Mercurial > hg > ishara
changeset 0:672052bd81f8
Initial partial import.
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@abuffer/abuffer.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +% abuffer - arrow that collects several outputs from supplied generator arrow +% +% abuffer :: +% arrow({},{[[N]]},S) ~'arrow with no inputs and one output', +% L:natural ~'width of buffer' +% -> arrow({}, {[[N,L]]},S). + +function o=abuffer(a,width) + s.base=a; + s.width=width; + o=class(s,'abuffer',arrow(nargin(a),narout(a))); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@abuffer/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,36 @@ +function u=construct(s,sizes_in) + u=construct(s.base,sizes_in); + + u.sizes_out = {[u.sizes_out{1}(1),s.width]}; + subproc = u.process; + width = s.width; + + if nargin(s.base)==0 && nargout(s.base)==1 + u.process = @proc01; + elseif nargin(s.base)==1 && nargout(s.base)==0 + u.process = @proc10; + else + u.process = @proc11; + end + + function proc10(X) + for i=1:width, subproc(X(:,i)); end + end + + function Y=proc11(X) + y=subproc(X(:,1)); + Y=repmat(y,1,width); + for i=2:width + Y(:,i)=subproc(X(:,i)); + end + end + + function Y=proc01 + y=subproc(); + Y=repmat(y,1,width); + for i=2:width + Y(:,i)=subproc(); + end + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@abuffer/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('buffer(%s,%d)',tostring(a.base),a.width);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@aconnect/aconnect.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,24 @@ +% aconnect - serial connection of two arrows +% +% aconnect :: +% arrow(T1,T2,S1), arrow(T2,T3,S2) +% -> arrow(T1,T3, pair(S1,S2)). +% +% The first arrow must have the same number of outputs +% and as the second arrow has inputs. The resulting +% arrow has a state type consisting of a two element +% cell array with elements of type S1 and S2. + +function o=aconnect(o1,o2,varargin) + + if nargin<1, o1=aid; o2=aid; end + if nargout(o1)~=nargin(o2) + error(sprintf('Connecting units: port number mismatch between \n %s (%d outputs)\nand %s (%d inputs)', ... + tostring(o1),nargout(o1),tostring(o2),nargin(o2))); + end + + s.unit1=o1; + s.unit2=o2; + + o=class(s,'aconnect',arrow(nargin(o1),nargout(o2))); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@aconnect/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,70 @@ +% construct - construct unit for serial connection of two arrows +function u=construct(o,sizes_in) + u1=[]; u2=[]; + try + u1=construct(o.unit1,sizes_in); + u2=construct(o.unit2,u1.sizes_out); + n_int=nargout(o.unit1); + n_out=nargout(o.unit2); + catch ex + if ~isempty(u2), u2.dispose(); end + if ~isempty(u1), u1.dispose(); end + rethrow(ex); + end + + + u=mkunit(o); + u.starting= @starting; + u.stopping= @stopping; + u.dispose = @dispose; + if n_int==1 + if n_out==1 + if nargin(o.unit1)==1 + u.process = @proc_111; + else + u.process = @proc_n11; + end + else + if nargin(o.unit1)==1 + u.process = @proc_11n; + else + u.process = @proc_n1n; + end + end + else + if nargin(o.unit1)==1 && n_out==1 + u.process = @proc_1n1; + else + u.process = @proc_val; + end + end + u.get_state = @get_state; + u.set_state = @set_state; + u.sizes_out = u2.sizes_out; + u.viewables = [u1.viewables;u2.viewables]; + + function y=proc_111(x), y=u2.process(u1.process(x)); end + function y=proc_n11(varargin), y=u2.process(u1.process(varargin{:})); end + function varargout=proc_11n(x), [varargout{1:n_out}]=u2.process(u1.process(x)); end + function varargout=proc_n1n(varargin) + [varargout{1:n_out}] = u2.process(u1.process(varargin{:})); + end + + function y=proc_1n1(x) + [tempvals{1:n_int}] = u1.process(x); + y=u2.process(tempvals{:}); + end + + function varargout=proc_val(varargin) + [tempvals{1:n_int}] = u1.process(varargin{:}); + [varargout{1:n_out}] = u2.process(tempvals{:}); + end + + + function dispose, u1.dispose(); u2.dispose(); end + function starting, u1.starting(); u2.starting(); end + function stopping, u1.stopping(); u2.stopping(); end + + function s=get_state, s = {u1.get_state(),u2.get_state()}; end + function set_state(s), u1.set_state(s{1}); u2.set_state(s{2}); end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@aconnect/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('%s * %s',tostring(a.unit1),tostring(a.unit2));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@afirst/afirst.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,17 @@ +% afirst - arrow that applies some arrow to first input and passes rest through +% +% afirst :: +% arrow(A:arglist(N),B:arglist(M),S), +% L:natural ~'the number of extra inputs to pass through' +% -> arrow([A,{[L]->type}], [B,{[L]->type}],S). +% +% The resulting arrow has N+L inputs and M+L outputs. +% The last L outputs have the same size and type as +% the last L inputs. + +function o=afirst(a,extra) + if nargin<2, extra=1; end + s.base=a; + s.extra=extra; + o=class(s,'afirst',arrow(nargin(a)+extra,nargout(a)+extra)); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@afirst/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,30 @@ +function u=construct(s,sizes_in) + + nin=nargin(s.base); + + u=construct(s.base,sizes_in(1:nin)); + u.sizes_out = [u.sizes_out,sizes_in(nin+(1:s.extra))]; + u.process = mkproc(u.process,nin,nargout(s.base),s.extra); +end + +function f=mkproc(g,nin,nout,extra) + f=@proc; + if extra==1 + if nin==1 && nout==1, f=@proc_111; + elseif nin==1 && nout==0, f=@proc_101; + elseif nin==0 && nout==1, f=@proc_011; + else, x=1:extra; f=@proc_nnn; end + else + x=1:extra; + f=@proc_nnn; + end + function [y1,x]=proc_111(x1,x), y1=g(x1); end + function x=proc_101(x1,x), g(x1); end + function [y1,x]=proc_011(x), y1=g(x1); end + + function varargout=proc_nnn(varargin) + [varargout{1:nout}]=g(varargin{1:nin}); + varargout(nout+x)=varargin(nin+x); + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@afirst/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function s=tostring(a) + if a.extra==1 + s=sprintf('first(%s)',tostring(a.base)); + else + s=sprintf('first(%s,%d)',tostring(a.base),a.extra); + end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@agraph/acquire.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +function acquire(a) + ud=get(0,'UserData'); + i=find(ud.figs==fig(a)); + if isempty(i) + ud.figs=[ud.figs, fig(a)]; + ud.arrows=[ud.arrows,{a}]; + set(0,'UserData',ud); + else + fprintf('Arrow %s cannot use figure %d, already in use by %s.\n',tostring(a),fig(a),tostring(ud.arrows{i})); + error('Figure already in use by arrow.'); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@agraph/agraph.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,21 @@ +% agraph - Base arrow class for graphics in a Matlab figure +% +% agraph :: +% N:natural ~'number of inputs', +% options { +% fig :: handle / gcf ~'figure for this instance'; +% autoflush :: boolean/1 ~'unit will call drawnow after every iteration' +% } +% -> agraph(N) < arrow(_:arglist(N),{},_). +% +% METHODS +% autoflush :: agraph(_) -> boolean. +% fig :: agraph(_) -> handle. +% +% This class is no use instantiated directly. Should be subclassed. +function o=agraph(nin,varargin) + s.opts=prefs('fig',[],'name','','autoflush',0,varargin{:}); + if isempty(s.opts.fig), warning('agraph requires figure'); end + o=class(s,'agraph',arrow(nin,0)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@agraph/autoflush.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function f=autoflush(s), f=s.opts.autoflush;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@agraph/fig.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function f=fig(s), f=s.opts.fig;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@agraph/name.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function f=name(s), f=s.opts.name;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@agraph/release.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +function release(a) + ud=get(0,'UserData'); + i=find(ud.figs==fig(a)); + ud.figs(i)=[]; + ud.arrows(i)=[]; + set(fig(a),'UserData',ud); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@agraph/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('fig:%d',a.opts.fig);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@ainfig/ainfig.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,18 @@ +% ainfig - Arrow for doing things in a figure +% +% ainfig :: options { +% dom :: [[N]->nonneg] / (1:N) ~'X values for plots'; +% ylim :: [[_]->nonneg] / [] ~'passed to ylim if not empty'; +% xlim :: [[_]->nonneg] / [] ~'passed to xlim if not empty'; +% xlabel :: [[_]->nonneg] / [] ~'passed to xlabel if not empty'; +% ylabel :: [[_]->nonneg] / [] ~'passed to ylabel if not empty'; +% plotfn :: plotfn / @plot ~'function to create image'; +% args :: {[_]} / {} ~'extra arguments for plotfn' +% } -> arrow({A}, {}, empty) ~'arrow from anything arrays'. + +function o=ainfig(fig,fn,varargin) + s.fn=fn; + s.opts=prefs('fig',fig,'ylim',[],'xlim',[],'colormap',[],varargin{:}); + o=class(s,'ainfig',agraph(1,s.opts)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@ainfig/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,18 @@ +function u=construct(s,sizes_in) + figure(fig(s)); + if ~isempty(s.opts.colormap), colormap(s.opts.colormap); end + %if isempty(s.opts.xlim) && numel(dom)>1, s.opts.xlim=[dom(1),dom(end)]; end + %if ~isempty(s.opts.ylim), ylim(s.opts.ylim); end + %if ~isempty(s.opts.xlim), xlim(s.opts.xlim); end + %if isfield(s.opts,'ylabel'), ylabel(s.opts.ylabel); end + %if isfield(s.opts,'xlabel'), xlabel(s.opts.xlabel); end + + u=mkunit(s); + u.sizes_out = {}; + if autoflush(s), u.process =@proc_flush; + else u.process=@proc_noflush; end + u.dispose = @()clf(fig(s)); + + function proc_flush(x), figure(fig(s)); s.fn(x); drawnow; end + function proc_noflush(x), figure(fig(s)); s.fn(x); end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@ainfig/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('ainfig<%s>',tostring(a.agraph));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@ainitstate/ainitstate.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +% ainitstate - arrow based on give arrow initialised with given state. +% +% ainitstate :: arrow(A,B,S), S -> arrow(A,B,S). +% +% The resulting arrow is the same as the supplied arrow +% except that its accessible state is explicitly initialised. + +function o=ainitstate(a,state) + s.base=a; + s.state=state; + o=class(s,'ainitstate',arrow(nargin(a),nargout(a)));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@ainitstate/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function u=construct(s,sizes_in) + + u=construct(s.base,sizes_in); + u.set_state(s.state);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@ainitstate/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=tostring(a.base)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@aparallel/aparallel.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,16 @@ +% aparallel - Parallel application of arrows to multiple inputs +% +% aparallel :: +% arrow( A1:arglist(N1), B1:arglist(M1), C1) ~'arrow with N1 inputs, M1 outputs', +% arrow( A2:arglist(N2), B2:arglist(M2), C2) ~'arrow with N2 inputs, M2 outputs', +% -> arrow( [A1,A2], [B1,B2],cell {C1,C2}) ~'arrow with N1+N2 ins, M1+M2 outs'. +% +% The list of inputs of the second arrow is concatenated to those +% of the first. Ditto the ouputs. State is cell array pair of +% states of the two component arrows. + +function o=aparallel(a1,a2) + s.a1=a1; + s.a2=a2; + o=class(s,'aparallel',arrow(nargin(a1)+nargin(a2),nargout(a1)+nargout(a2))); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@aparallel/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,57 @@ +function u=construct(s,sizes_in) + + nin1=nargin(s.a1); + nin2=nargin(s.a2); + + u1=[]; u2=[]; + try + u1=construct(s.a1,sizes_in(1:nin1)); + u2=construct(s.a2,sizes_in(nin1+(1:nin2))); + + u.sizes_out = [u1.sizes_out,u2.sizes_out]; + + nout1=length(u1.sizes_out); + nout2=length(u2.sizes_out); + + ix1 = 1:nin1; ix2 = nin1+(1:nin2); + ox1 = 1:nout1; ox2 = nout1+(1:nout2); + + nout = length(u.sizes_out); + if all([nin1,nin2,nout1,nout2]==[1,1,1,1]), + u.process = @proc11; + else + u.process = @proc; + end + catch ex + if ~isempty(u2), u2.dispose(); end + if ~isempty(u1), u1.dispose(); end + rethrow(ex); + end + + u.dispose = @dispose; + u.starting= @starting; + u.stopping= @starting; + u.dispose = @dispose; + u.get_state = @get_state; + u.set_state = @set_state; + u.viewables = [u1.viewables;u2.viewables]; + + function [y1,y2]=proc11(x1,x2) + y1=u1.process(x1); + y2=u2.process(x2); + end + + function varargout=proc(varargin) + varargout=cell(1,nout); + [varargout{ox1}]=u1.process(varargin{ix1}); + [varargout{ox2}]=u2.process(varargin{ix2}); + end + + function dispose, u1.dispose(); u2.dispose(); end + function starting, u1.starting(); u2.starting(); end + function stopping, u1.stopping(); u2.stopping(); end + + function s=get_state, s = {u1.get_state(),u2.get_state()}; end + function set_state(s), u1.set_state(s{1}); u2.set_state(s{2}); end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@aparallel/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('(%s + %s)',tostring(a.a1),tostring(a.a2));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arr/arr.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,31 @@ +% arr - Lift function to processing unit +% +% arr :: +% F:(A:arglist(N)->B:arglist(M)) ~'arbitrary function with N inputs and M outputs', +% options { +% nargin :: natural / nargin(F); +% nargout :: natural / nargout(F); +% } +% -> arrow(A:arglist(N),B:arglist(M),empty). +% +% The arr class is a class of arrows which simply apply an ordinary +% Matlab function to the inputs to obtain the outputs. In many cases, +% the number of inputs and outputs can be determined from the supplied +% function handle, but if the number arguments in or out is variable, +% then the nargin and nargout options must be used. +% +% The type empty denotes the type of empty arrays, ie +% the state of an arr arrow is always an empty matrix. +% +% arr(@log) - arrow which supplies the log of its input. +% arr(@plus) - sum two inputs to produce output +% arr(@(a,b)deal(a+b,a-b),'nargout',2) - computes sum and difference of inputs. + +function o=arr(fn,varargin) + if nargin==0, fn=@id; end + opts=prefs('nargin',[],'nargout',[],'sizefn',[],varargin{:}); + if isempty(opts.nargin), opts.nargin=nargin(fn); end + if isempty(opts.nargout), opts.nargout=nargout(fn); end + if opts.nargout<0, opts.nargout=1; end % assume 1 if we can't tell + o=class(struct('fn',fn,'sizefn',opts.sizefn),'arr',arrow(opts.nargin,opts.nargout)); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arr/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,31 @@ +function u=construct(s,sizes_in) + u=mkunit(s); + if isempty(s.sizefn) + u.sizes_out=guess_sizes(s.fn,sizes_in,nargout(s)); + else + u.sizes_out=s.sizefn(sizes_in); + end + u.process=mkproc(s.fn,nargin(s),nargout(s)); + +end + +function f=mkproc(fn,nin,nout); + if nout==0, f = @proc_n0; + elseif nin==0, f = @proc_0n; + elseif nin==1 && nout==1, f=@proc_11; + else f=@proc_nn; end + + function proc_n0(varargin), fn(varargin{1:nin}); end + function out=proc_11(in), out=fn(in); end + function varargout=proc_0n, [varargout{1:nout}]=fn(); end + function varargout=proc_nn(varargin), + [varargout{1:nout}]=fn(varargin{1:nin}); + end +end + +function sz_out=guess_sizes(fn,sz_in,nout) + ins = map(@zeros,sz_in); + [outs{1:nout}] = fn(ins{:}); + sz_out = map(@size,outs); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arr/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('arr(%s)',tostring(a.fn));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrf/arrf.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,16 @@ +% arrf - Creat functional arrow using a function factory +% +% arrf :: +% FF: (SZ -> (A:arglist(N)->B:arglist(M))) ~'function to create function from sizes', +% N: natural ~'number of inputs', +% M: natural ~'number of outputs', +% options {} +% -> arrow(A:arglist(N),B:arglist(M),empty). +% +% The type empty denotes the type of empty arrays, ie +% the state of an arr arrow is always an empty matrix. + +function o=arrf(ffn,nin,nout,varargin) + opts=prefs('sizefn',[],varargin{:}); + o=class(struct('fn',ffn,'sizefn',opts.sizefn),'arrf',arrow(nin,nout)); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrf/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,32 @@ +function u=construct(s,sizes_in) + u=mkunit(s); + fn=s.fn(sizes_in); + if isempty(s.sizefn) + u.sizes_out=guess_sizes(fn,sizes_in,nargout(s)); + else + u.sizes_out=s.sizefn(sizes_in); + end + u.process=mkproc(fn,nargin(s),nargout(s)); + +end + +function f=mkproc(fn,nin,nout); + if nout==0, f = @proc_n0; + elseif nin==0, f = @proc_0n; + elseif nin==1 && nout==1, f=@proc_11; + else f=@proc_nn; end + + function proc_n0(varargin), fn(varargin{1:nin}); end + function out=proc_11(in), out=fn(in); end + function varargout=proc_0n, [varargout{1:nout}]=fn(); end + function varargout=proc_nn(varargin), + [varargout{1:nout}]=fn(varargin{1:nin}); + end +end + +function sz_out=guess_sizes(fn,sz_in,nout) + ins = map(@zeros,sz_in); + [outs{1:nout}] = fn(ins{:}); + sz_out = map(@size,outs); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrf/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('arrf(%s)',tostring(a.fn));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/arrow.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,28 @@ +% arrow - Base class for processing unit +% +% arrow :: +% N:natural ~'number of inputs', +% M:natural ~'number of inputs' +% -> arrow(T1:arglist(N),T2:arglist(M),_). +% +% The arrow(T1,T2,S) type denotes the type of an arrow with N inputs +% and M outputs when T1 is a list of N types and T2 is list of M types. +% S is the type of the state of the arrow and can be determined by subclasses, +% The inputs and outputs then have the types as listed in T1 and T2 +% respectively. +% +% The base arrow class cannot be used without subclassing since +% any attempt to instantiate the live processing unit will throw +% an exception. +% +% METHODS +% +% nargin - number of inputs +% nargout - number of inputs +% construct - instantiate live processing unit + + +function o=arrow(nin,nout) + s.nargin=nin; + s.nargout=nout; + o=class(s,'arrow');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/buffer.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +% buffer - returns an arrow that collects several outputs from another arrow +% +% buffer :: +% arrow({},{[[N]]},S) ~'arrow with no inputs and one output', +% L:natural ~'width of buffer' +% -> arrow({}, {[[N,L]]},S). +function b=buffer(a,width), b=abuffer(a,width);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,25 @@ +% construct - Instantiate live processing unit +% +% construct :: +% arrow(A:arglist(N), B:arglist(M), S) ~'the arrow to instantiate', +% {[N]->size} ~'the sizes of the inputs' +% -> unit(A,B,S) ~'live processing unit structure'. +% +% NB the type size denotes a row vector of array dimensions. +% The type unit(A,B,S) is a structure containing +% values and functions for running the live processing unit. Its fields +% are as follows: +% +% unit(A:arglist(N),B:arglist(M),S) :== struct { +% starting :: () -> action (); +% stopping :: () -> action (); +% dispose :: () -> action (); +% set_state :: S -> action () +% get_state :: () -> S; +% viewables :: () -> list(samer.core.Viewable); +% process :: A{:} -> B{:} +% }. + +function u=construct(s,sizes_in) + error('cannot construct system for base arrow class'); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/display.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function display(a) + disp([' ' tostring(a)]);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/first.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +% first - Apply arrow to first input and pass through others +% +% first :: +% arrow(A:arglist(N),B:arglist(M)), +% L:natural ~'the number of extra inputs to pass through' +% -> arrow([A,{[L]->type}], [B,{[L]->type}]). +% +% The resulting arrow has N+L inputs and M+L outputs. +% The last L outputs have the same size and type as +% the last L inputs. + +function b=first(a,varargin), b=afirst(a,varargin{:}); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/gt.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +% gt - Sequential composition of arrows +% +% Operator form of aseq. See aparellel class for details. +% The following are equivalent: +% aseq(a1,a2) == a1 > a2 + +function o=gt(o1,o2), o=aseq({o1,o2}); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/mgather.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,9 @@ +function [outputs,state]=amgather(a,its,varargin) + nout=nargout(a); + getst=(nargout>1); + [outputs,state]=with_arrow(a,@run,{}); + function [outs,st]=run(u) + [outs{1:nout}]=umgather(u,its,varargin{:}); + if getst, st=u.get_state(); else st=[]; end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/mkunit.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,32 @@ +% mkunit - Initialise processing unit structure +% +% This is for use by arrow implementations. It +% fills in defaults for the function handles in the +% structure representing a live processing unit. +% +% mkunit :: +% arrow(_:arglist(N),_:arglist(M),S) +% -> struct { +% starting :: () -> action (); +% stopping :: () -> action (); +% dispose :: () -> action (); +% set_state :: S -> action () +% get_state :: () -> S. +% viewables :: () -> list(samer.core.Viewable) +% }. +% +% NB arrow(A,B,S) denotes an arrow with an accessible state +% of type S. It is a subtype of arrow(A,B). +% +% list(A) denotes the type of cell arrays of objects of +% type A, ie list(A) :== {[N]->A} where N can be any +% natural number. + +function u=mkunit(o) + u.starting=@nop; + u.stopping=@nop; + u.dispose=@nop; + u.viewables={}; + u.get_state=@()[]; + u.set_state=@nop; +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/mpower.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,8 @@ +% mpower - Arrow with state initialiser +% +% mpower :: arrow(A,B,S), S -> arrow(A,B,S). +% +% The resulting arrow is the same as the supplied arrow +% except that its accessible state is explicitly initialised. +function o=mpower(a,state), o=ainitstate(a,state); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/mtimes.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +% mtimes - Serial connection of arrows +% +% Operator form of aconnect. See aconnect for details. +% The following are all equivalent: +% >> aconnect(a1,aconnect(a2,a2)). +% >> a1 * a2 * a3 +function o=mtimes(o1,o2), o=aconnect(o1,o2); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/nargin.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +% nargin - Number of inputs of an arrow +function n=nargin(s), n=s.nargin;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/nargout.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +% nargout - Number of outputs of an arrow +function n=nargout(s), n=s.nargout;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/plus.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +% plus - Parallel application of arrows to multiple inputs +% +% Operator form of aparallel. See aparellel class for details. +% The following are equivalent: +% aparallel(a1,a2) == a1 + a2 + +function o=plus(o1,o2), o=aparallel(o1,o2); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@arrow/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('arrow(%d->%d)',nargin(a),nargout(a));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@asampler/asampler.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,15 @@ +% asampler - sampling arrow +% +% asampler :: +% (E -> [E->A]) ~'function to generate sample array of given size', +% E:[[D,1]] ~'size of arrays to generate' +% -> arrow({},{[E->A]},empty). +% +% This is intended to make it easy to generate sequences of random data +% using a function which relies on Matlab's random number generators. + +function o=asampler(fn,sz) + s.fn=fn; s.sz=sz; + o=class(s,'asampler',arrow(0,1)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@asampler/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +function u=construct(s,sizes_in) + u=mkunit(s); + sz=s.sz; fn=s.fn; + u.sizes_out = guess_sizes(fn,sz); + u.process = @proc; + + function out=proc, out=fn(sz); end +end + +function sz_out=guess_sizes(fn,sz) + out = fn(sz); + sz_out = {size(out)}; +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@asampler/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('asampler(%s,%s)',tostring(a.fn),tostring(a.sz));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@aseq/aseq.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,13 @@ +% aseq - arrow to sequence multiple finite generators +% +% aseq :: +% {[N]->arrow(A,B,_)} ~'cell array of arrows' +% -> arrow(A,B,aseq_state). +% + + +function o=aseq(ax) + if iscell(ax) ax=celldata(ax); end + s.arrows=ax; + o=class(s,'aseq',arrow(nargin(head(ax)),nargout(head(ax)))); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@aseq/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,59 @@ +function u=construct(s,sizes_in) + + current_arrow = head(s.arrows); + remaining_arrows = next(s.arrows); + fprintf('aseq: starting with arrow %s...\n',tostring(current_arrow)); + + nin=nargin(current_arrow); + nout=nargout(current_arrow); + + running=0; + current_unit = construct(current_arrow,sizes_in(1:nin)); + current_proc = current_unit.process; + + u=mkunit(s); + u.sizes_out = current_unit.sizes_out; + u.starting = @starting; + u.stopping = @stopping; + u.dispose = @dispose; + u.get_state = @get_state; + u.set_state = @set_state; + u.process = @proc_nn; + + function starting, current_unit.starting(); running=1; end + function stopping, current_unit.stopping(); running=0; end + function dispose, current_unit.dispose(); end + + function s=get_state, s={current_arrow, remaining_arrows, current_unit.get_state()}; end + function set_state(s), replace_running_unit(s{1},s{2},s{3}); end + + function varargout=proc_nn(varargin) + try + [varargout{1:nout}]=current_proc(varargin{:}); + catch ex + if iseof(ex) && ~isempty(remaining_arrows) + next_arrow=head(remaining_arrows); + fprintf('aseq: continuing with next arrow %s...\n',tostring(next_arrow)); + replace_running_unit(next_arrow, next(remaining_arrows)); + [varargout{1:nout}]=proc_nn(varargin{:}); + else + rethrow(ex); + end + end + end + + function replace_running_unit(a,remaining,state) + if running + current_unit.stopping(); + current_unit.dispose(); + end + current_arrow=a; + current_unit=construct(a,sizes_in(1:nin)); + current_proc=current_unit.process; + remaining_arrows=remaining; + if nargin>2, current_unit.set_state(state); end + if running, current_unit.starting(); end + end +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@aseq/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('seq(%s)',tostring(a.arrows));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@asignal/asignal.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,23 @@ +% asignal - Arrow which produces frames from a signal +% +% asignal :: +% signal(C,R), +% N:natural ~'block size', +% M:natural ~'hop size' +% -> arrow({},{[[C,N]]]}). +% +% asignal :: +% signal(C,R), +% N:natural ~'block size', +% -> arrow({},{[[C,N]]]}). +% +% If hop size is omitted, it defaults to the block size + +function o=asignal(source,block,hop) + if nargin<3, hop=block; end + s.source=source; + s.block=block; + s.hop=hop; + o=class(s,'asignal',arrow(0,1)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@asignal/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,49 @@ +function u=construct(s,sizes_in) + src=construct(s.source); + ch=channels(s.source); + + span=s.block; + jump=s.hop; + olap=span-jump; + rdr=src.reader(jump); + + if olap>0 + buf=[zeros(ch,jump),sigreadn(src,olap)]; % preload with overlap + OL1=1:olap; + OL=(jump+1):span; + HOP=(olap+1):span; + process=@proc; + fprintf(' Using signal reader with overlap=%d.\n',olap); + else + process=@proc0; + fprintf(' Using zero-overlap signal reader.\n'); + end + + u=mkunit(s); + u.starting = src.start; + u.stopping = src.stop; + u.dispose = src.dispose; + u.process = process; + u.sizes_out = {[ch,span]}; + + function out=proc0, + [out,rem]=rdr(); + if rem>0, error('ARROW:EOF','End of stream'); end + end + + function out=proc, + buf(:,OL1)=buf(:,OL); % copy overlap from end of buf to head + [buf(:,HOP),rem]=rdr(); + if rem>0, error('ARROW:EOF','End of stream'); end + %out=[buf,chunk]; + out=buf; + end + + % old version + function out=proc1, + [chunk,rem]=rdr(); + if rem>0, error('ARROW:EOF','End of stream'); end + out=[buf,chunk]; + buf=out(:,OL); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@asignal/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function s=tostring(a) + s=sprintf('asignal(%s,%d,%d)',tostring(a.source),a.block,a.hop); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@asink/asink.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,22 @@ +% asink - output arrow using sink object +% +% asink :: +% sink(C,R) ~'signal sink' +% -> arrow({[[N,1]]]},{},empty). +% +% asink :: +% sink(C,R) ~'signal sink', +% [[1,M]] ~'indices of samples to select from input' +% -> arrow({[[N,1]]]},{},empty). +% +% This unit will accept vectors of any size and send them to an audio output +% device or destination. If 2nd argument is specified as I and data is supplied +% in array x, then only samples x(I) are played. +function o=asink(sink,window) + if nargin==0, sink=sinknull; end + if nargin<2, window=[]; end + s.sink=sink; + s.window=window; + o=class(s,'asink',arrow(1,0)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@asink/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,25 @@ +function u=construct(s,sizes_in) + u=mkunit(s); + if sizes_in{1}(1)~=channels(s.sink) + error('Number of rows in input does not match channels in sink'); + end + snk=construct(s.sink); + + if isempty(s.window), + write=snk.writer(sizes_in{1}(2)); + u.process=@proc1; + else + WIN=s.window; + write=snk.writer(length(WIN)); + u.process=@proc2; + end + + u.sizes_out = {}; + u.dispose = snk.dispose; + u.starting = snk.start; + u.stopping = snk.stop; + + function proc1(x), write(x); end + function proc2(x), write(x(:,WIN)); end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@asink/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function s=tostring(a), s=sprintf('asink(%s)',tostring(a.sink)); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@aswitch/aswitch.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,15 @@ +% aswitch - switching arrow +% +% aswitch :: +% arrow(A:arglist(N),B:arglist(M),S) +% -> arrow([A,{box(arrow(A,B,S))}], B,S). +% +% The resulting arrow has N+1 inputs and M outputs. The last input +% is for boxed arrows, that is, a stream of events consisting of +% arrows. When a new arrow arrives, the aswitch arrow starts behaving +% like it. + +function o=aswitch(a) + s.base=a; + o=class(s,'aswitch',arrow(nargin(a)+1,nargout(a))); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@aswitch/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,63 @@ +function u=construct(s,sizes_in) + nin=nargin(s.base); + nout=nargout(s.base); + + running=0; + current_arrow = s.base; + current_unit = construct(current_arrow,sizes_in(1:nin)); + current_proc = current_unit.process; + + u=mkunit(s); + u.sizes_out = current_unit.sizes_out; + u.starting = @starting; + u.stopping = @stopping; + u.dispose = @dispose; + u.get_state = @get_state; + u.set_state = @set_state; + + if nin==1 && nout==1, u.process=@proc_11; + elseif nin==1 && nout==0, u.process=@proc_10; + elseif nin==0 && nout==1, u.process=@proc_01; + else, u.process=@proc_nn; end + + function starting, current_unit.starting(); running=1; end + function stopping, current_unit.stopping(); running=0; end + function dispose, current_unit.dispose(); end + + function s=get_state, s={current_arrow, current_unit.get_state()}; end + function set_state(s), replace_running_unit(s{1},s{2}); end + + function y1=proc_11(x1,x), + if ~isempty(x), replace_running_unit(x{1}); end + y1=current_proc(x1); + end + + function x=proc_10(x1,x), + if ~isempty(x), replace_running_unit(x{1}); end + current_proc(x1); + end + function y1=proc_01(x), + if ~isempty(x), replace_running_unit(x{1}); end + y1=current_proc(); + end + + function varargout=proc_nn(varargin) + x=varargin{end}; + if ~isempty(x), replace_running_unit(x{1}); end + [varargout{1:nout}]=current_proc(varargin{1:nin}); + end + + function replace_running_unit(a,state) + if running + current_unit.stopping(); + current_unit.dispose(); + end + current_arrow=a; + current_unit=construct(a,sizes_in(1:nin)); + current_proc=current_unit.process; + if nargin>1, current_unit.set_state(state); end + if running, current_unit.starting(); end + end +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@aswitch/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('switch(%s)',tostring(a.base));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@asysobj/asysobj.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,13 @@ +% asysobj - Arrow from Matlab System Object +% +% asysobj :: +% sysobj(A,B,S) ~'System object with inputs A and outputs B', +% ({[N]->size} -> {[M]->size} ~'function to compute sizes out from sizes in' +% -> arrow(A,B,S) ~'arrow from A to B with state of type S'. + +function o=asysobj(hfn,nin,nout,sizefn) + s.h=hfn; + s.sizefn=sizefn; + o=class(s,'asysobj',arrow(nin,nout)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@asysobj/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +function u=construct(s,sizes_in) + nout=nargout(s); + u=mkunit(s); + h=s.h(sizes_in); + + procs = { @proc00, @proc01, @proc0n; ... + @proc10, @proc11, @proc11; ... + @procn0, @procn1, @procnn }; + + u.sizes_out = s.sizefn(sizes_in); + u.process = procs{ n2i(nargin(s)), n2i(nargout(s)) }; + u.dispose = @()release(h); + + function i=n2i(n), i=1+max(n,2); end + function proc00(in), step(h); end + function proc10(in), step(h,in); end + function proc01(in), out=step(h); end + function out=proc11(in), out=step(h,in); end + + function procn0(varargin), step(h,varargin{:}); end + function out=procn1(varargin), out=step(h,varargin{:}); end + function varargout=proc0n, [varargout{1:nout}]=step(h); end + function varargout=proc1n(in), [varargout{1:nout}]=step(h,in); end + + function varargout=procnn(varargin), [varargout{1:nout}]=step(h,varargin{:}); end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@asysobj/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('asysobj(%s)',tostring(a.h));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@auinum/auinum.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,16 @@ +% auinum - Arrow that sends a user-controlled number +% +% auinum :: +% real ~'initial value', +% options { +% fig :: handles / gcf ~'figure to track' +% } +% -> arrow({},{real},empty). + +function o=auinum(x0,varargin) + s.x0=x0; + s.opts=prefs('fig',[],varargin{:}); + if isempty(s.opts.fig), s.opts.fig=gcf; end + o=class(s,'auinum',arrow(0,1)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@auinum/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,35 @@ +function u=construct(s,sizes_in) + fg=fig(s); + current_value = s.x0; + ht=uitext('parent',fg,tostring(current_value),'left'); + + u=mkunit(s); + u.process=@proc; + u.sizes_out = {[1,1]}; + u.dispose = @dispose; + u.starting = @starting; + u.stopping = @stopping; + + function starting + set(fg,'ButtonDownFcn',@btndown); + set(fg,'WindowButtonMotionFcn',[]); + end + + function stopping + set(fg,'ButtonDownFcn',[]); + set(fg,'WindowButtonMotionFcn',[]); + end + + function x=proc, + pos=get(ax,'CurrentPoint'); + x=pos(1,1:2)'; + end + + function btndown(a,b), set(fg,'WindowButtonMotionFcn',@nop); end + function btnup(a,b), set(fg,'WindowButtonMotionFcn',[]); end + + function dispose + set(fg,'ButtonDownFcn',[]); + set(fg,'WindowButtonMotionFcn',[]); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@auinum/fig.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function f=fig(s), f=s.opts.fig;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@auinum/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('auinum<fig:%d>',a.opts.fig);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@emousepos/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,48 @@ +function u=construct(s,sizes_in) + fg=fig(s); figure(fg); + ax=gca; + + current_pos={}; %[nan;nan]; + btnisup=1; + + if ~isempty(s.opts.xlim), xlim(s.opts.xlim); end + if ~isempty(s.opts.ylim), xlim(s.opts.ylim); end + if isfield(s.opts,'ylabel'), ylabel(s.opts.ylabel); end + if isfield(s.opts,'xlabel'), xlabel(s.opts.xlabel); end + if isfield(s.opts,'box'), box(s.opts.box); end + + u=mkunit(s); + u.process=@proc; + u.sizes_out = {[2,1]}; + u.dispose = @dispose; + u.starting = @starting; + u.stopping = @stopping; + + function starting + set(ax,'ButtonDownFcn',@btndown); + set(fg,'WindowButtonMotionFcn',[]); + end + + function stopping + set(ax,'ButtonDownFcn',[]); + set(fg,'WindowButtonMotionFcn',[]); + end + + function x=proc, + x=current_pos; + if btnisup, current_pos={}; end % [nan;nan]; end + end + + function btndown(a,b), + set(fg,'WindowButtonMotionFcn',@move,'WindowButtonUpFcn',@btnup); + btnisup=0; + move(a,b); + end + function btnup(a,b), set(fg,'WindowButtonMotionFcn',[]); btnisup=1; end + function move(a,b), cp=get(ax,'CurrentPoint'); current_pos={cp(1,1:2)'}; end + + function dispose + set(ax,'ButtonDownFcn',[]); + set(fg,'WindowButtonMotionFcn',[]); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@emousepos/emousepos.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,20 @@ +% emousepos - Arrow that generates mouse-move events +% +% emousepos :: +% options { +% fig :: handles / gcf ~'figure to track'; +% xlim :: [[1,2]] / [] ~'if not empty, set X limits of axes'; +% ylim :: [[1,2]] / [] ~'if not empty, set Y limits of axes' +% } +% -> arrow({},boxed([[2,1]]),empty). +% +% The output of the emousepos arrow is a stream of events carrying +% two element column vectors containing the X and Y coordinates of +% the last mouse-move event in the current time-slice. + +function o=mousepos(varargin) + s.opts=prefs('fig',[],'xlim',[],'ylim',[],varargin{:}); + if isempty(s.opts.fig), s.opts.fig=gcf; end + o=class(s,'emousepos',arrow(0,1)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@emousepos/fig.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function f=fig(s), f=s.opts.fig;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@emousepos/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('emousepos<fig:%d>',a.opts.fig);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@erate/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,33 @@ +function u=construct(s,sizes_in) + + nin=nargin(s.base); + + u=construct(s.base,s.sizes_in(1:nin)); + u.sizes_out = [u.sizes_out]; % !!! this is wrong. need better type system + u.process = mkproc(u.process,nin,nargout(s.base)); +end + +function f=mkproc(g,nin,nout) + empty={{}}; + f=@proc; + if nin==1 && nout==1, f=@proc_11; + elseif nin==1 && nout==0, f=@proc_10; + else, f=@proc_nn; end + + function proc_10(x1), + if ~isempty(x1), g(x1{1}); end; + end + function y1=proc_11(x1,x), if isempty(x1), y1={}; else y1={g(x1{1})}; end; end + + function varargout=proc_nn(varargin) + if any(cellfun(@isempty,varargin)), varargout=repmat(empty,1,nout); + else + ins=cellfun(@unbox,varargin(1:nin)); + [outs{1:nout}]=g(ins{:}); + varargout=cellfun(@box,outs); + end + end + function x=unbox(y), x=y{1}; end + function y=box(x), y={x}; end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@erate/erate.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,20 @@ +% erate - Drive sub-arrow at event rate, ie when events arrive +% +% erate :: arrow(A:arglist(N),B:arglist(M),S), +% -> arrow(events(A), events(B),S). +% +% the type events(A) denotes a list of types where each +% type is a boxed version of the the corresponding type in A. +% The boxed type boxed(A) is either {} (no-event) or {A}, +% (event with data of type A). If the encapsulated arrow has +% multiple inputs, the arrow is fired only if all inputs +% receive an event simultaneously. The arrow must have at +% least one input. + +function o=erate(a,sizes_in) + + s.base=a; + s.sizes_in=sizes_in; + if nargin(a)<1, error('erate arrow must have at least 1 input'); end + o=class(s,'erate',arrow(nargin(a),nargout(a))); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@erate/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('erate(%s)',tostring(a.base));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@esender/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,35 @@ +function u=construct(s,sizes_in) + fg=fig(s); figure(fg); clf; + set(gcf,'Name',s.opts.name); + hpanel = uipanel('title',s.opts.title,'bordertype','line'); + %hpanel = uigridcontainer('v0','GridSize',[1,1]); + hedit = uicontrol('parent',hpanel,'style','edit','string',s.opts.init,'horizontalalignment','left'); + %hbtn = uicontrol('parent',hpanel,'style','pushbutton','string','send'); + set(hedit,'BackgroundColor',get(0,'DefaultAxesColor')); + set(hedit,'units','normalized','position',[0,0,1,1]); + %set(hedit,'ToolTipString','Enter a MATLAB expression to evaluate a send.'); + %set(hbtn,'ToolTipString','Press to resend the last entered expression.'); + + queue = {}; + u=mkunit(s); + u.process=@proc; + u.sizes_out = {[1,1]}; + u.dispose = @dispose; + u.starting = @starting; + u.stopping = @stopping; + u.get_state = @()get(hedit,'string'); + u.set_state = @(s)set(hedit,'string',s); + + function dispose, delete(hpanel); end + function starting, set(hedit,'Callback',@send); end + function stopping, set(hedit,'Callback',[]); end + function x=proc, x=queue; queue={}; end + + function send(varargin), + str=get(hedit,'string'); + fprintf('* esender: evaluating %s\n',str); + try, queue = [queue, {evalin('base',str)}]; + catch fprintf('* esender: ERROR evaluating.\n'); + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@esender/esender.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,18 @@ +% esender - Arrow with a UI for sending events +% +% esender :: +% options { +% fig :: handles / gcf ~'figure to track' +% } +% -> arrow({},{box(A)},esender_state). +% +% The output of the mousepos arrow is a two element column vector +% containing the X and Y coordinates of the current point in axes +% coordinates. + +function o=esender(varargin) + s.opts=prefs('fig',[],'init','','title','','name','',varargin{:}); + if isempty(s.opts.fig), s.opts.fig=gcf; end + o=class(s,'esender',arrow(0,1)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@esender/fig.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function f=fig(s), f=s.opts.fig;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@esender/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('esender<fig:%d>',a.opts.fig);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@estates/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,26 @@ +function u=construct(s,sizes_in) + + u=construct(s.base,sizes_in); + s0=u.get_state(); + u.sizes_out = [u.sizes_out,size(s0)]; + u.process = mkproc(u.process, nargout(s.base), ... + u.get_state,s.period); +end + +function f=mkproc(g,nout,getst,period) + k=1; + f=@proc_nnn; + + function varargout=proc_nnn(varargin) + varargout=cell(1,nout+1); + [varargout{1:nout}]=g(varargin{:}); + if k==1, + k=period; + varargout{nout+1}={getst()}; + else + k=k-1; + varargout{nout+1}={}; + end + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@estates/estates.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +% estates - sample states of given arrow and supply as extra output EVENT +% +% estates :: +% arrow( A, B, C) ~'arrow from A to B with states of C', +% natural ~'factor by which to subsample states' +% -> arrow( A, [B, {box(C)}], C). +function o=estates(a,period) + s.base=a; + s.period=period; + o=class(s,'estates',arrow(nargin(a),nargout(a)+1)); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@estates/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('estates(%s,%d)',tostring(a.base),a.period);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@imager/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,41 @@ +function u=construct(s,sizes_in) + acquire(s); + figure(fig(s)); set(gcf,'Name',name(s)); + + X=nan(sizes_in{1}); + + if isfield(s.opts,'xdom') || isfield(s.opts,'ydom') + xdom=getparam(s.opts,'xdom',[1,size(X,2)]); + ydom=getparam(s.opts,'ydom',[1,size(X,1)]); + h=s.opts.imagefn(xdom,ydom,X,s.opts.args{:}); + else + h=s.opts.imagefn(X,s.opts.args{:}); + end + if isfield(s.opts,'clickthru') && s.opts.clickthru + parent=get(h,'Parent'); + set(h,'ButtonDownFcn',@clickthru); + end + + if ~isempty(s.opts.xlim), xlim(s.opts.xlim); end + if ~isempty(s.opts.ylim), ylim(s.opts.ylim); end + if isfield(s.opts,'ylabel'), ylabel(s.opts.ylabel); end + if isfield(s.opts,'xlabel'), xlabel(s.opts.xlabel); end + if getparam(s.opts,'colorbar',0), colorbar; end + if ~isempty(s.opts.clim) caxis(s.opts.clim); end + if ~isempty(s.opts.colormap), colormap(s.opts.colormap); end + + u=mkunit(s); + if autoflush(s), u.process =@proc_flush; + else u.process=@proc_noflush; end + + u.sizes_out = {}; + u.dispose = @dispose; + + function dispose, delete(h); release(s); end + function proc_flush(x), set(h,'CData',x); drawnow; end + function proc_noflush(x), set(h,'CData',x); end + function clickthru(a,b) + fn=get(parent,'ButtonDownFcn'); + if ~isempty(fn), fn(a,b); end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@imager/imager.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +% imager - Unit for displaying images +% +% imager :: options { +% xdom :: [[_]->real] / [] ~'x-vals for pixel centres'; +% ydom :: [[_]->real] / [] ~'y-vals for pixel centres'; +% xlim :: [[1,2]] / [] ~'passed to xlim if not empty'; +% ylim :: [[1,2]] / [] ~'passed to ylim if not empty'; +% clim :: [[_]->real] / [] ~'passed to caxis if not empty'; +% xlabel :: string / [] ~'passed to xlabel if not empty'; +% ylabel :: string / [] ~'passed to ylabel if not empty'; +% imagefn :: imagefn / @imagexy ~'function to create image'; +% colormap :: [[N,3]] /[] ~'if not empty, colormap to install'; +% clickthru :: bool / 0 ~'if 1, button clicks passed to parent'; +% args :: {[_]} / {} ~'extra arguments for imagefn' +% } -> arrow({[[M,N]]}, {}, empty) ~'arrow from 2D arrays'. +% +% imager is an arrow which displays each input array as an image +% using imagexy by default. The essential thing about imager is that +% the graphics must be updated by setting the 'CData' property of +% the handle graphics object returned by the imaging function. + +function o=imager(varargin) + s.opts=prefs('dlim',[],'xlim',[],'ylim',[],'clim',[],'colormap',[],'imagefn',@imagexy,'args',{},varargin{:}); + if isempty(s.opts.clim), s.opts.clim=s.opts.dlim; end + o=class(s,'imager',agraph(1,s.opts)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@imager/private/imagexy.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function H=imagexy(varargin) +% IMAGEXY - Just like imagesc but with axis xy + +h=imagesc(varargin{:}); +if nargout>0, H=h; end +axis xy;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@imager/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('imager<%s>',tostring(a.agraph));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@loop/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,18 @@ +function u=construct(s,sizes_in) + u=mkunit(s); + state=s.s0(sizes_in{1}); fn=s.fn; + u.sizes_out = guess_sizes(fn,sizes_in,state); + u.get_state = @get_state; + u.set_state = @set_state; + u.process = @proc; + + function out=proc(in), [out,state]=fn(in,state); end + function s=get_state, s=state; end + function set_state(s), state=s; end +end + +function sz_out=guess_sizes(fn,sz_in,st) + [out,s1] = fn(zeros(sz_in{1}),st); + sz_out = {size(out)}; +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@loop/loop.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,13 @@ +% loop - Looping feedback arrow for stateful arrows. +% +% loop :: +% (A, S -> B, S) ~'function to map input and state to output and next state', +% (size -> S0:S) ~'function to map size of input to initial state' +% -> arrow({A},{B},S) ~'arrow from A to B with state of type S'. + +function o=loop(fn,s0) + if nargin<1, fn=@(a,b)deal(a,b); s0=[]; end + s.fn=fn; s.s0=s0; + o=class(s,'loop',arrow(1,1)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@loop/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('loop(%s)',tostring(a.fn));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@loop1/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +function u=construct(s,sizes_in) + u=mkunit(s); + nout=nargout(s); + + [fn,state]=s.init(sizes_in{:}); + u.sizes_out = guess_sizes(fn,nout,sizes_in,state); + u.get_state = @get_state; + u.set_state = @set_state; + u.process = ifx(nout>0,@proc,@proc0); + + function s=get_state, s=state; end + function set_state(s), state=s; end + function varargout=proc(varargin) + [varargout{1:nout},state]=fn(varargin{:},state); + end + function varargout=proc0(varargin) + state=fn(varargin{:},state); + end +end + +function sz_out=guess_sizes(fn,nout,sz_in,st) + ins = map(@zeros,sz_in); + if nout==0, s1=fn(ins{1},st); outs={}; + else [outs{1:nout},s1] = fn(ins{:},st); end + sz_out = map(@size,outs); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@loop1/loop1.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,21 @@ +% loop1 - Looping feedback arrow for stateful arrows. +% +% loop1 :: +% N:natural ~'number of inputs for this arrow', +% M:natural ~'number of outputs for this arrow', +% ({[N]->size} -> ([A:arglist(N), {S}] -> [B:arglist(M), {S}])) +% ~'function to map input sizes to state transformer', +% ({[N]->size} -> S0:S) ~'function to map size of input to initial state' +% -> arrow(A,B,S) ~'arrow from A to B with state of type S'. + +function o=loop1(nin,nout,initfn) + if nargin<1, + nin=1; nout=1; + initfn=@(sz)deal(@(a,b)deal(a,b),[]); + end + s.init=initfn; + s.nin=nin; + s.nout=nout; + o=class(s,'loop1',arrow(nin,nout)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@loop1/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('loop1(%s)',tostring(a.init));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@mousepos/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,46 @@ +function u=construct(s,sizes_in) + fg=fig(s); figure(fg); + ax=gca; + + current_pos=get(ax,'CurrentPoint'); + + if ~isempty(s.opts.xlim), xlim(s.opts.xlim); end + if ~isempty(s.opts.ylim), xlim(s.opts.ylim); end + if isfield(s.opts,'ylabel'), ylabel(s.opts.ylabel); end + if isfield(s.opts,'xlabel'), xlabel(s.opts.xlabel); end + if isfield(s.opts,'box'), box(s.opts.box); end + + u=mkunit(s); + u.process=@proc; + u.sizes_out = {[2,1]}; + u.dispose = @dispose; + u.starting = @starting; + u.stopping = @stopping; + + function starting + set(ax,'ButtonDownFcn',@btndown); + set(fg,'WindowButtonMotionFcn',[]); + end + + function stopping + set(ax,'ButtonDownFcn',[]); + set(fg,'WindowButtonMotionFcn',[]); + end + + function x=proc, + % pos=get(ax,'CurrentPoint'); + x=current_pos(1,1:2)'; + end + + function btndown(a,b), + set(fg,'WindowButtonMotionFcn',@move,'WindowButtonUpFcn',@btnup); + current_pos=get(ax,'CurrentPoint'); + end + function btnup(a,b), set(fg,'WindowButtonMotionFcn',[]); end + function move(a,b), current_pos=get(ax,'CurrentPoint'); end + + function dispose + set(ax,'ButtonDownFcn',[]); + set(fg,'WindowButtonMotionFcn',[]); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@mousepos/fig.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function f=fig(s), f=s.opts.fig;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@mousepos/mousepos.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,20 @@ +% mousepos - Arrow that tracks the mouse position in some axes. +% +% mousepos :: +% options { +% fig :: handles / gcf ~'figure to track'; +% xlim :: [[1,2]] / [] ~'if not empty, set X limits of axes'; +% ylim :: [[1,2]] / [] ~'if not empty, set Y limits of axes' +% } +% -> arrow({},[[2,1]]),empty). +% +% The output of the mousepos arrow is a two element column vector +% containing the X and Y coordinates of the current point in axes +% coordinates. + +function o=mousepos(varargin) + s.opts=prefs('fig',[],'xlim',[],'ylim',[],varargin{:}); + if isempty(s.opts.fig), s.opts.fig=gcf; end + o=class(s,'mousepos',arrow(0,1)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@mousepos/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('mousepos<fig:%d>',a.opts.fig);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@plotter/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,48 @@ +function u=construct(s,sizes_in) + acquire(s); + eff_size=sizes_in{1}; + if s.opts.transpose, eff_size = eff_size([2,1]); end + if isempty(s.opts.dom), dom=1:eff_size(1); else dom=s.opts.dom; end + figure(fig(s)); set(gcf,'Name',name(s)); + + if s.opts.transpose, pre=@transpose; else pre=@id; end + if isempty(dom) + h=s.opts.plotfn(pre(zeros(sizes_in{1})),s.opts.args{:}); + else + h=s.opts.plotfn(dom,pre(zeros(sizes_in{1})),s.opts.args{:}); + end + + if isempty(s.opts.xlim) && numel(dom)>1, s.opts.xlim=[dom(1),dom(end)]; end + if ~isempty(s.opts.ylim), ylim(s.opts.ylim); end + if ~isempty(s.opts.xlim), xlim(s.opts.xlim); end + if isfield(s.opts,'ylabel'), ylabel(s.opts.ylabel); end + if isfield(s.opts,'xlabel'), xlabel(s.opts.xlabel); end + + u=mkunit(s); + if length(h)==1 + if autoflush(s), u.process =@proc_flush; + else u.process=@proc_noflush; end + else + af=autoflush(s); + u.process =@proc_mat; + end + + u.sizes_out = {}; + u.dispose = @dispose; + + function dispose, delete(h); release(s); end + function proc_flush(x), set(h,'YData',pre(x)); drawnow; end + function proc_noflush(x), set(h,'YData',pre(x)); end + function proc_mat(x), + if s.opts.transpose + for i=1:length(h) + set(h(i),'YData',x(i,:)'); + end + else + for i=1:length(h) + set(h(i),'YData',x(:,i)); + end + end + if af, drawnow; end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@plotter/plotter.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,23 @@ +% plotter - Arrow for doing plots. +% +% plotter :: options { +% dom :: [[N]->nonneg] / (1:N) ~'X values for plots'; +% ylim :: [[_]->nonneg] / [] ~'passed to ylim if not empty'; +% xlim :: [[_]->nonneg] / [] ~'passed to xlim if not empty'; +% xlabel :: [[_]->nonneg] / [] ~'passed to xlabel if not empty'; +% ylabel :: [[_]->nonneg] / [] ~'passed to ylabel if not empty'; +% plotfn :: plotfn / @plot ~'function to create image'; +% args :: {[_]} / {} ~'extra arguments for plotfn' +% } -> arrow({[[N,M]]}, {}, empty) ~'arrow from 2D arrays'. +% +% plotter is an arrow which displays each input array as line plots +% using plot by default. The essential thing about plotter is that +% the graphics must be updated by setting the 'YData' property of +% the handle graphics object returned by the plotting function. + +function o=plotter(varargin) + s.opts=prefs('dlim',[],'dom',[],'ylim',[],'xlim',[],'plotfn',@plot,'args',{},'tranpose',0,varargin{:}); + if isempty(s.opts.ylim), s.opts.ylim=s.opts.dlim; end + o=class(s,'plotter',agraph(1,s.opts)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@plotter/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('plotter<%s>',tostring(a.agraph));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@rgbimager/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +function u=construct(s,sizes_in) + figure(fig(s)); + + xl=s.opts.xlim; + yl=s.opts.ylim; + X=zeros(sizes_in{1}); + + if isempty(xl) && isempty(yl) + h=image(X,s.opts.args{:}); + else + if isempty(xl) xl=[1,size(X,2)]; end + if isempty(yl) yl=[1,size(X,1)]; end + h=image(xl,yl,X,s.opts.args{:}); + end + if isfield(s.opts,'ylabel'), ylabel(s.opts.ylabel); end + if isfield(s.opts,'xlabel'), xlabel(s.opts.xlabel); end + + u=mkunit(s); + if autoflush(s), u.process =@proc_flush; + else u.process=@proc_noflush; end + + u.sizes_out = {}; + u.dispose = @()delete(h); + + function proc_flush(x), set(h,'CData',x); drawnow; end + function proc_noflush(x), set(h,'CData',x); end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@rgbimager/rgbimager.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,20 @@ +% rgbimager - Unit for displaying rgbimages +% +% imager :: options { +% xlim :: [[_]->real] / [] ~'passed to xlim if not empty'; +% ylim :: [[_]->real] / [] ~'passed to ylim if not empty'; +% xlabel :: string / [] ~'passed to xlabel if not empty'; +% ylabel :: string / [] ~'passed to ylabel if not empty'; +% args :: {[_]} / {} ~'extra arguments for imagefn' +% } -> arrow({[[M,N]]}, {}, empty) ~'arrow from 2D arrays'. +% +% imager is an arrow which displays each input array as an image +% using imagexy by default. The essential thing about imager is that +% the graphics must be updated by setting the 'CData' property of +% the handle graphics object returned by the imaging function. + +function o=imager(varargin) + s.opts=prefs('xlim',[],'ylim',[],'args',{},varargin{:}); + o=class(s,'rgbimager',agraph(1,s.opts)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@rgbimager/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('rgbimager<%s>',tostring(a.agraph));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@scatterer/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,30 @@ +function u=construct(s,sizes_in) + figure(fig(s)); cla; set(gcf,'Name',name(s)); + h=s.opts.scatfn(zeros(sizes_in{1}),s.opts.args{:}); + if ~isempty(s.opts.xlim), xlim(s.opts.xlim); end + if ~isempty(s.opts.ylim), ylim(s.opts.ylim); end + if ~isempty(s.opts.zlim), zlim(s.opts.zlim); end + if isfield(s.opts,'ylabel'), ylabel(s.opts.ylabel); end + if isfield(s.opts,'xlabel'), xlabel(s.opts.xlabel); end + if isfield(s.opts,'zlabel'), xlabel(s.opts.zlabel); end + if isfield(s.opts,'rotate3d'), rotate3d(s.opts.rotate3d); end + + + u=mkunit(s); + af=autoflush(s); + if sizes_in{1}(2)<=2 u.process =@proc_2d; + else u.process =@proc_3d; + end + + u.sizes_out = {}; + u.dispose = @()delete(h); + + function proc_2d(x) + set(h,'XData',x(:,1),'YData',x(:,2)); + if (af), drawnow; end + end + function proc_3d(x) + set(h,'XData',x(:,1),'YData',x(:,2),'ZData',x(:,3)); + if (af), drawnow; end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@scatterer/scatterer.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,17 @@ +% scatterer - Arrow for doing scatter plots. +% +% scatterer :: options { +% xlim :: [[_]->nonneg] / [] ~'passed to xlim if not empty'; +% ylim :: [[_]->nonneg] / [] ~'passed to ylim if not empty'; +% xlabel :: [[_]->nonneg] / [] ~'passed to xlabel if not empty'; +% ylabel :: [[_]->nonneg] / [] ~'passed to ylabel if not empty'; +% args :: {[_]} / {} ~'extra arguments for scat' +% } -> arrow({[[N,M]]}, {}, empty) ~'arrow from 2D arrays'. +% +% scatterer is an arrow which displays input on scatter (xy) plot. + +function o=scatterer(varargin) + s.opts=prefs('xlim',[],'ylim',[],'zlim',[],'scatfn',@scat,'args',{},varargin{:}); + o=class(s,'scatterer',agraph(1,s.opts)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@scatterer/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('scatterer<%s>',tostring(a.agraph));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@states/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,18 @@ +function u=construct(s,sizes_in) + + u=construct(s.base,sizes_in); + s0=u.get_state(); + u.sizes_out = [u.sizes_out,size(s0)]; + u.process = mkproc(u.process, nargout(s.base), u.get_state); +end + +function f=mkproc(g,nout,getst) + f=@proc_nnn; + + function varargout=proc_nnn(varargin) + varargout=cell(1,nout+1); + [varargout{1:nout}]=g(varargin{:}); + varargout{nout+1}=getst(); + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@states/states.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,9 @@ +% states - sample states of given arrow and supply as extra output +% +% states :: +% arrow(A, B, C) ~'arrow with state type C' +% -> arrow(A, [B,{C}], C). ~'arrow with extra output of type C +function o=states(a) + s.base=a; + o=class(s,'states',arrow(nargin(a),nargout(a)+1)); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@states/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('states(%s)',tostring(a.base));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@unfolder/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,18 @@ +function u=construct(s,sizes_in) + u=mkunit(s); + state=s.s0; fn=s.fn; + u.sizes_out = guess_sizes(fn,state); + u.get_state = @get_state; + u.set_state = @set_state; + u.process = @proc; + + function out=proc, [out,state]=fn(state); end + function s=get_state, s=state; end + function set_state(s), state=s; end +end + +function sz_out=guess_sizes(fn,st) + [out,s1] = fn(st); + sz_out = {size(out)}; +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@unfolder/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('unfolder(%s)',tostring(a.fn));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@unfolder/unfolder.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +% unfolder - unfolding arrow +% +% unfolder :: +% (S -> B, S) ~'function to state to output and next state', +% S ~'initial state' +% -> arrow({},{B},S) ~'arrow from A to B with state of type S'. + +function o=unfolder(fn,s0) + s.fn=fn; s.s0=s0; + o=class(s,'unfolder',arrow(0,1)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@vplotter/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,30 @@ +function u=construct(s,sizes_in) + figure(fig(s)); set(gcf,'Name',name(s)); + h=s.opts.plotfn(zeros(1,1),s.opts.args{:}); + if ~isempty(s.opts.ylim), ylim(s.opts.ylim); end + if ~isempty(s.opts.xlim), xlim(s.opts.xlim); end + if isfield(s.opts,'ylabel'), ylabel(s.opts.ylabel); end + if isfield(s.opts,'xlabel'), xlabel(s.opts.xlabel); end + + u=mkunit(s); + if length(h)==1 + if autoflush(s), u.process =@proc_flush; + else u.process=@proc_noflush; end + else + af=autoflush(s); + u.process =@proc_mat; + end + + u.sizes_out = {}; + u.dispose = @()delete(h); + + function proc_flush(x), set(h,'XData',1:length(x),'YData',x); drawnow; end + function proc_noflush(x), set(h,'XData',1:length(x),'YData',x); end + function proc_mat(x), + dom=1:size(x,1); + for i=1:length(h) + set(h(i),'XData',dom,'YData',x(:,i)); + end + if af, drawnow; end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@vplotter/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(a) + s=sprintf('vplotter<%s>',tostring(a.agraph));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/@vplotter/vplotter.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,21 @@ +% vplotter - Arrow for doing variable length plots. +% +% vplotter :: options { +% ylim :: [[_]->nonneg] / [] ~'passed to ylim if not empty'; +% xlim :: [[_]->nonneg] / [] ~'passed to xlim if not empty'; +% xlabel :: [[_]->nonneg] / [] ~'passed to xlabel if not empty'; +% ylabel :: [[_]->nonneg] / [] ~'passed to ylabel if not empty'; +% plotfn :: plotfn / @plot ~'function to create image'; +% args :: {[_]} / {} ~'extra arguments for plotfn' +% } -> arrow({[[N,M]]}, {}, empty) ~'arrow from 2D arrays'. +% +% vplotter is an arrow which displays each input array as line plots +% using plot by default. The essential thing about plotter is that +% the graphics must be updated by setting the 'YData' property of +% the handle graphics object returned by the plotting function. + +function o=vplotter(varargin) + s.opts=prefs('ylim',[],'xlim',[],'plotfn',@plot,'args',{},varargin{:}); + o=class(s,'vplotter',agraph(1,s.opts)); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/abufsig.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,45 @@ +% abufsig - Arrow which produces multiple buffered frames from a signal +% +% abufsig :: +% signal(C,R), +% N:natural ~'block size', +% M:natural ~'hop size', +% L:natural ~'buffer width' +% -> arrow({},{[[N*C,L]]}). +% +% abufsig :: +% signal(C,R), +% N:natural ~'block size', +% M:natural ~'hop size' +% -> arrow({},{[[N*C,1]]]}). +% +% abufsig :: +% signal(C,R), +% N:natural ~'block size', +% -> arrow({},{[[C*N,1]]]}). +% +% If hop size is omitted, it defaults to the block size. +% If buffer width is omitted, it defaults to 1. + +function o=abufsig(source,block,hop,width) + if nargin<4, width=1; end + if nargin<3, hop=block; end + + ch=channels(source); + if (mod(block,ch)>0 || mod(hop,ch)) + error('Block size and hop must be a multiple of channel count'); + end + + if width==1, + o=asignal(source,block/ch,hop/ch)*arr(@flt); + else + olap = block-hop; + span = (hop*(width-1)+block); + jump = (hop*width); + o=asignal(source,span/ch,jump/ch)*arr(@buf); + end + + function y=flt(x), y=x(:); end + function y=buf(x), y=buffer(x(:),block,olap,'nodelay'); end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/abufsink.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +% abufsink - output arrow using sink object +% +% abufsink :: +% sink(C,R) ~'signal sink' +% -> arrow({[[N,L]]]},{},empty). +% +% abufsink :: +% sink(C,R) ~'signal sink' +% [[M]->[N]] ~'array of indices into input to select samples to send' +% -> arrow({[[N,L]]]},{},empty). +% +% This unit will accept vectors of any size and send them to an audio output +% device or destination. +% +function o=abufsink(sink,window) + if nargin<2, window=[]; end + ch=channels(sink); + if isempty(window) + o=arr(@rshp)*asink(sink); + else + o=arr(@wnd)*asink(sink); + end + + function y=rshp(x), y=reshape(x,ch,[]); end + function y=wnd(x), y=reshape(x(window,:),ch,[]); end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/adata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +% adata - Arrow to generate stream from lazy sequence object +% +% adata :: seq(A) -> arrow( {}, {A}, seq(A)). +function a=adata(X) + a=unfolder(@decons1,X); +end + +function [h,t]=decons1(x) + if isempty(x), error('ARROW:EOF','End of data sequence'); end + [h,t]=decons(x); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/additive_split.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,30 @@ +% additive_split - Arrow to process data with adaptive zero mean +% +% additive_split :: +% arrow( {[N,M]}, {[N,M]}, S1) ~'arrow to process N channel zero mean data', +% arrow( {[N]}, {[N]}, S2) ~'arrow to process estimated mean', +% options {} ~'options passed to azeromean' +% -> arrow( {[N,M]}, {[N,M]}, pair( pair([N],pair(S1,S2)), empty)). +% +% This arrow uses the azeromean arrow to adaptively estimate the mean of +% the N channels of input data, using a gaussian data model. The mean is +% subtracted out. The two components are then processed independently by +% the two supplied arrows and added together to create the output. + +function o=additive_split(a1,a2,varargin) + opts=prefs(varargin{:}); + + o = states(azeromean(gaussian,opts))*(a1+a2)*aplus; +end + +function o=aplus, o=arrf(@plusfn,2,1); end +function f=plusfn(sz) + if all(sz{1}==sz{2}), f=@plus; + elseif sz{1}(1)==sz{2}(1) && sz{1}(2)>sz{2}(2) + f=@(a,b)a+repmat(b,1,size(a,2)); + elseif sz{1}(1)==sz{2}(1) && sz{1}(2)<sz{2}(2) + f=@(a,b)b+repmat(a,1,size(b,2)); + else + error('additive_split:incompatible sizes'); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/aeig.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,16 @@ +% aeig - Arrow for eigenvalue/vector decomposition +% +% aeig :: N:natural, I:[[M]->[N]] -> arrow( {[[N,N]]}, {[[N,M]], [[M]]}, empty). +function o=aeig(N,I) + J=(1+N)-I; + o=arr(@eigsI,'sizefn',@(sz){[N,length(I)],[length(I),1]}); + + function [V,d]=eigsI(A) + [V,D]=eig(A.cov); + V=V(:,J); + d=diag(D); + d=d(J); + end +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/afield.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,9 @@ +% afield - arrow to extract named field from structure +% +% afield :: N:string ~'field name' -> arrow({struct{N::T;}, {T}, empty). +% +% If input is structure with a field named N of type T, +% the single output is of type T. +function o=afield(nm,sz) + o=arr(@(x)getfield(x,nm),'sizefn',@(s){sz}); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/agen.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,17 @@ +% agen - Arrow to generate signal using generator object +% +% agen :: +% gen(S) ~'generator with state of type S', +% N:natural ~'size of output blocks', +% S ~'initial state', +% M:natural ~'number of parameters for generator' +% -> arrow({[M]},{[[N]]},agen_state). + +function o=agen(gen,n,s0,nin) + o=loop(@next,@(sz)s0); + + function [y,s2]=next(x,s1) + [y,s2]=block(gen,s1,n,x); + y=y'; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/aica.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,22 @@ +% aica - ICA +% +% aica :: +% model(real) ~'probability model for components', +% [[N,N]] ~'initial weight matrix', +% options { +% rate :: nonneg/1e-4 ~'adaptation rate'; +% } +% -> arrow({[[N]]},{[[N]]},aica_state). + +function o=aica(model,W0,varargin) + opts=prefs('rate',1e-4,varargin{:}); + score=scorefn(model); + + rate=opts.rate; + o=loop(@update,@(s)W0); + + function [y,W]=update(x,W) +% y=W'*x; W=W+rate*(W-(W*y)*score(y)'); + y=W*x; W=W+rate*(W-(score(y)/size(y,2))*(y'*W)); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/aid.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +% aid - Arrow that passes one input straight to its output +% +% aid :: arrow({A},{A},empty). +% +% Basically, aid = arr(@id). +function a=aid, a=arr(@id);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/ainsert.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,13 @@ +% ainsert - Arrow which does whatever you write in the text box +% +% ainsert :: expr(arrow(A,B,S)) -> arrow(A,B,S). +% +% expr(T) denotes the type of strings which evaulate to a value of type T. +% This arrow provides a text box initialised to the given string. +% The arrow behaves like the arrow created by evaluating the expression. +% You can type a new expression at any time and the arrow will switch +% behaviour. + +function o=ainsert(a0,varargin) + o=(aid + esender('init',a0,varargin{:}))*aswitch(evalin('base',a0)); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/alatch.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +% alatch - Arrow which produced the value in the last event received. +% +% alatch :: A -> arrow( {box(A)}, {A}, A). +function o=alatch(x0) + o=loop(@upd,@(sz)x0); +end + +function [y,s]=upd(x,s) + if iscell(x) && ~isempty(x), s=x{end}; end + y=s; +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/alinein.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,19 @@ +% linein - Audio input arrow +% +% linein :: +% nonneg ~'sampling rate', +% N:natural ~'block size', +% M:natural ~'hop size', +% options { +% channels :: natural/1 ~'number of audio channels'; +% width :: natural/1 ~'number of frames per buffer'; +% bufsize :: natural/[] ~'desired line buffer size' +% } +% -> arrow({},{[[N,W]}},empty). +% +% Default buffer size is N+M*opts.width for low latency. + +function a=linein(rate,block,hop,varargin) + opts=prefs('channels',1,'width',1,varargin{:}); + opts.bufsize=getparam(opts,'bufsize',block+hop*opts.width); + a=audioin(linesource(opts.channels,rate,opts),block,hop,opts.width);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/amatrix.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,19 @@ +% amatrix - arrow to generate sequence by scanning through an array +% +% amatrix :: [[N,M]] -> arrow({},{[[N]]},1..M). +function o=amatrix(X) + state=1; + len=size(X,2); + o=unfolder(@sfn1,state); + + function [x,S]=sfn(S) + x=X(:,S); + S=1+mod(S,len); + end + + function [x,S]=sfn1(S) + if S>len, error('ARROW:EOF','End of arrow sequence'); end + x=X(:,S); + S=S+1; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/amult.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +% amult - Arrow to (pre)multiply inputs by a constant. +% +% amult :: [[N,M]] -> arrow( {[[M,L]]}, {[[N,L]]}, empty). +function o=amult(k), o=arr(@(x)k*x); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/anull.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +% asink - Do nothing absorbing arrow +% +% asink :: N:natural -> arrow(_:arglist(N),{},empty). +function a=asink(nin) + if nargin<1, nin=1; end + a=arr(@nop,'nargin',nin,'nargout',0); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/aolapadd.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,52 @@ +function o=aolapadd(N,hop) +% aolapadd - overlap-and-add signal reconstruction arrow +% +% aolapadd :: +% N:natural ~'frame size', +% M:natural ~'hop size' +% -> arrow( {[[N]]}, {[[M]]}, [[N-M]]). + + + I=1:hop; + ol=N-hop; + + o=loop1(1,1,@olapadd); + + function [fn,s0]=olapadd(sz) + s0=zeros(ol,1); + if ol<=hop, J=1:ol; K=hop+1:N; fn=ifx(sz(2)==1,@st1,@st2); + else J=hop+1:ol; K=ol+1:N; fn=ifx(sz(2)==1,@st3,@st4); + end + + function [y,s]=st1(x,s) + y=x(I); + y(J)=y(J)+s; + s=x(K); + end + + function [y,s]=st2(x,s) + width=size(x,2); + y=zeros(hop,width); + for i=1:width + y(:,i)=x(I,i); + y(J,i)=y(J,i)+s; + s=x(K,i); + end + end + + function [y,s]=st3(x,s) + y=(s(I)+x(I)); + s=[s(J)+x(J);x(K)]; + end + + function [y,s]=st4(x,s) + width=size(x,2); + y=zeros(hop,width); + for i=1:width + y(:,i)=(s(I)+x(I,i)); + s=[s(J)+x(J,i);x(K,i)]; + end + end + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/arrow_repl.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,63 @@ +% arrow_repl - Instantiate arrow system and drop into REPL. +% +% arrow_repl :: +% arrow(_:arglist(N),_:arglist(M),S) ~'arbitrary arrow', +% {[N]->size} ~'sizes of inputs' +% options { +% gui :: boolean/false ~'create Java GUI for viewables' +% } +% -> _. +% +% This function provides a command line with access to a live +% system instantiated from the given arrow. The command line +% has the prompt 'unit>> ' to distinguish it from the normal +% Matlab prompt, but in other respects, is the same. The only +% commands that function differently are 'quit' and 'exit', +% which are trapped and behave as 'return' does, returning control +% to this function. Arbitrary values can be returned through to +% the called of arrow_repl using ret, eg +% unit>> ret(get_state(),45); +% returns two values: the current state of the system and the +% value 45. +% +% The environment contains the following variables of interest: +% sys :: arrow(A,B,S). % the original arrow +% unit :: unit(A,B,S). % the live processing unit +% get_state :: () -> S. % returns the state of the system +% set_state :: S -> action (). % sets the state of the system +% +% Other useful functions which can operate on the live unit +% are: ugather, uiterate, ufold and utransfer. + + +function varargout=arrow_repl(sys,sizes_in,varargin) + opts = prefs('gui',0,varargin{:}); + [varargout{1:nargout}]=with_arrow(sys,@unit_repl,sizes_in,opts,'keyboard',0,'pause',0); + + function varargout=unit_repl(unit) + returns={}; + try + fprintf('\n\nEntering REPL. Type "return","exit", or "quit" to finish.\n'); + fprintf('The function ret(..) sets return values.\n\n'); + cont=true; + while cont, + str=input('unit>> ','s'); + if strcmp(str,'quit') break; end + if strcmp(str,'exit') break; end + if strcmp(str,'return') break; end + try, eval(str) + catch ex + fprintf('\n%s\n',getReport(ex)); + end + end + catch ex + if ~isempty(uihandles), delete(uihandles); end + rethrow(ex); + end + varargout=returns; + + function set_state(s), unit.set_state(s); end + function s=get_state, s=unit.get_state(); end + function ret(varargin), returns=varargin; cont=false; end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/arrow_sched.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,126 @@ +% arrow_sched - Instantiate arrow system to run on background timer and drop into REPL. +% +% arrow_sched :: +% arrow({},_,_) ~'arbitrary arrow with no inputs', +% nonneg ~'period of timer', +% options { +% sched_fig :: handle /0 ~'figure number for scheduler control UI'; +% draw :: boolean /false ~'do drawnow after each iteration'; +% exec_mode :: string / 'fixedSpacing' ~'timer execution mode' +% } +% -> {...}. +% +% This function provides a command line with access to a live +% system instantiated from the given arrow. The command line +% has the prompt 'with_sched>> ' to distinguish it from the normal +% Matlab prompt, but in other respects, is the same. The only +% commands that function differently are 'quit' and 'exit', +% which are trapped and behave as 'return' does, returning control +% to this function. Arbitrary values can be returned through to +% the called of arrow_repl using ret, eg +% unit>> ret(get_state(),45); +% returns two values: the current state of the system and the +% value 45. +% +% The environment contains the following variables of interest: +% sys :: arrow(A,B,S). % the original arrow +% unit :: unit(A,B,S). % the live processing unit +% sched :: struct. % scheduler structure (see rsched) +% +% The following functions are also available: +% get_state :: () -> S. % returns the state of the system +% set_state :: S -> action (). % sets the state of the system +% stop :: () -> action (). % stop processing in timer thread. +% start :: () -> action (). % start processing in timer thread. +% startat :: time -> action (). % start processing at given time (see nows). +% set_period :: nonneg -> action (). % set period of timer (stops and restarts) +% +% While running, the background thread calls unit.process() on each +% iteration, so the system must have zero inputs. It can have any +% number of outputs--these are all discarded while running. + +function varargout=arrow_sched(sys,period,varargin) + opts=prefs('sched_fig',0,'draw',0,'exec_mode','fixedSpacing','start',0,varargin{:}); + [varargout{1:nargout}]=with_arrow(sys,@with_sched,{},opts,'keyboard',0); + + function varargout=with_sched(unit) + if opts.draw, stepfn=@step_draw; else stepfn=@step; end + + returns={}; + uihandles=[]; + sched=rsched(stepfn,1,period,0,'onstart',@onstart,'onstop',@onstop,'defer',1); + try + set(sched.timer(),'ExecutionMode',opts.exec_mode); + if opts.sched_fig>0 + figure(opts.sched_fig); + uihandles=sched_ui(sched,12); + end + + fprintf('\n'); + if opts.start, + fprintf('\nStarting automatically as requested.\n'); + start; + end + + fprintf('\nEntering REPL. Type "return","exit", or "quit" to finish.\n'); + fprintf('The function ret(..) sets return values.\n\n'); + cont=true; + while cont, + str=input('with_sched>> ','s'); + if strcmp(str,'quit') break; end + if strcmp(str,'exit') break; end + if strcmp(str,'return') break; end + try, eval(str) + catch ex + fprintf('\n%s\n',getReport(ex)); + end + end + catch ex + if ~isempty(uihandles), delete(uihandles); end + if sched.isrunning(), sched.stop(); end + sched.dispose(); + rethrow(ex); + end + + if ~isempty(uihandles), delete(uihandles); end + if sched.isrunning(), sched.stop(); end + sched.dispose(); + varargout=returns; + + function step1 + if sched.isrunning(), error('Already running'); + else + unit.starting(); + unit.process(); + unit.stopping(); + end + end + + function set_period(d) + if sched.isrunning(), stop; set(sched.timer(),'Period',d); start; + else set(sched.timer(),'Period',d); end + end + + function startat(t), sched.startat(t); end + function start, sched.start(); end + function stop, sched.stop(); end + function set_state(s), unit.set_state(s); end + function s=get_state, s=unit.get_state(); end + function onstart(s,t,t0), unit.starting(); end + function onstop(s,t), unit.stopping(); end + function ret(varargin), returns=varargin; cont=false; end + function run_for(its) + set(sched.timer(),'TasksToExecute',its); + start; + end + + function [s,t0]=step(s,per,t0,dt), + unit.process(); + end + + function [s,t0]=step_draw(s,per,t0,dt) + unit.process(); + drawnow; + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/ascan.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +% ascan - Arrow to implement scanl. +% +% ascan :: ((A,S)->S), S -> arrow({A},{S},S). +function o=ascan(sfn,x0) + o=loop(@st,@(sz)x0); + function [y,s]=st(x,s), s=sfn(x,s); y=s; end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/asubsample.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,10 @@ +% asubsample - Arrow to subsample input sequence. +% +% asubsample :: natural -> arrow({A},{box(A)},natural). +function o=asubsample(N) + o=loop(@barrier,@(sz)0); + function [y,s]=barrier(x,s) + if s==0, y={x}; s=N-1; + else s=s-1; y={}; end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/asweep.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +% asweep - Arrow which writes inputs consecutively into a buffer +% +% asweep :: +% W:natural ~'width of buffer', +% A ~'a value to pad buffer with' +% -> arrow({[[N,1]->A]}, {[[N,W]->A]}, [[N,W]->A]). +% +% This arrow expects column vectors of some type A. It +% maintains an array of width W and writes the input +% vectors into its columns, starting at column 1 and +% increasing, wrapping round at column W. This can be +% used, eg to create a sweeping (not scrolling) line +% plot of the last W values of some signal: +% source * asweep(200,nan) * plotter +% +% See also awindow. + +function a=asweep(width,pad) + a=loop(@windowfn,@(sz){1,repmat(pad,sz(1),width)}); + function [out,st]=windowfn(in,st) + for i=1:size(in,2) + st{2}(:,st{1}) = in(:,i); + st{1} = 1+mod(st{1},width); + end + out=st{2}; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/atime.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,13 @@ +% atime - Arrow that counts time starting from zero +% +% atime :: arrow({},{[1]},pair(empty,real)). +% atime :: DT:real -> arrow({},{[1]},pair(empty,real)). +% +% If no parameters are supplied, time increases by 1 each iteration. +% If one parameter DT is supplied, time increases by DT each iteration. +function a=atime(dt) + if nargin<1, dt=1; end + a=const(dt) * integrate(0); +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/audio_bench.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,98 @@ +% audio_bench - put given arrow between audio input and output +% +% audio_bench :: +% N:natural ~'audio frame size', +% M:natural ~'audio hop size', +% list(string) ~'list of audio file names', +% arrow({[[N,W]]}, {[[N,W]]}, S) ~'arrow to process audio buffers', +% options { +% fs :: nonneg/22050 ~'audio sampling rate'; +% scope :: natural/0 ~'figure for waveform plot, 0 to disable'; +% batch :: natural/1 ~'width of buffers'; +% state :: S/[] ~'initialise with this state'; +% outbuf :: natural/2 ~'increase audio output buffer by this many frames'; +% run :: bool/0 ~'if true, run the arrow in arrow_sched'; +% start :: bool/1 ~'if running and true, start immediately'; +% period :: nonneg/0.003 ~'if running timer period in seconds'; +% liveaudio :: bool/0 ~'if true, ignore files and use live audio input'; +% } +% -> arrow( {}, {}, T) ~'arrow describing whole system', +% [[1,P]->[2]} ~'path to state S in overall state T', +% T, ~'final state if returned from repl'. +% +% This provides an environment for running an audio processing arrow. +% Audio is provided in NxW buffers where N is the frame length and W is determined +% by the batch options. Hop size is M. Audio is obtained from the given list of files. +% +% The processing arrow is initially run as fast as possible, but if the value in the +% 'output select' is changed from 1 to 2, output is played on audio output device. +% If it is set to 3, the original audio input is played unmodified. +% +% If the 'liveaudio' option is set, then the list of files is ignored and live audio +% input used instead. +% +% If 'run' is false, the arrow describing the system is returned, but if true, the +% system is instantiated using arrow_sched and the user dropped into the 'with_sched>>' +% interactive interpreter loop. The loop can be exitted by typing 'return' or 'ret(...)'. +% If 'ret(..)' is used, then the value supplied is returned as the second return value +% from audio_bench. + +function [o,path,r]=audio_bench(N,M,filelist,a,varargin) + opts=prefs('fs',22050,'period',0.003,'outbuf',3,'run',0,'start',1,'output',1, ... + 'scope',0,'state',[],'batch',1,'liveaudio',0,'playthru',0,'draw',1,varargin{:}); + + if opts.scope>0 + scope_sink=plotter('fig',opts.scope,'ylim',[-1,1]); + if 0 + if opts.batch>1 + scope1=obs_with(arr(@(t)t(:,1))*scope_sink); + else + scope1=obs_with(scope_sink); + end + else + %scope=@(a)a*arr(@(x1,x2)deal(x1,x2,[x1(:,1),x2(1:M,1)]),'nargout',3)*(aid+aid+scope_sink); + scope=@(a)a*arr(@scope_join)*(aid+aid+scope_sink); + end + else + scope=@id; + end + + fprintf('Creating audio source with %d files.\n',length(filelist)); + if opts.liveaudio + src=linein(1,opts.fs,'bufsize',4*N); + else + src=resamplex(opts.fs,map(@monofile,filelist),'bs',2^nextpow2(M*opts.batch)); + end + aout=abufsink(lineout(1,opts.fs,'bufsize',(opts.outbuf+opts.batch)*M),1:M); + + o= ( abufsig(src,N,M,opts.batch) ... + * dup * scope(a + aid)... + * (aid + aid + esender('init',num2str(opts.output),'fig',29,'name','output select')*arr(@selout))... + * aswitch(unbox(selout({opts.output}))) ... + ); + + path=[1,1,2,1]; % path to state of a in state of o + if ~isempty(opts.state), o=o^opts.state; disp('Initialising...'); end + if opts.run, + r=arrow_sched(o,opts.period,'start',opts.start); + else + r=[]; + end + + function [x1,x2,x3]=scope_join(x1,x2) + x3=[x1(1:M,1),x2(1:M,1)]; + end + + function o=selout(cn) + if ~iscell(cn) || isempty(cn), o={}; + else + switch cn{1} + case 1, o={anull+anull}; + case 2, o={aout+anull}; + case 3, o={anull+aout}; + otherwise, o={}; + end + end + end +end +function x=unbox(y), x=y{1}; end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/audio_bench1.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,51 @@ +% audio_bench - put given arrow between audio input and output +% +% audio_bench :: +% N:natural ~'audio frame size', +% M:natural ~'audio hop size', +% list(string) ~'list of audio file names', +% arrow({[[N,W]]}, {[[N,W]]}, S) ~'arrow to process audio buffers', +% options { +% fs :: nonneg/22050 ~'audio sampling rate'; +% scope :: natural/0 ~'figure for waveform plot, 0 to disable'; +% batch :: natural/1 ~'width of buffers'; +% state :: S/[] ~'initialise with this state'; +% outbuf :: natural/2 ~'increase audio output buffer by this many frames'; +% run :: bool/0 ~'if true, run the arrow in arrow_sched'; +% start :: bool/1 ~'if running and true, start immediately'; +% period :: nonneg/0.003 ~'if running timer period in seconds'; +% liveaudio :: bool/0 ~'if true, ignore files and use live audio input'; +% } +% -> arrow( {}, {}, T) ~'arrow describing whole system', +% [[1,P]->[2]} ~'path to state S in overall state T', +% T, ~'final state if returned from repl'. +% +% This provides an environment for running an audio processing arrow. +% Audio is provided in NxW buffers where N is the frame length and W is determined +% by the batch options. Hop size is M. Audio is obtained from the given list of files. +% +% The processing arrow is initially run as fast as possible, but if the value in the +% 'output select' is changed from 1 to 2, output is played on audio output device. +% If it is set to 3, the original audio input is played unmodified. +% +% If the 'liveaudio' option is set, then the list of files is ignored and live audio +% input used instead. +% +% If 'run' is false, the arrow describing the system is returned, but if true, the +% system is instantiated using arrow_sched and the user dropped into the 'with_sched>>' +% interactive interpreter loop. The loop can be exitted by typing 'return' or 'ret(...)'. +% If 'ret(..)' is used, then the value supplied is returned as the second return value +% from audio_bench. + +function [o,path]=audio_bench(N,M,filelist,a,varargin) + opts=prefs('fs',22050,'batch',1,'liveaudio',0,varargin{:}); + + fprintf('Creating audio source with %d files.\n',length(filelist)); + if opts.liveaudio + src=linein(1,opts.fs,'bufsize',4*N); + else + src=resamplex(opts.fs,map(@monofile,filelist),'bs',2^nextpow2(M*opts.batch)); + end + o= abufsig(src,N,M,opts.batch) * a; + path=[2]; % path to state of a in state of o +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/audio_norm.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,31 @@ +% audio_norm - Arrow to do audio loudness normalisation using arbitrary estimator +function o= audio_norm(src,fs,N,M,W,Lag,dynorm,varargin) + opts=prefs('spectra',1,'lim',[-6,-1],'play',0,varargin{:}); + + if opts.spectra, + spectra=@(f,clim)obs_with(aspectrum(N)*arr(@log10)*imager('clim',clim,'fig',f)); + else + spectra=@(f,clim)aid; + end + + if opts.play + player = arr(@(x)flatten(x(1:M,:))) * audioout(linesink(1,fs)); + else + player = aid; + end + + o = audioin(src,N,M,W) ... + * spectra(13,[-11,1]) ... + * dup * ( ... + arr(@flatten)*dup*( ... + arr(@(t)log(mean(abs(t))))*delay(Lag-1,nan) ... % instantaneous log scale + + dynorm(Lag) ... % estimated log scale + ) ... + * arr(@(a,b)[a;b]) ... % combine + * obs_with(scope(128,'fig',11,'ylim',opts.lim)) ... % plot both on top of each other + * arr(@(t)t(2)) ... % pick out dynorm_lap value + + delay(Lag-1,0) ... % delay audio same amount as scale signal + ) ... + * arr(@(ls,x)0.03*x*exp(-ls)) ... % divide audio buffer by scale + * spectra(15,[-6,6]) ... + * player;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/audioin.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function o=audioin(ch,rate,N,M,varargin), + if nargin<4, M=N; end + opts=prefs('width',1,varargin{:}); + o=abufsig(linein(ch,rate,opts),N,M,opts.width);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/audioout.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function o=audioout(ch,rate,varargin), + opts=prefs('window',[],varargin{:}); + o=abufsink(lineout(ch,rate,'pad',ceil(0.2*rate),opts),opts.window);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/audioplay.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,13 @@ +function a=audioplay(ch,rate,window,varargin) + if nargin<3, window=[]; end + opts=prefs('buffer',1,'queue',4,'dspargs',{},varargin{:}); + + a=asysobj(@(sz)dsp.AudioPlayer(rate,'BufferSizeSource','Property', ... + 'BufferSize', opts.buffer*sz{1}(1), ... + 'QueueDuration',opts.queue*sz{1}(1)/rate, ... + opts.dspargs{:}), ... + 1,0, @(sz){}); + + if ~isempty(window), a=arr(@(x)x(window,:))*a; end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/audiorec.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,25 @@ +function a=audiorec(ch,rate,N,M,varargin) + if nargin<4, M=N; end + opts=prefs('buffer',1,'queue',4,'dspargs',{},varargin{:}); + + a=asysobj(@(sz)dsp.AudioRecorder('OutputDataType','double','NumChannels',ch,'SampleRate',rate, ... + 'SamplesPerFrame',M,'BufferSizeSource','Property', ... + 'BufferSize', opts.buffer*M, ... + 'QueueDuration',opts.queue*M/rate, ... + opts.dspargs{:}), ... + 0,1,@(sz){[M,ch]}); + + if N>M + OL=M+1:N; + a=a*loop(@upd,@(sz)zeros(N-M,ch)); + elseif N<M + BLOCK=M-N+1:M; + a=a*arr(@(x)x(BLOCK,:)); + end + + function [y,s]=upd(x,s) + y=[s;x]; + s=y(OL,:); + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/awindow.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,23 @@ +% awindow - Maintain a sliding window of last few inputs +% +% awindow :: +% W:natural ~'width of buffer', +% A ~'a value to pad buffer with' +% -> arrow({[[N,1]->A]}, {[[N,W]->A]}, [[N,W]->A]). +% +% This arrow expects column vectors of some type A. It +% maintains an array of width W containing the last W +% inputs, with the latest input at the right edge. +% This can be used, eg to create a scrolling line +% plot of the last W values of some signal: +% source * awindow(200,nan) * plotter +% +% See also asweep. +function a=awindow(width,pad) + a=loop(@windowfn,@(sz)repmat(pad,sz(1),width)); + ix=2:width; + function [out,buf]=windowfn(in,buf) + buf=[buf(:,ix),in]; + out=buf; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/azeromean.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,45 @@ +% azeromean - additive normalisation arrow +% +% azeromean :: +% options { +% offset :: real /0 ~'initial offsets'; +% rate :: nonneg/1e-7 ~'offset adaptation rate'; +% tension :: real /0 ~'smoothing strength'; +% } +% -> arrow({[[N]]},{[[N]]},azeromean_state). + +function o=azeromean(model,varargin) + opts=prefs('offset',nan,'rate',1e-7,'tension',0,varargin{:}); + score=scorefn(model); + + rate=opts.rate; + if opts.tension>0 + tension=opts.tension; + o=loop(@update_t,@(s)repmat_to(opts.offset,[s(1),1])); + else + o=loop(@update,@(s)repmat_to(opts.offset,[s(1),1])); + end + + function [y,offset]=update(x,offset) + nans=isnan(offset); + offset(nans)=x(nans); + y = x-repmat(offset,1,size(x,2)); + offset = offset + rate*sum(score(y),2); + end + + function [y,offset]=update_t(x,offset) + nans=isnan(offset); + offset(nans)=x(nans); + w = size(x,2); + y = x; + for i=1:w + y(:,i)=y(:,i)-offset; + offset = offset + rate*(score(y(:,i))+reg(offset)); + end + end + + function g=reg(h) + zz=zeros(1,size(h,2)); + g=tension*[zz;diff(h,2,1);zz]; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/const.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +% const - arrow that always produces a constant value +% +% const :: A -> arrow({},{A},empty). +function a=const(x), a=arr(@()x);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/delay.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +% delay - arrow implementing a delay line +% +% delay :: +% W:natural ~'width of buffer', +% A ~'a value to pad delay line with' +% -> arrow({[[N,1]->A]}, {[[N,1]->A]}, {[W]->[[N]->A]}). + +function a=delay(n,pad) + a=loop(@delayfn,@(sz)repmat({repmat(pad,sz)},1,n)); + function [out,buf]=delayfn(in,buf) + out=buf{1}; + buf=[buf(2:end),{in}]; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/adct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,13 @@ +% adct - arrow for DCT +% +% adct :: M:natural -> arrow({[[N]]}, {[[M]]}, empty). +function o=adct(M) + o=arrf(@mkdct,1,1); + + function f=mkdct(sizes_in) + % take DCT size from size(1) of first input + W=row(dct(eye(sizes_in{1}(1))),M); + f=@(x)W*x; + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/adynfir.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,22 @@ +% adynfir - Apply dynamic FIR filter to input signal +% +% adynfir :: +% N:natural ~'number of FIR filter coefficients', +% M:natural ~'number of samples per input block' +% -> arrow({[[N]], [[M]]}, {[[M]]}, pair(empty,[[N-M]])). + +function o=adynfir(N,M) + + o=arr(@(f,u){f,u})*loop(@next,@(sz)zeros(N-1,1)); + + function [y,s2]=next(x,s) + if iscell(x) + u=[s;x{2}]; + y=conv2(u,x{1},'valid'); + s2=u(M+1:end); + else + y=zeros(M,1); + s2=s; + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/adyniir.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,25 @@ +% adyniir - Apply dynamic IIR filter to input signal +% +% adyniir :: arrow({[[K,N+1]], [[K,M]]}, {[[K,M]]}, [[K,N]]). +% +% N is the order of the IIR filter +% K is the number of independent channels to filter. +% M is the number of consecutive samples in input signal + +function o=adyniir + o=loop1(2,1,@(s1,s2)deal( ifx(s2(2)==1,@next1,@nextm), zeros(s1(1),s1(2)-1))); +end + + +function [y,yp]=next1(a,x,yp) + y=x-sum(a(:,2:end).*yp,2); + yp=[y,yp(:,1:end-1)]; +end + +function [y,yp]=nextm(a,x,yp) + M=size(x,2); + y=zeros(size(x)); + for i=1:M + [y(:,i),yp]=next1(a,x(:,i),yp); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/afilter.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,18 @@ +% afilter - Linear filter arrow +% +% afilter :: +% [[P]] ~'filter B coefficients', +% [[Q]] ~'filter A coefficients', +% -> arrow({[[N]]},{[[N]]},[[O]]). +% +% The arrow afilter(B,A) is equivalent to using filter(B,A,X) +% on a signal in an array. + +function o=afilter(b,a,zi) + + if nargin<3, zi=[]; end + o = loop(@filt,@(s)zi); + function [y,z]=filt(x,z) + [y,z]=filter(b,a,x,z); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/ainvmel.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +% ainvmel - arrow to warp mel scale spectrum to linear freq spectrum +% +% ainvmel :: +% N:natural ~'block size of original audio frames', +% nonneg ~'audio sampling frequency in Hz', +% [[1,2]] ~'frequency limits in Hz', +% L:natural ~'number of bands in mel spectrum' +% -> arrow( {[[L]]}, {[[dftbins(N)]]}, empty). + +function o=ainvmel(N,fs,flim,L) + o=amult(tri_filterbank_aa(melspace(flim(1),min(flim(2),fs/2),L+2),binmap(0,fs/2,dftbins(N)))'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/alevinson.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +function o=alevinson(N) + if nargin>0, fn=@levN; else fn=@lev; end + + o=arr(fn); + function [a,e]=levN(r), [a,e]=levinson(r,N); end + function [a,e]=lev(r), [a,e]=levinson(r); end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/alpc.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,28 @@ +% alpc - LPC arrow +% +% alpc :: +% N:natural ~'size of waveform blocks to expect', +% M:natural ~'order of LPC to do' +% options { +% specfn :: ([[N,T]]->[[dftbins(N),T]])/ @powspec ~'function to compute spectra'; +% window :: (N:natural->[[N]]) / @hanning ~'function to compute window' +% } +% -> arrow({[[N,1]]},{[[M,1]]},empty). + +function o=alpc(N,M,varargin) + opts=prefs('window',@hanning,'nargout',1,varargin{:}); + w=spdiag(opts.window(N)); + if opts.nargout<=1 + o=arr(@fn); + else + o=arr(@fn2); + end + + function y=fn(x) + y=lpc(w*x,M); + end + + function [y,v]=fn2(x) + [y,v]=lpc(w*x,M); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/amagspec.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,19 @@ +% apowspec - Arrow to compute power spectra +% +% apowspec :: +% [[N]] ~'analysis window' +% -> arrow( {[[N]]}, {[[dftbins(N)]]}, empty). +% +% apowspec :: +% [[M]] ~'analysis window', +% N ~'size for FFT' +% -> arrow( {[[M]]}, {[[dftbins(N)]]}, empty). +function [o,fx]=apowspec(window,N) + W=spdiag(window); + if nargin<2, N=length(window); end + fx=(0:dftbins(N)-1)/N; + o=arr(@ps); + function y=ps(x) + y=magspec(W*x,N); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/amelceps.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,13 @@ +% melceps - arrow from audio to log mel cepstrum (MFCCs) +function o=melceps(N,M,L,fs,varargin) + opts=prefs('norm_rate',1e-6,'plot_melspec',1,'lowf',100,varargin{:}); + if opts.plot_melspec, + mp=obs_with(imgtrace(256,'fig',9,'clim',[-20,20])); + figure(9); colormap(bipolar1); + else; mp=aid; end + + o = amelspec(N,M,fs,'lowf',opts.lowf) ... + * states(azeromean(gaussian,'rate',opts.norm_rate),50) * (aid + vplotter('fig',12)) ... + * mp * adct(1:L); % ... +% * obs_with(plotter('fig',11,'ylim',[-20,20],'xlim',[0,L+1],'plotfn',@bar)); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/amelspec.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,21 @@ +% amelspec - arrow from audio to log mel spectra +% +% amelspec :: +% N:natural ~'size of FFT used to compute spectra', +% M:natural ~'number of mel bands to compute' +% nonneg ~'sampling frequency', +% options { +% windowfn :: N:natural->[[N]] / @hanning ~'window function'; +% lowf :: nonneg / 100 ~'filter bank low frequency in Hz' +% } +% -> arrow( {[[dftbins(N)]]}, {[[L]]}, empty). +% +% Uses antialiased triangular filterbank from lowf to fs/2. + +function o=amelspec(N,M,fs,varargin) + opts=prefs('windowfn',@hanning,'lowf',100,'floor',5e-9,varargin{:}); + melW = lin2mel(N,fs,[opts.lowf,fs/2],M); + noise_floor=opts.floor; + o = apowspec(opts.windowfn(N))*arr(@cc); + function y=cc(x), y=log(melW*x+noise_floor); end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/apow2melspec.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +% apow2melspec - arrow from power spectra to log mel spectra +% +% apow2melspec :: +% N:natural ~'size of FFT used to compute spectra', +% nonneg ~'sampling frequency', +% [[1,2]->freq] ~'upper and lower frequency limits', +% L:natural ~'number of mel bands to compute' +% -> arrow( {[[dftbins(N)]]}, {[[L]]}, empty). + +function o=apow2melspec(N,fs,flim,L) + melW = tri_filterbank_aa(melspace(flim(1),min(flim(2),fs/2),L+2),binmap(0,fs/2,dftbins(N))); + o=arr(@cc); + function y=cc(x), y = log(melW*x+5e-9); end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/apowspec.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,19 @@ +% apowspec - Arrow to compute power spectra +% +% apowspec :: +% [[N]] ~'analysis window' +% -> arrow( {[[N]]}, {[[dftbins(N)]]}, empty). +% +% apowspec :: +% [[M]] ~'analysis window', +% N ~'size for FFT' +% -> arrow( {[[M]]}, {[[dftbins(N)]]}, empty). +function [o,fx]=apowspec(window,N) + W=spdiag(window); + if nargin<2, N=length(window); end + fx=(0:dftbins(N)-1)/N; + o=arr(@ps); + function y=ps(x) + y=powspec(W*x,N); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/apowspec1.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +% apowspec1 - Arrow to compute power spectra (automatic sizing version) +% +% apowspec1 :: +% (N:natural -> [[N]]) ~'analysis window function' +% -> arrow( {[[N]]}, {[[dftbins(N)]]}, empty). + +function o=apowspec1(windowfn) + o=arrf(@mk,1,1); + function f=mk(sizes) + N=sizes{1}(1); + W=spdiag(windowfn(N)); + f=@(x)powspec(W*x,N); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/aresample.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function a=aresample(f1,f2) + f0=gcd(f1,f2); + p=f2/f0; q=f1/f0; + %[y,num]=resample(zeros(16,1),p,q); + num=get(mfilt.firsrc(p,q),'Numerator'); % design resampling filter using mfilt + a=asysobj(@(sz)dsp.FIRRateConverter(p,q,num),1,1,@(sz){[sz{1}(1)*f2/f1,sz{1}(2)]});
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/aspecsyn.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +% aspecsyn - Spectral synthesis arrow +% +% aspecsyn :: +% N:natural, +% M:natural, +% (N:natural-> [[N]]) ~'window function' +% -> arrow( {[[N]]}, {[[M]]}, _). +function o=aspecsyn(N,M,windowfn) + o = (arr(@spec2fir) + asampler(@randn,[N,1])) ... % FIR filter coefficients and white noise + * adynfir(N,N) * amult(spdiag(windowfn(N))) ... % windowed sample buffers + * aolapadd(N,M); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/aspectrum.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,19 @@ +% aspectrum - frequency spectrum arrow +% +% aspectrum :: +% N:natural ~'size of waveform blocks to expect' +% options { +% specfn :: ([[N,T]]->[[dftbins(N),T]])/ @powspec ~'function to compute spectra'; +% window :: (N:natural->[[N]]) / @hanning ~'function to compute window' +% } +% -> arrow({[[N,T]]},{[[dftbins(N),T]]},empty). + +function o=aspectrum(N,varargin) + opts=prefs('specfn',@powspec,'window',@hanning,varargin{:}); + specfn=opts.specfn; + w=spdiag(opts.window(N)); + o=arr(@fn); + function y=fn(x) + y=specfn(w*x); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/spec_bench.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,25 @@ +% spec_bench - Arrow for doing spectral-based processing +% +% spec_bench :: +% N:natural ~'frame size', +% M:natural ~'hop size' +% arrow( {[dftbins(N),W]}, {[dftbins(N),W]}, S1), ~'arrow to process magnitude spectra', +% arrow( {[dftbins(N),W]}, {[dftbins(N),W]}, S2), ~'arrow to process phase spectra' +% -> arrow( {[N,W]}, {[N,W]}, spec_bench_state(S1,S2)) ~'total arrow'. +% +% This splits a signal into magnitude and phase spectra (using Hanning analysis window), +% applies supplied arrows to the two branches, and then recombines them using an inverse +% DFT and overlap-and-add to compose the output signal. + +function o=spec_bench(N,M,a1,a2) + H=spdiag(hanning(N,'periodic')); + + o= ( amult(H) ... % analysis window + * mag_phase_split(N) ... % split into magnitude and phase spectra + * (a1 + a2) ... % apply a1 and a2 to mag and phase + * mag_phase_join(N) ... % reconstruct + * amult((N/M/6)*H) ... % reconstruction window + * aolapadd(N,M) ... % overlap and add + ); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/spec_bench1.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,22 @@ +% spec_bench - Arrow for doing spectral-based processing +% +% spec_bench :: +% N:natural ~'frame size', +% M:natural ~'hop size' +% arrow( {[dftbins(N),W]}, {[dftbins(N),W]}, S1), ~'arrow to process magnitude spectra' +% -> arrow( {[N,W]}, {[dftbins(N),W]}, spec_bench1_state(S1,S2)) ~'total arrow'. +% +% This splits a signal into magnitude and phase spectra (using Hanning analysis window), +% applies supplied arrows to the two branches, and then recombines them using an inverse +% DFT and overlap-and-add to compose the output signal. + +function [o,path]=spec_bench1(N,M,a1,a2) + H=spdiag(hanning(N,'periodic')); + + o= ( amult(H) ... % analysis window + * mag_phase_split(N) ... % split into magnitude and phase spectra + * (a1 + anull) ... % apply a1 and a2 to mag and phase + ); + path=[2,1]; +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dsp/spec_bench2.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +% spec_bench2 - Arrow for doing spectral-based processing (no phase) +% +% spec_bench :: +% N:natural ~'frame size', +% M:natural ~'hop size' +% arrow( {[dftbins(N),W]}, {[dftbins(N),W]}, S1), ~'arrow to process power spectra', +% -> arrow( {[N,W]}, {[N,W]}, pair(pair(empty,S1),empty)) ~'total arrow'. +% +% This splits a signal into magnitude and phase spectra (using Hanning analysis window), +% applies supplied arrows to the two branches, and then recombines them using an inverse +% DFT and overlap-and-add to compose the output signal. +function o=spec_bench(N,M,a) + o=apowspec(hanning(N))*a*aspecsyn(N,M,@hanning); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/dup.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +% dup - Arrow to duplicate one input to two outputs. +% +% dup :: arrow({A},{A,A},empty). +function u=dup, u=arr(@dupfn); end +function [x,y]=dupfn(x); y=x; end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/emerge.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,15 @@ +% emerge - Arrow to merge event inputs +% +% emerge :: N:natural ~'number of inputs' +% -> arrow({[N]->boxed(A)},{boxed(A)},empty). +% +% Inputs are event streams, ie values of type boxed(A), +% which are cell arrays of values of type A. +% Output is an event stream consisting of all events +% merged into one stream. If multiple events arrive +% at one time, the output cell array will contain more +% than one value. +function o=emerge(nin) + o=arr(@merge); + function y=merge(varargin), y=cat(2,varargin{1:nin}); end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/get_subcell.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function V=get_subcell(A,Path) + if isempty(Path), V=A; + else + V=get_subcell(A{Path(1)},Path(2:end)); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/imgtrace.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +% imgtrace - arrow which displays last few input vectors in an image +% +% imgtrace :: +% W:natural ~'width of image', +% options { +% } +% -> arrow({[[N,1]]}, {}, pair([[N,W]],empty)). + +function o=imgtrace(width,varargin) + o=asweep(width,nan)*imager(varargin{:}); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/integrate.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +% integrate - arrow that integrates its input +% +% integrate :: +% X:A ~'initial value' +% -> arrow({A},{A},A). + +function a=integrate(init) + a=loop(@accum,@(s)init); +end + +function [y,s2]=accum(x,s), s2=x+s; y=s2; end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/iseof.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,8 @@ +% iseof - test caught exception to see if it is Java End Of File +% +% iseof :: exception -> boolean. +function f=iseof(ex) + f = strcmp(ex.identifier,'ARROW:EOF') ... + || (strcmp(ex.identifier,'MATLAB:Java:GenericException') ... + && strncmp(ex.message(27:end),'java.io.EOFException',20)); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/mousex.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +% mousex - Mouse X position in axes +% +% mousex :: options {} -> arr({},real,pair(empty,empty)). +function o=mousex(varargin), o=mousepos(varargin{:}) * arr(@(t)t(1)); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/mousey.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +% mousey - Mouse X position in axes +% +% mousey :: options {} -> arr({},real,pair(empty,empty)). +function o=mousey(varargin), o=mousepos(varargin{:}) * arr(@(t)t(2)); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/mscaler.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,59 @@ +% mscaler - Dynamic additive and multiplicative normalisation in Matlab +% +% mscaler :: +% model(real) ~'model for observations', +% options { +% scale :: nonneg /1 ~'initial scale factor'; +% offset :: real /0 ~'initial offset'; +% scale_rate :: nonneg/0.02 ~'scale adaptation rate'; +% offset_rate :: nonneg/1e-7 ~'offset adaptation rate'; +% batch :: natural/4 ~'batch size for updates' +% } +% -> arrow({[[N]]},{[[N]]},mscaler_state). + +function o=mscaler(model,varargin) + opts=prefs('scale',1,'offset',0, ... + 'scale_rate',0.02,'offset_rate',1e-7,'batch',4, ... + 'nargout', 1, ... + varargin{:}); + + rates=[opts.scale_rate;opts.offset_rate]; + batch=opts.batch; + score=scorefn(model); + z3 = [0;0;0]; + + if (opts.batch==1) + o=loop(@update,@(s)[opts.scale;opts.offset]); + else + o=loop(@update_batched,@(s){z3,[opts.scale;opts.offset]}); + end + + function ss=stats(y,phi), + n=size(y,1); + ss=[n;sum(y.*phi)-n;sum(phi)]; + end + + function [y,phi]=infer(params,x) + y = (x-params(2))/params(1); + phi = score(y); + end + + function params=updparams(params,stat1,stat2) + params = [ params(1)*exp(rates(1)*stat1); + params(2)+rates(2)*params(1)*stat2 ]; + end + + function [y,state]=update(x,state) + [y,phi] = infer(state,x); + state = updparams(state, mean(y(:).*phi(:))-1, mean(phi(:))); + end + + function [y,state]=update_batched(x,state) + params=state{2}; + [y,phi] = infer(params,x); + ss = state{1} + stats(y(:),phi(:)); + if (ss(1)<batch) state{1}=ss; + else state = {z3, updparams(params,ss(2)/ss(1),ss(3)/ss(1))}; + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/obs_with.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +% obs_with - arrow to observe a signal while passing it through +% +% obs_with :: +% arrow({A},{},S) ~'arrow sink to observe values of type A', +% -> arrow({A},{A},pair(empty,S)). + +function b=obs_with(a), b=dup*first(a); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/perm.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,23 @@ +% perm - arrow to permute inputs +% +% perm :: +% N:natural ~'number of inputs', +% P:[[M]->[N]] ~'permutation of inputs' +% -> arrow(_:arglist(N), _:arglist(M), empty). +% +% This function creates an arrow whos outputs can +% be copies of any of the inputs in any order. +% For example, +% perm(5,[3,2,5]) +% is an arrow with 5 inputs and 3 outputs. Output +% 1 is input 3, output 2 is input 2, and output 3 is +% input 5. + +function a=perm(nin,p) + nout=length(p); + a=arr(@permfn,'nargin',nin,'nargout',length(p)); + + function varargout=permfn(varargin) + [varargout{1:nout}]=varargin{p}; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/sched_ui.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,21 @@ +% sched_ui - Create buttons to control scheduler. +function handles=sched_ui(sched,fig) + clf(fig); + handles=map(@(fn)mkbutton(getfield(sched,fn),fn),{'start','stop'}); + layout([10,10],handles); + handles=cell2mat(handles); + + function b=mkbutton(action,text) + b=uicontrol('Parent',fig,'Style','Pushbutton','String',text,'Callback',@(a,b)action()); + end +end + +function layout(pos,handles), foldl(@add_control,pos,handles); end +function cur=add_control(cur,h) + pos=get(h,'Position'); + set(h,'Position',[cur,pos(3:4)]); + cur = cur+[0,pos(2)]; +end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/scope.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +% scope - arrow to create scrolling plot of real valued signals +% +% scope :: +% W:natural ~'width of plot in samples', +% -> arrow({[[N,1]]}, {}, pair([[N,W]],pair(empty,empty))). +% +% If input vectors are N dimensional, this will plot +% N lines showing their history over the last W samples. + + +function b=scope(width,varargin) + b=awindow(width,nan)*arr(@transpose)*plotter(varargin{:});
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/set_subcell.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +% set_subcell - replace subnode of cell based tree structure +function A=set_subcell(A,Path,Val) + if isempty(Path), A=Val; + else + A{Path(1)} = set_subcell(A{Path(1)},Path(2:end),Val); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/accumstats.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,37 @@ +% accumstats - arrow that collects 1st and 2nd order statistics (struct version) +% +% accumstats :: arrow({[[N]]},{stats_struct(N)},stats_struct(N)). +% accumstats :: nonneg -> arrow({[[N]]},{stats_struct(N)},stats_struct(N)). +% +% If an argument is given, it is used as the effective memory length +% stats_struct(N) ::= struct { +% ag :: nonneg; +% amu :: [[N]]; +% aco ::[[N,N]]; +% }. + +function a=accumstats(L) + if nargin<1, kappa=inf; else kappa=L*(L-1); end + + ss.ag=0; + ss.amu=0; + ss.aco=0; + a=loop(ifx(isinf(kappa),@accum,@accum_forget),@(s)ss); + + function [y,ss]=accum_forget(x,ss), + n=size(x,2); + K=kappa/(kappa+n*ss.ag); + ss.ag=K*ss.ag+n; + ss.amu=K*ss.amu+sum(x,2); + ss.aco=K*ss.aco+x*x'; + y=ss; + end +end + +function [y,ss]=accum(x,ss), + ss.ag=ss.ag+size(x,2); + ss.amu=ss.amu+sum(x,2); + ss.aco=ss.aco+x*x'; + y=ss; +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/accumstats_cell.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +% accumstats - arrow that collects 1st and 2nd order statistics (cell version) +% +% accumstats :: arrow({[[N]]},{stats_cell},stats_cell). +% +% stats_cell ::= cell { nonneg, [[N]], [[N,N]] }. + +function a=accumstats + a=loop(@accum,@(s){0,0,0}); +end + +function [y,s2]=accum(x,s), + s2={s{1}+size(x,1),s{2}+sum(x,2),s{3}+x*x'}; + y=s2; +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/afitgauss.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,63 @@ +% afitgauss - Fit Gaussian to stream of input vectors +% +% afitgauss :: +% nonneg~'adaptation rate', +% options { +% zeromean :: bool/0 ~'assume input is zero mean?' +% } +% -> arrow( {[[N]]}, {struct { mu::[[N]]; cov:[[N,N]] }}, stats_struct(N)). +% +% stats_struct(N) ::= struct { +% ag :: nonneg; +% amu :: [[N]]; +% aco ::[[N,N]]; +% }. + +function o=afitgauss(L,varargin) + + opts=prefs('zeromean',0,varargin{:}); + + GMM=gmm; + %K=L/(L+1); + kappa=L*(L-1); % precision of diffusion process for effective memory of L + + M0=[]; + o=loop(ifx(opts.zeromean,@update_z,@update),@init); + + function s0=init(size_in) + N=size_in(1); + M0=GMM.ss_init(GMM.blank(1,N)); + s0=foldl( @(s,x)GMM.ss_accum(s,[x,-x],[0.5,0.5]), M0, mat2cell(eye(N),N,ones(1,N))); + end + + function [y,s]=update(x,s) + % factor to reduce weight of evidence so far + % corresponds roughly to *addition* of variance + % in the exponential family diffusion scheme of things + K=kappa/(kappa+s.ag); + s.ag = K*s.ag + size(x,2); + s.amu = K*s.amu + sum(x,2); + s.aco = K*s.aco + x*x'; + y=mstep(s,M0); + end + + function [y,s]=update_z(x,s) + % factor to reduce weight of evidence so far + K=kappa/(kappa+s.ag); + s.ag = K*s.ag + size(x,2); + s.aco = K*s.aco + x*x'; + y=mstep_z(s,M0); + end + + function M=mstep(S,M) + M.mu=S.amu/S.ag; + M.cov=msym(S.aco/S.ag - M.mu*M.mu'); + end + + function M=mstep_z(S,M) + M.mu=zeros(size(S.aco,1),1); + M.cov=S.aco/S.ag; + end + + function A=mysm(X), A=(X+X')/2; end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/ahist.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,29 @@ +% ahist - arrow to accumulate histogram from input +function o=ahist(map,L) + if nargin<2, kappa=inf; else kappa=L*(L-1); end + o=loop1(1,0,@accumfn); + + function [f,s0]=accumfn(sz) + s0=zeros(sz(1),cardr(map)); + ROWS=flatten(repmat((1:sz(1))',1,sz(2))); + HSZ=[sz(1),cardr(map)]; + if isinf(kappa), f=@accum + else f=@accum_forget; + end + + function s=accum(x,s) + COLS=flatten(map(x)); + I=isfinite(COLS); + s=s+accumarray([ROWS(I),COLS(I)],1,HSZ); + end + + function s=accum_forget(x,s) + n=size(x,2); + K=kappa/(kappa+n*sum(s(1,:),2)); + + COLS=flatten(map(x)); + I=isfinite(COLS); + s=K*s+accumarray([ROWS(I),COLS(I)],1,HSZ); + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/ahistimg.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,8 @@ +function o=ahistimg(map,varargin) + opts=prefs('log',false,'period',1,'memory',inf,varargin{:}); + o=estates(ahist(map,opts.memory),opts.period); + if opts.log, + p=arr(@(t)log(t+1))*imager('xdom',centres(map),opts); + else p=imager('xdom',centres(map),opts); + end + o=o*erate(p,{[opts.channels,cardr(map)]});
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/ahistplot.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function o=ahistplot(map,varargin) + opts=prefs('log',false,'period',1,'memory',inf,varargin{:}); + o=estates(ahist(map,opts.memory),opts.period); + if opts.log, p=arr(@(t)log(t')); + else p=arr(@transpose); end + o=o*erate(p*plotter('dom',centres(map),opts),{[opts.channels,cardr(map)]});
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/apca.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,38 @@ +% apca - PCA +% +% acpa :: +% [[N,M]] ~'initial weight vectors', +% options { +% ordered :: bool /1 ~'produce PCs in variance order?'; +% rate :: nonneg/1e-7 ~'adaptation rate'; +% subsample :: natural/1; +% plotfig :: natural/0; +% } +% -> arrow({[[N]]},{[[M]]},apca_state). + +function o=apca(W0,varargin) + opts=prefs('rate',1e-7,'ordered',1,'subsample',1,'plotfig',0,varargin{:}); + + rate=opts.rate; + if opts.ordered + o=loop(@update1,@(s)W0); + else + o=loop(@update,@(s)W0); + end + if opts.plotfig>0, + o=estates(o,opts.subsample)*(aid + erate(plotter('fig',opts.plotfig,'name','PC basis'))) + end + + function [y,W]=update(x,W) + y=W'*x; + e=x-W*y; + W=W+rate*e*y'; + end + + function [y,W]=update1(x,W) + y=W'*x; + NY=repmat(-y',size(x,1),1); + E=cumsum([x,W.*NY],2); % errors after progressive reconstruction + W=W-rate*(E(:,2:end).*NY); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/appca.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +% appca - Arrow for doing a probabilistic PCA of sorts +% +% appca :: +% [[N,M]] ~'initial weight vectors', +% options { +% rate :: nonneg/1e-4 ~'adaptation rate'; +% zeromean :: bool/1 ~'assume input is zero mean?'; +% subsample :: natural/1; +% plotfig :: natural/0; +% plottype :: {'plot','image'}/'plot' ~'how to plot eigenvectors'; +% } +% -> arrow({[[N]]},{[[M]]},appca_state). + +function o=appca(W0,varargin) + [N,M]=size(W0); + opts=prefs('rate',0.0001,'subsample',1,'plotfig',0,'zeromean',1,varargin{:}); + switch opts.plottype + case 'plot', eigplot=@plotter; + case 'image', eigplot=@imager; + otherwise, error(['appca: unrecognised plot type ', opts.plottype]); + end + pl = ifx(opts.plotfig, obs_with(eigplot('fig',opts.plotfig,'name','Eigenvectors')), aid); + o = dup*(afitgauss(1/opts.rate,opts)*asubsample(opts.subsample) ... + *erate(aeig(N,1:M)*afirst(pl)*arr(@eig2whitener))*alatch(W0') ... + + aid)*arr(@mtimes); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/eig2whitener.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +% eig2whitener - compute whitening matrix from covariance eigenvectors and values +% +% eig2whitener :: +% [[N,M]] ~'M eigenvectors of NxN covaraince matrix', +% [[M]] ~'corresponding M eigenvalues' +% -> [[M,N]] ~'matrix to apply to get decorrelated unit variance coefficients'. + +function W=eig2whitener(V,d) + W=diag(1./sqrt(d))*V'; +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/nica.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,69 @@ +% nica - Noisy ICA in Matlab. +% +% nica :: [[N,M]], options {} -> arrow({[[N]]},{[[M]}},nica_state). + +function o=nica(A0,varargin) + [N,M] = size(A0); + opts=prefs('rate',0.005,'dwa_thresh',0.01,'batch',N, ... + 'train', 1, ... + 'noise_std', 1, ... + 'qpopts',{}, ... + 'on_error',@keyboard, ... + varargin{:}); + + var = opts.noise_std^2; + rate = opts.rate; + f0 = var*ones(2*M,1); + Eyes = [eye(M),-eye(M)]; + lb = zeros(2*M,1); + + qp_options = optimset(opts.qpopts{:}); + + system.A = A0; + system.AK = system.A*Eyes; + system.H = system.AK'*system.AK; + + if opts.train + system.learn.W = 0; + system.learn.G = zeros(N,M); + o=loop(@infer_learn,@(s)system); + else + o=loop(@infer,@(s)system); + end + + + function [y,sys]=infer_learn(x,sys) + [y,E]=nica_infer_qp(sys,x); + + sys.learn.G = sys.learn.G + sys.A*sign(y)*y'; +% sys.learn.G = sys.learn.G + (x-sys.A*y)*y'; + sys.learn.W = sys.learn.W + 1; + if sys.learn.W>=opts.batch + sys.A = sys.A + opts.rate*(sys.learn.G/sys.learn.W - sys.A); +% sys.A = sys.A + opts.rate*(sys.learn.G/sys.learn.W); + sys.G = zeros(N,M); + sys.AK = sys.A*Eyes; + sys.H = sys.AK'*sys.AK; + sys.learn.W = 0; + sys.learn.G = zeros(N,M); + end + end + + function [y,sys]=infer(x,sys) + [y,E]=nica_infer_qp(sys,x); + end + + function [s,E]=nica_infer_qp(system,x) + f = f0 - system.AK'*x; + + [ss,E,exitflag,prob]=quadprog(system.H,f,[],[],[],[],lb,[],[],qp_options); + s=ss(1:M)-ss(M+1:end); + if exitflag<=0 && exitflag~=-4 + opts.on_error(); + end + end +end + + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/nica_nn.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,61 @@ +% nica_nn - Nonnegative Noisy ICA in Matlab. +% +% nica_nn :: [[N,M]], options {} -> arrow({[[N]]},{[[M]}},nica_state). + +function o=nica_nn(A0,varargin) + [N,M] = size(A0); + opts=prefs('rate',0.005,'dwa_thresh',0.01,'batch',N, ... + 'train', 1, ... + 'noise_std', 1, ... + 'qpopts',{}, ... + 'on_error',@keyboard, ... + varargin{:}); + + f0 = (opts.noise_std^2)*ones(M,1); + lb = zeros(M,1); + zNM = zeros(N,M); + + qp_options = optimset(opts.qpopts{:}); + + system.A = A0; + system.H = system.A'*system.A; + + if opts.train + system.learn.W = 0; + system.learn.G = zNM; + o=loop(@infer_learn,@(s)system); + else + o=loop(@infer,@(s)system); + end + + + function [y,sys]=infer_learn(x,sys) + [y,E]=nica_infer_qp(sys,x); + + sys.learn.G = sys.learn.G + (sys.A*sign(y))*y'; + sys.learn.W = sys.learn.W + 1; + if sys.learn.W>=opts.batch + sys.A = sys.A + opts.rate*(sys.learn.G/sys.learn.W - sys.A); + sys.H = sys.A'*sys.A; + sys.learn.W = 0; + sys.learn.G = zNM; + end + end + + function [y,sys]=infer(x,sys) + [y,E]=nica_infer_qp(sys,x); + end + + function [s,E]=nica_infer_qp(system,x) + f = f0 - system.A'*x; + + [s,E,exitflag,prob]=quadprog(system.H,f,[],[],[],[],lb,[],[],qp_options); + if exitflag<=0 && exitflag~=-4 + opts.on_error(); + end + end +end + + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/stats_pca.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,29 @@ +function o=astats_pca(I) + %GMM=gmm('full'); + %m0=GMM.blank(1,N); + o=arr(@stats_pca); + function pca=stats_pca(stats) + if isstruct(stats) + m1=mstep(stats); + [V,D]=eig(m1.cov); + J=(1+size(D,1))-I; + pca.eigvecs=V(:,J); + pca.eigvals=diag(D); + pca.eigvals=max(0,pca.eigvals(J)); + pca.mean=m1.mu; + else + pca.dummy=1; + end + end + function M=mstep(S) + M.mu=S.amu/S.ag; + M.cov=msym(S.aco/S.ag - M.mu*M.mu'); + end + + function M=mstep_z(S) + M.mu=zeros(size(S.aco,1),1); + M.cov=S.aco/S.ag; + end + + function A=msym(X), A=(X+X')/2; end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/stats_pca_cell.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +function o=astats_pca_cell(I) + o=arr(@stats_pca); + function pca=stats_pca(stats) + if iscell(stats) + m1=mstep(stats); + [V,D]=eig(m1.cov); + J=(1+size(D,1))-I; + pca.eigvecs=V(:,J); + pca.eigvals=diag(D); + pca.eigvals=pca.eigvals(J); + pca.mean=m1.mu; + else + pca.dummy=1; + end + end + function M=mstep(S) + M.mu=S{2}/S{1}; + M.cov=msym(S{3}/S{1} - M.mu*M.mu'); + end + + function M=mstep_z(S) + M.mu=zeros(size(S{3},1),1); + M.cov=S{3}/S{2}; + end + + function A=msym(X), A=(X+X')/2; end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/stats/whitener.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,9 @@ +% whitener - return whitening matrix given covariance +function W=whitener(A,I) + [V,D]=eig(A); + J=(1+size(V,2))-I; + eigs=diag(D); + W=diag(1./sqrt(eigs(J)))*V(:,J)'; +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/sweep.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +% sweep - arrow to create sweeping plot of real valued signals +% +% sweep :: +% W:natural ~'width of plot in samples', +% -> arrow({[[N,1]]}, {}, pair([[N,W]],pair(empty,empty))). +% +% If input vectors are N dimensional, this will plot +% N lines showing their history over the last W samples. + + +function b=sweep(width,varargin) + b=asweep(width,nan)*arr(@transpose)*plotter(varargin{:});
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/ufold.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,25 @@ +% ufold - Fold data into processing unit +% +% ufold :: +% unit({[[N,1]]}, _, S) ~'live processing unit', +% [[N,T]] ~'data to pass through', +% S ~'initial state of unit', +% options { +% draw :: boolean/false ~'whether or not to call drawnow after each iteration'; +% quiet :: boolean/false ~'whether or not to suppress progress messages' +% } +% -> S ~'final state'. +% +% This function accepts the live processing unit associated +% with an arrow (as created by with_arrow). The arrow must +% accept one column vector as input. Its output is ignored. +% The state of the unit is first set, then data is passed +% through one column at a time, and the final state is returned. + +function A2=ufold(unit,X,A1,varargin) + if ~isempty(A1), unit.set_state(A1); end + uiter(unit,size(X,2),@foldx,[],'label','ufold',varargin{:}); + A2=unit.get_state(); + + function s=foldx(i,s), unit.process(X(:,i)); end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/ugather.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,43 @@ +% ugather - Run a processing unit and collect output +% +% ugather :: +% unit({}, {[[N,1]]}, _) ~'live processing unit', +% T:natural ~'number of iterations to run (can be inf)', +% options { +% draw :: boolean/false ~'whether or not to call drawnow after each iteration'; +% quiet :: boolean/false ~'whether or not to suppress progress messages'; +% chunk :: natural/1 ~'print progress every chunk interations'; +% expand :: boolean/false~'do binary expansion of results array' +% } +% -> [[N,T]] ~'collected output'. +% +% This function accepts the live processing unit associated +% with an arrow (as created by with_arrow). The arrow must +% have zero inputs and one output. The requested number of outputs +% are collected into an array and returned. If inf outputs are +% requested, the system is run until an EOF exception is caught. + +function X=ugather(u,its,varargin) + opts=prefs('expand',1,varargin{:}); + if opts.expand && isinf(its) + X=zeros(u.sizes_out{1}(1),32); % initial size is arbitrarily 32 + done=uiter(u,its,@gatherxx,[],'label','ugather',opts); + if done<size(X,2), X=X(:,1:done); end + else + if ~isinf(its), X=zeros(u.sizes_out{1}(1),its); end + + done=uiter(u,its,@gatherx,[],'label','ugather',opts); + if done<its, X=X(:,1:done); end + end + + function s=gatherx(i,s), X(:,i)=u.process(); end + function s=gatherxx(i,s), + if i>size(X,2), + %fprintf('ugather: expanding at %d.\n',size(X,2)); + X=[X,zeros(size(X))]; % double size + end + X(:,i)=u.process(); + end +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/uiter.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,48 @@ +% uiter - Run iterative thing on a live processing unit +% +% uiter :: +% unit({}, _, _) ~'live processing unit', +% T:natural ~'number of iterations to run (can be inf)', +% (natural,Q->Q) ~'function to run one step, can be stateful', +% Q ~'initial value to thread through calls to step fn', +% options { +% draw :: boolean/false ~'whether or not to call drawnow after each iteration'; +% quiet :: boolean/false ~'whether or not to suppress progress messages'; +% chunk :: natural/1 ~'print progress every chunk interations'; +% label :: string/'uiter'~'used to identify progress messages' +% } +% -> natural ~'number of iterations actually done', +% Q ~'final value returned by step function'. +% +% This function accepts the live processing unit associated +% with an arrow (as created by with_arrow). Then system is +% started, an arbitrary function is called repeatedly, and then +% the system is stopped. If an EOF exception is thrown, the +% itertion is cut short but the function returns normally. +% If any other exception is thrown, the system is stopped before +% rethrowing the exception. + +function [itsdone,state]=uiter(u,its,nextfn,state,varargin) + opts=prefs('label','uiter','draw',1,'quiet',0,'chunk',1,varargin{:}); + quiet=opts.quiet; draw=opts.draw; + chunk=opts.chunk; + u.starting(); + try + i=1; + while i<=its, + if ~quiet && mod(i,chunk)==0, fprintf(' %s: %d \r',opts.label,i); end + state=nextfn(i,state); + if draw, drawnow; end + i=i+1; + end + catch ex + if ~iseof(ex) + if ~quiet, fprintf('exception at %d iterations.\n',i); end + u.stopping(); + rethrow(ex); + end + end + itsdone=i-1; + if ~quiet, fprintf('done %d iterations.\n',itsdone); end + u.stopping(); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/uiterate.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,45 @@ +% uiterate - Run a processing unit for some number of iterations +% +% uiterate :: +% unit({}, _, _) ~'live processing unit', +% T:natural ~'number of iterations to run (can be inf)', +% options { +% draw :: boolean/false ~'whether or not to call drawnow after each iteration'; +% quiet :: boolean/false ~'whether or not to suppress progress messages'; +% chunk :: natural/1 ~'print progress every chunk interations' +% } +% -> action (). +% +% This function accepts the live processing unit associated +% with an arrow (as created by with_arrow). The arrow must +% have zero inputs. Outputs are ignored. If inf iterations are +% requested, the system is run until an EOF exception is caught. + +function uiterate(u,its,varargin) + uiter1(u,its,u.process,'label','uiterate',varargin{:}); +end + +function itsdone=uiter1(u,its,itfn,varargin) + opts=prefs('draw',1,'quiet',0,'chunk',1,varargin{:}); + quiet=opts.quiet; draw=opts.draw; + chunk=opts.chunk; + u.starting(); + try + i=1; + while i<=its, + if ~quiet && mod(i,chunk)==0, fprintf(' %s: %d \r',opts.label,i); end + itfn(); + if draw, drawnow; end + i=i+1; + end + catch ex + if ~iseof(ex) + if ~quiet, fprintf('exception at %d iterations.\n',i); end + u.stopping(); + rethrow(ex); + end + end + itsdone=i-1; + if ~quiet, fprintf('done %d iterations.\n',itsdone); end + u.stopping(); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/umgather.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,34 @@ +% umgather - Run a processing unit and collect multiple outputs +% +% ugather :: +% unit({}, A:arglist(K), _) ~'live processing unit with K outputs', +% T:natural ~'number of iterations to run (can be inf)', +% options { +% draw :: boolean/false ~'whether or not to call drawnow after each iteration'; +% quiet :: boolean/false ~'whether or not to suppress progress messages'; +% chunk :: natural/1 ~'print progress every chunk interations'; +% } +% -> B:arglist(K) ~'collected outputs'. +% +% This function accepts the live processing unit associated +% with an arrow (as created by with_arrow). The arrow must +% have zero inputs and one output. The requested number of outputs +% are collected into an array and returned. If inf outputs are +% requested, the system is run until an EOF exception is caught. + +function varargout=umgather(u,its,varargin) + opts=prefs('draw',0,varargin{:}); + nout=length(u.sizes_out); + gatherers=map(@(sz)gatherer(sz,opts),u.sizes_out); + if opts.draw, dfn=@drawnow; else dfn=@nop; end + uiter(u,its,@gatherxx,[],'label','umgather',opts); + varargout=map(@(g)g.collect(),gatherers); + + function s=gatherxx(i,s), + [outs{1:nout}]=u.process(); + for i=1:nout, gatherers{i}.append(outs{i}); end + dfn(); + end +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/utransfer.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,23 @@ +% utransfer - Run a processing unit, passing data through and collecting outputs +% +% utransfer :: +% unit({[[N,1]]}, {[[M,1]]}, _) ~'live processing unit', +% [[N,T]] ~'data to pass through', +% options { +% draw :: boolean/false ~'whether or not to call drawnow after each iteration'; +% quiet :: boolean/false ~'whether or not to suppress progress messages' +% } +% -> [[M,T]] ~'collected output'. +% +% This function accepts the live processing unit associated +% with an arrow (as created by with_arrow). The arrow must +% have zero inputs and one output. The requested number of outputs +% are collected into an array and returned. If inf outputs are +% requested, the system is run until an EOF exception is caught. + +function Y=utransfer(u,X,varargin) + Y=zeros(u.sizes_out{1}(1),size(X,2)); + uiter(u,size(X,2),@transferx,[],'label','utransfer',varargin{:}); + + function s=transferx(i,s), Y(:,i)=u.process(X(:,i)); end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/vecedit.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,21 @@ +% vecedit - Graphical editor for real-valued vector +% +% vecedit :: +% [[N]] ~'initial value of editable vector', +% options { +% fig :: handle/gcf ~'figure to use'; +% } +% -> arrow({},{[[N]]},vecedit_state) ~'arrow that generates vectors'. +% +% vecedit takes all options accepted by emousepos and plotter. +function o=vecedit(x0,varargin) + N=length(x0); x0=x0(:); + opts=prefs(varargin{:}); + o = emousepos(opts) * erate(loop(@edit,@(z)x0) * obs_with(plotter(opts)),{[2,1]}) * alatch(x0); + + function [f,g]=edit(m,f) + i=round(m(1)); + if i>=1 && i<=N, f(i)=m(2); end + g=f; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/arrows/with_arrow.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,78 @@ +% with_arrow - Instatiate processing network and run a command against it +% +% with_arrow :: +% arrow(T1:arglist(N),T2:arglist(M),S), +% Cmd:(unit(T1,T2,S) -> action R) ~'function to apply to live unit', +% {[N]->size} ~'sizes of inputs', +% options { +% pause :: boolean/false ~'pause after creation and before destruction of unit'; +% keyboard :: boolean/false ~'drop to debug command line instead of pausing'; +% gui :: boolean/false ~'create Java GUI for viewables' +% } +% -> action R ~'eventually returns any return values from Cmd. +% +% This command brings to life the processing network defined by the +% supplied arrow. The function Cmd is called passing in a structure representing +% the live system. After Cmd, the system is closed in a controlled fashion, +% releasing any system resources that were claimed during construction. +% This occures even if an exception is thrown. HOWEVER - if you press Ctrl-C, +% this generates an uncatchable exception and so resources will not be +% correctly released. +% +% If the gui option is supplied, a Java GUI is created for any viewable +% objects created by the system (Java class samer.core.Viewable). This +% requires that the Java AWT be available, ie usejava('awt')==1. + + +function varargout=with_arrow(sys,cmd,sizes_in,varargin) + opts=prefs('pause',0,'gui',0,'keyboard',0,varargin{:}); + ud.figs=[]; + ud.arrows={}; + set(0,'UserData',ud); + u=construct(sys,sizes_in); + if opts.gui, + if usejava('awt'), + if exist('expose_viewables','file') + frame=expose_viewables(u.viewables,'system'); + else + fprintf('WARNING: could not find expose_viewables function.\n'); + opts.gui=false; + end + else + fprintf('WARNING: cannot create GUI Java AWT is unavailable.\n'); + opts.gui=false; + end + end + if opts.keyboard + whos + fprintf('type "return" to when you have finished snooping around.\n'); + keyboard + elseif opts.pause>0, + msg_pause('press any key to start'); + fprintf('running...'); + end + try, [varargout{1:nargout}]=cmd(u); + catch ex + fprintf('\nwith_arrow: CAUGHT EXCEPTION\n\n'); + % fprintf(getReport(ex)); + if opts.keyboard, keyboard + elseif opts.pause>0, msg_pause('\npress any key to close'); end + if opts.gui, frame.dispose; end + u.dispose(); + rethrow(ex); + end + if opts.keyboard + fprintf('type "return" to when you have finished snooping around.\n'); + keyboard + elseif opts.pause>0, + msg_pause('\npress any key to close'); + end + if opts.gui, frame.close; end + u.dispose(); + set(0,'UserData',[]); +end + +function msg_pause(msg) + fprintf(msg); pause; + fprintf('\n'); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/@linein/linein.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,54 @@ +% linein - Live input signal +% +% linein :: +% C:natural ~'desired no. of channels', +% R:nonneg ~'desired sample rate', +% options { +% bufsize :: natural/0 ~'desired buffer size, 0 is auto' +% } +% -> signal(C,R). +classdef linein < sigbase + properties (GetAccess=private, SetAccess=immutable) + opts + end + methods + function s=linein(channels,rate,varargin) + s=s@sigbase(channels,rate); + s.opts = prefs('bufsize',0,'bits',16,varargin{:}); + end + function c=tostring(sig), c='linein'; end + + function s=construct(sig) + import javax.sound.sampled.*; + import samer.audio.alt.*; + + src=LineSource(audio_format(sig.channels,sig.rate,sig.opts.bits),sig.opts.bufsize); + ref=disposables('reg',src); + fprintf('\nOpened audio input device:\n %s\n',char(src.toString)); + fprintf(' Actual buffer size is %d.\n',src.getLine.getBufferSize); + + s.stop = @stop; + s.start = @start; + s.dispose = @dispose; + s.reader = @reader; + + s.getLine = @()src.getLine(); + + function start, src.start(); src.check(); end + function stop, src.check(); src.stop(); end + function r=reader(n) + ch=sig.channels; + rdr=src.reader(ch*n); + r=@next; + function [x,rem]=next + x=reshape(rdr.next(),ch,n); rem=0; + end + end + + function dispose + disposables('dereg',ref); + src.dispose(); + end + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/@lineout/lineout.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,71 @@ +% lineout - Live audio output +% +% lineout :: +% C:natural ~'desired no. of channels', +% R:nonneg ~'desired sample rate', +% options { +% bufsize :: natural/[] ~'desired buffer size' +% } +% -> sink(C,R). +classdef lineout < sink + properties (GetAccess=private, SetAccess=immutable) + fs + chans + opts + end + methods + function s=lineout(channels,rate,varargin) + s.opts = prefs('bufsize',0,'bits',16,'pad',0,varargin{:}); + s.chans=channels; + s.fs=rate; + end + + function c=tostring(sig), c=sprintf('lineout(%d,%d)',sig.chans,sig.fs); end + function c=channels(s), c=s.chans; end + function c=rate(s), c=s.fs; end + function s=construct(sig) + import samer.audio.alt.*; + + snk=LineSink(audio_format(sig.chans,sig.fs,sig.opts.bits),sig.opts.bufsize); + snk.setScale(0.999); + line=snk.getLine(); + ref=disposables('reg',snk); + fprintf('\nOpened audio output device:\n %s\n',char(snk.toString)); + fprintf(' Actual buffer size is %d.\n',snk.getLine.getBufferSize); + + if sig.opts.pad>0, + fprintf(' Padding start and stop with %d samples.\n',sig.opts.pad); + pad=zeros(sig.chans*sig.opts.pad,1); + padwr=snk.writer(length(pad)); + maybe_pad=@()padwr.write(pad); + else + maybe_pad=@nop; + end + + s.stop = @stop; + s.start = @start; + s.dispose = @dispose; + s.writer = @writer; + + s.getLine = @()line; + s.setGain = @(s)snk.setScale(s); + + function start, line.flush(); line.start(); maybe_pad(); snk.check(); end + function stop, snk.check(); maybe_pad(); line.drain(); line.stop(); end + + function r=writer(n) + ch=sig.chans; + wr=snk.writer(ch*n); + r=@next; + function rem=next(x) + rem=wr.write(x(:))/ch; + end + end + + function dispose + disposables('dereg',ref); + snk.dispose(); + end + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/@sndstream/sndstream.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,82 @@ +% sndstream - file reader implementation using samer.audio.alt.FileSource +% +% sndstream :: +% (unit -> (AudioInputStream, unit -> unit)) ~'function to open stream', +% (unit -> string) ~'function to create character representation', +% options { +% channels :: natural/nan ~'desired number of channels'; +% rate :: nonneg/nan ~'desired sampling rate'; +% bits :: natural/16 ~'desired bits per sample'; +% } +% -> signal(C,R). +% +% If channels or rate are not nan, audio format will be converted to match. +% If either of them are nan, the corresponding value from the audio file will +% be left unchanged. + +classdef sndstream < signal + properties (GetAccess=private, SetAccess=immutable) + streamfn + stringfn + format + end + methods + function s=sndstream(streamfn,varargin) + opts=prefs('channels',nan,'rate',nan,'bits',16, ... + 'stringfn',@()sprintf('sndstream(%s)',tostring(streamfn)), ... + varargin{:}); + + if any(isnan([opts.channels,opts.rate,opts.bits])) + fmt=peek(streamfn); + if isnan(opts.channels), opts.channels=fmt.getChannels(); end + if isnan(opts.rate), opts.rate=fmt.getSampleRate(); end + if isnan(opts.bits), opts.bits=fmt.getSampleSizeInBits(); end + end + if opts.bits<0 + error('Cannot determine bits per sample'); + end + + s.streamfn=streamfn; + s.stringfn=opts.stringfn; + s.format=audio_format(opts.channels,opts.rate,opts.bits); + end + + function s=tostring(sig), s=sig.stringfn(); end + function c=channels(s), c=s.format.getChannels(); end + function r=rate(s), r=s.format.getSampleRate(); end + + function s=construct(sig) + [str,cleanup]=sig.streamfn(false); + src=samer.audio.alt.StreamSource(str,sig.format); + ref=disposables('reg',src); + s.start = @()src.start(); + s.stop = @()src.stop(); + s.reader = @reader; + s.dispose = @dispose; + + function r=reader(n) + ch=src.getFormat.getChannels(); + rdr=src.reader(n*ch); + r=@next; + function [x,rem]=next + x=reshape(rdr.next(),ch,n); + rem=rdr.unread()/ch; + end + end + function dispose + disposables('dereg',ref); + src.dispose(); + cleanup(); + end + end + end +end + +function fmt=peek(streamfn) + [str,cleanup]=streamfn(true); + f1=str.getFormat(); + str.close(); cleanup(); + ss=f1.getSampleSizeInBits(); + if ss<0, ss=16; end + fmt=audio_format(f1.getChannels(),f1.getSampleRate(),ss); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/@wavsink/wavsink.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,67 @@ +% wavsink - file reader implementation using samer.audio.alt.StreamSink +% +% wavsink :: +% (unit -> (InputStream, unit -> unit)) ~'function to open stream', +% (unit -> string) ~'function to create character representation', +% options { +% channels :: natural/nan ~'desired number of channels'; +% rate :: nonneg/nan ~'desired sampling rate'; +% bits :: natural/16 ~'desired bits per sample'; +% } +% -> signal(C,R). +% +% If channels or rate are not nan, audio format will be converted to match. +% If either of them are nan, the corresponding value from the audio file will +% be left unchanged. + +classdef wavsink < sink + properties (GetAccess=private, SetAccess=immutable) + streamfn + stringfn + format + end + + methods + function s=wavsink(ch,rate,streamfn,stringfn,varargin) + opts=prefs('bits',16,varargin{:}); + s.streamfn=streamfn; + s.stringfn=stringfn; + s.format=audio_format(ch,rate,opts.bits); + end + + function s=tostring(sig), s=sig.stringfn(); end + function c=channels(s), c=s.format.getChannels(); end + function r=rate(s), r=s.format.getSampleRate(); end + function s=construct(sig) + import samer.audio.alt.*; + + [str,cleanup]=sig.streamfn(); + snk=StreamSink(StreamSink.wavOutputStream(str, sig.format)); + snk.setScale(0.999); + ref=disposables('reg',snk); + s.start = @()snk.start(); + s.stop = @()snk.stop(); + s.writer = @writer; + s.dispose = @dispose; + + function r=writer(n) + ch=snk.getFormat.getChannels(); + wr=snk.writer(n*ch); + r=@next; + function rem=next(x), rem=wr.write(x(:))/ch; end + end + function dispose + disposables('dereg',ref); + fprintf('Closing WAV output stream.\n'); + snk.dispose(); + cleanup(); + end + end + + end +end + +function str=austream(str) + if ~str.markSupported, str=java.io.BufferedInputStream(str); end + str=javax.sound.sampled.AudioSystem.getAudioInputStream(str); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/audio_format.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,13 @@ +% audio_format - make javax.sound.sampled.AudioFormat object +% +% audio_format :: +% N:natural ~'number of channels', +% R:nonneg ~'sampling rate in Hz' +% -> javax.sound.sampled.AudioFormat. + +function f=audio_format(channels,rate,bits,bigendian) + if isnan(channels), channels=-1; end + if isnan(rate), rate=-1; end + if nargin<3, bits=16; end + if nargin<4, bigendian=false; end + f=javax.sound.sampled.AudioFormat(rate,bits,channels,true,bigendian);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/filesink.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,10 @@ +function s=filesink(ch,rate,file,varargin) + str=sprintf('filesink(''%s'')',file); + s=wavsink(ch,rate,@()filestream(file),@()str,varargin{:}); +end + +function [str,disp]=filestream(file) + import java.io.*; + str=BufferedOutputStream(FileOutputStream(jfile(file))); + disp=@nop; +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/flacfile.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function s=mp3dec(file,varargin) + s=sndpipe(sprintf('flac --decode -o - "%s"',file),'stringfn',@()sprintf('flacfile(''%s'')',file),varargin{:}); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/java/AudioSink.java Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,84 @@ +/* + * AudioSink.java + * + * Copyright (c) 2000, Samer Abdallah, King's College London. + * All rights reserved. + * + * This software is provided AS iS and WITHOUT ANY WARRANTY; + * without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. + */ + +package samer.audio.alt; +import javax.sound.sampled.AudioFormat; + +/** + General interface for objects that accept a stream of + samples. +*/ + +public abstract class AudioSink +{ + AudioFormat format; + double scale; + + public AudioSink(AudioFormat f) { format=f; } + public AudioFormat getFormat() { return format; } + + public double getScale() { return scale; } + public void setScale(double s) { scale=s; } + + public abstract void dispose(); + public abstract void start(); + public abstract void stop(); + public abstract int bwrite(byte [] bbuf, int offs, int len) throws Exception; + + /** Return a task which takes samples from the given buffer + * The idea is that the audio sink can choose the right + * kind of writer depending on the format of the audio stream, + * and then handle any conversions automatically. + * Should return the number of samples NOT written. + */ + + public Writer writer(int len) { + return new Writer(len,format.getSampleSizeInBits()/8); + } + + public class Writer { + byte[] bbuf; + int bps; + Converter conv; + + public Writer(int len, int bps) { + this.bps=bps; + bbuf=new byte[len*bps]; + conv=getConverter(bbuf,bps); + } + + public int write(double dbuf[]) throws Exception { return write(dbuf,0,dbuf.length); } + public int write(double dbuf[], int off, int len) throws Exception { + conv.convert(dbuf,off,len); + int rem=len*bps, pos=0; + while (rem>0) { + int count = bwrite(bbuf, pos, rem); + if (count<=0) { return rem; } + rem -= count; pos += count; + } + return 0; + } + } + + private interface Converter { public void convert(double [] dbuf, int offset, int count); } + private Converter getConverter(final byte [] b,final int bps) { + switch (bps) { + case 1: return new Converter() { public void convert(double[] d,int i, int n) { Util.doubleToByte(d,b,i,n,scale); } }; + case 2: return new Converter() { public void convert(double[] d,int i, int n) { Util.doubleToShort(d,b,i,n,scale); } }; + case 3: return new Converter() { public void convert(double[] d,int i, int n) { Util.doubleToMedium(d,b,i,n,scale); } }; + case 4: return new Converter() { public void convert(double[] d,int i, int n) { Util.doubleToInt(d,b,i,n,scale); } }; + } + throw new Error("Unrecognised sample format"); + } + + protected static void print(String msg) { System.out.println(msg); } +} +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/java/AudioSource.java Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,73 @@ +/* + * AudioSource.java + * + * Copyright (c) 2012, Samer Abdallah + * All rights reserved. + * + * This software is provided AS iS and WITHOUT ANY WARRANTY; + * without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. + */ + +package samer.audio.alt; +import javax.sound.sampled.AudioFormat; + +public abstract class AudioSource +{ + AudioFormat format; + + public AudioSource(AudioFormat f) { format=f; } + + public AudioFormat getFormat() { return format; } + + public abstract void dispose(); + public abstract void start(); + public abstract void stop(); + public abstract int read(byte [] bbuf, int offset, int len) throws Exception; + + public Reader reader(int len) { + return new Reader(len,format.getSampleSizeInBits()/8); + } + + public class Reader { + byte[] bbuf; + double[] dbuf; + int rem, numbytes, bps; + Converter conv; + + public Reader(int numsamples, int bps) { + this.bps=bps; + numbytes=bps*numsamples; + bbuf=new byte[numbytes]; + dbuf=new double[numsamples]; + conv=getConverter(bbuf,dbuf,bps); + rem=0; + } + + public int unread() { return rem; } + public double[] next() throws Exception { + int rem=numbytes, pos=0; + while (rem>0) { + int bytesRead=read(bbuf, 0, rem); + if (bytesRead<=0) { this.rem=rem/bps; return dbuf; } + int count=bytesRead/bps; + conv.convert(pos,count); + pos+=count; rem-=bytesRead; + } + return dbuf; + } + } + + protected interface Converter { public void convert(int pos, int count); } + protected static Converter getConverter(final byte [] bbuf,final double [] dbuf,final int bps) { + switch (bps) { + case 1: return new Converter() { public void convert(int pos, int count) { Util.byteToDouble(bbuf,dbuf,pos,count); } }; + case 2: return new Converter() { public void convert(int pos, int count) { Util.shortToDouble(bbuf,dbuf,pos,count); } }; + case 3: return new Converter() { public void convert(int pos, int count) { Util.mediumToDouble(bbuf,dbuf,pos,count); } }; + case 4: return new Converter() { public void convert(int pos, int count) { Util.intToDouble(bbuf,dbuf,pos,count); } }; + } + throw new Error("Unrecognised sample format"); + } + public static void print(String msg) { System.out.println(msg); } +} +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/java/LineSink.java Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,60 @@ +/* + * LineSink.java + * + * Copyright (c) 2000, Samer Abdallah, King's College London. + * All rights reserved. + * + * This software is provided AS iS and WITHOUT ANY WARRANTY; + * without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. + */ + +package samer.audio.alt; +import javax.sound.sampled.*; + +/** + An AudioSink that sends samples to a Java Sound SourceDataLine. + Audio format can be determined in several ways (see below). + <p> Object is a Viewable, and is called "lineout". + Reads property "scale" from current environment, but scale + can be adjusted afterwards. + @see samer.audio.AudioSink +*/ + +public class LineSink extends AudioSink +{ + private SourceDataLine line; + private int bufsize; + + public LineSink(AudioFormat f, int bufsize) throws Exception { + this((SourceDataLine)AudioSystem.getLine(lineInfo(f,bufsize)),f,bufsize); + } + + public LineSink(SourceDataLine l, AudioFormat f, int bufsize) throws Exception { + super(f); line=l; + if (bufsize==0) line.open(f); else line.open(f,bufsize); + this.bufsize=line.getBufferSize(); + } + + public void dispose() { + print("Closing audio input line."); + try { line.close(); } + catch (Exception ex) { print("line failed to close: "+ex); } + } + + public void start() { line.start(); } + public void stop() { line.stop(); } + public int bwrite(byte [] buf, int off, int n) throws Exception { return line.write(buf,off,n); } + + public DataLine getLine() { return line; } + public void check() { print("LineSink samples in buffer: "+(bufsize-line.available())); } + public String toString() { return "LineSink: "+getLine().getFormat(); } + + public static DataLine.Info lineInfo(AudioFormat fmt) { return lineInfo(fmt,0); } + public static DataLine.Info lineInfo(AudioFormat fmt, int bufsize) { + if (bufsize==0) + return new DataLine.Info( SourceDataLine.class, fmt); + else + return new DataLine.Info( SourceDataLine.class, fmt, bufsize); + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/java/LineSource.java Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,66 @@ +/* + * LineSource.java + * + * Copyright (c) 2012, Samer Abdallah, King's College London. + * All rights reserved. + * + * This software is provided AS iS and WITHOUT ANY WARRANTY; + * without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. + */ + +package samer.audio.alt; +import javax.sound.sampled.*; +import java.io.*; + + +/** + An AudioSource that reads from the sound card in real time. + Uses a standard JavaSound TargetDataLine to get data. + However, an alternative DataLine can be supplied instead. +*/ + +public class LineSource extends AudioSource +{ + private TargetDataLine line; + private int bufsize; + + /** Create LineSource reading from given TargetDataLine */ + public LineSource(AudioFormat f, int bufsize) throws Exception { + this((TargetDataLine)AudioSystem.getLine(lineInfo(f,bufsize)),f,bufsize); + } + + public LineSource(TargetDataLine l,AudioFormat f,int bs) throws Exception { + super(f); line=l; + print("Opening audio data line: "+f); + if (bs==0) line.open(f); else line.open(f,bs); + bufsize=line.getBufferSize(); + } + + public void dispose() { + print("Closing audio data line"); + try { line.close(); } + catch (Exception ex) { + print("line failed to close: "+ex); + } + } + + public void start() { line.flush(); line.start(); } + public void stop() { line.stop(); } + public int read(byte [] buf, int offs, int len) throws Exception { + return line.read(buf,offs,len); + } + + public DataLine getLine() { return line; } + public void check() { print("LineSource buffer room available: "+(bufsize-line.available())); } + public String toString() { return "LineSource("+line.getFormat()+")"; } + + public static DataLine.Info lineInfo(AudioFormat fmt) { return lineInfo(fmt,0); } + public static DataLine.Info lineInfo(AudioFormat fmt, int bufsize) { + if (bufsize==0) + return new DataLine.Info( TargetDataLine.class, fmt); + else + return new DataLine.Info( TargetDataLine.class, fmt, bufsize); + } +} +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/java/StreamSink.java Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,46 @@ +/* + * StreamSink.java + * + * Copyright (c) 2000, Samer Abdallah, King's College London. + * All rights reserved. + * + * This software is provided AS iS and WITHOUT ANY WARRANTY; + * without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. + */ + +package samer.audio.alt; + +import javax.sound.sampled.*; +import java.io.*; + +import org.tritonus.share.sampled.AudioSystemShadow; +import org.tritonus.share.sampled.file.AudioOutputStream; + +/** + An AudioSink that writes to an OutputStream +*/ + +public class StreamSink extends AudioSink +{ + AudioOutputStream out; + + public StreamSink(AudioOutputStream stream) { super(stream.getFormat()); out=stream; } + + public void dispose() { + try { out.close(); } + catch (IOException ex) { print("*** Error closing: "+ex); } + } + + public void stop() {} + public void start() {} + public int bwrite(byte []buf, int off, int n) throws Exception { return out.write(buf, off, n); } + + public String toString() { return "StreamSink: "+getFormat(); } + + public static AudioOutputStream wavOutputStream(OutputStream stream, AudioFormat fmt) throws Exception { + // could alse have raw output stream + return AudioSystemShadow.getAudioOutputStream( + AudioFileFormat.Type.WAVE,fmt,AudioSystem.NOT_SPECIFIED,stream); + } +}
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/java/StreamSource.java Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,103 @@ +/* + * StreamSource.java + * + * Copyright (c) 2012, Samer Abdallah, King's College London. + * All rights reserved. + * + * This software is provided AS iS and WITHOUT ANY WARRANTY; + * without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. + */ + +package samer.audio.alt; +import javax.sound.sampled.*; +import java.io.*; + +public class StreamSource extends AudioSource +{ + InputStream in; + + public StreamSource(AudioInputStream ain) throws Exception { super(ain.getFormat()); in=ain; } + public StreamSource(AudioInputStream ain, AudioFormat target) throws Exception { + this(prepareStream(ain,target)); + } + + // AudioSource interface methods + public void dispose() { + print("Closing audio stream..."); + try { in.close(); } catch (IOException ex) {} + } + + public void start() {} + public void stop() {} + public int read(byte [] buf, int off, int len) throws Exception { + return in.read(buf,off,len); + } + + public static AudioInputStream prepareStream(AudioInputStream ain, AudioFormat target) throws Exception { + // convert to target format if required + print("Preparing audio stream..."); + print(" / audio format: "+ain.getFormat().toString()); + if (target==null) { + AudioFormat fin=ain.getFormat(); + ain=convertFormat(new AudioFormat( fin.getSampleRate(), 16, fin.getChannels(), true, false), ain); + } else { + ain=convertFormat(target, ain); + } + print(" \\ final format: "+ain.getFormat().toString()); + return ain; + } + + private static AudioInputStream convertVia(AudioFormat fout, AudioInputStream sin, AudioFormat fint) throws Exception + { + print(" | Trying recursive via "+fint.toString()); + AudioInputStream sint=AudioSystem.getAudioInputStream(fint,sin); + AudioFormat fres=sint.getFormat(); + if (!fres.equals(fint)) { + print(" | obtained "+fres.toString()); + } + return convertFormat(fout, sint); + } + + public static AudioInputStream convertFormat(AudioFormat fout, AudioInputStream sin) throws Exception + { + AudioFormat fin=sin.getFormat(); + + if (fin.equals(fout)) return sin; + if (fin.getEncoding()!=AudioFormat.Encoding.PCM_SIGNED) { + if (fin.getEncoding().getClass().getName().startsWith("javazoom.spi.")) { + // these are broken, must go via 16 bit decode with no channels change + print(" ! Detected noncompliant Javazoom decoder, going via 16 bit."); + return convertVia( fout, sin, new AudioFormat( + fin.getSampleRate(), 16, fin.getChannels(), true, fout.isBigEndian())); + } + + // first get into PCM encoding, then try recursive + try { + return convertVia( fout, sin, new AudioFormat( + fin.getSampleRate(), fout.getSampleSizeInBits(), + fin.getChannels(), true, fout.isBigEndian())); + } catch (IllegalArgumentException ex) { + print(" * Direct conversion failed"); + } + return convertVia( fout, sin, new AudioFormat( + fin.getSampleRate(), fin.getSampleSizeInBits(), + fin.getChannels(), true, fout.isBigEndian())); + } + + if ( !unify(fin.getChannels(),fout.getChannels()) + || !unify(fin.getSampleSizeInBits(),fout.getSampleSizeInBits())) { + // convert these before doing any sample rate conversion + return convertVia(fout, sin, new AudioFormat( + fin.getSampleRate(), fout.getSampleSizeInBits(), + fout.getChannels(), true, fout.isBigEndian())); + } + + // the only thing left is sample rate + return AudioSystem.getAudioInputStream(fout,sin); + } + + private static boolean unify(int x, int y) { return x==-1 || y==-1 || x==y; } + private static boolean unify(float x, float y) { return x==-1 || y==-1 || x==y; } +} +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/java/TestLine.java Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,63 @@ +package samer.audio.alt; +import javax.sound.sampled.*; + + +public class TestLine { + // Args: <dur> <freq in Hz> <bufsize> <framesize> + public static double TwoPi=2*Math.PI; + + public static class SineSrc { + double ph,freq; + + public SineSrc(double f) { freq=f; ph=0; } + public void next(double [] buf, int l) { + for (int i=0; i<l; i++) { + buf[i]=Math.sin(ph); + ph+=freq; + } + ph -= TwoPi*Math.floor(ph/TwoPi); + } + }; + + public static void main(String[] args) { + int bufsize, N, numframes; + double [] buffer; + double rate, dur, freq; + + if (args.length<4) { + System.out.println("TestLine <dur> <freq in Hz> <bufsize> <framesize>"); + return; + } + + try { + dur=Double.parseDouble(args[0]); + freq=Double.parseDouble(args[1]); + bufsize=Integer.parseInt(args[2]); + N=Integer.parseInt(args[3]); + rate=22050; + + System.out.println("Playing test signal: "+dur+" s, "+freq+"% Hz"); + System.out.println("frame size="+N+" buffer size="+bufsize); + + buffer = new double[N]; + SineSrc src=new SineSrc(2*Math.PI*freq/rate); + LineSink sink=new LineSink(new AudioFormat((float)rate,16,1,true,false),bufsize); + try { + AudioSink.Writer w=sink.writer(N); + numframes = (int)(dur*rate/N); + + sink.start(); + for (int i=0; i<numframes; i++) { + src.next(buffer,N); + w.write(buffer,0,N); + } + sink.getLine().drain(); + sink.stop(); + } finally { + sink.dispose(); + } + } catch(Exception ex) { + } + } +} +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/java/Util.java Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,87 @@ +/* + * AudioSource.java + * + * Copyright (c) 2012, Samer Abdallah + * All rights reserved. + * + * This software is provided AS iS and WITHOUT ANY WARRANTY; + * without even the implied warranty of MERCHANTABILITY or + * FITNESS FOR A PARTICULAR PURPOSE. + */ + +package samer.audio.alt; + +public class Util +{ + /* NB. These copying functions allow NEGATIVE offset (off<0). The semantics + * of this is are that n values are copied from source to destination, writing + * into the destination starting at the negative offset, but that values before + * index 0 will never be accessed, hence, they are not actually copied. Only + * the last n-off values will be available in dst starting from index 0. + * This is useful as it allows block-wise audio input where the block lenght + * is smaller than the step length. + */ + + public static void intToDouble(byte [] src, double [] dst, int off, int n) { + int i, j; + if (off<0) { i= 4*(-off); j=0; } else { i=0; j=off; } + while (j<n+off) dst[j++] = (1.0/(256.0*8388608.0))*((src[i++]&0xff) | (src[i++]&0xff)<<8 | (src[i++]&0xff)<<16 | src[i++]<<24); + } + + public static void mediumToDouble(byte [] src, double [] dst, int off, int n) { + int i, j; + if (off<0) { i= 3*(-off); j=0; } else { i=0; j=off; } + while (j<n+off) dst[j++] = (1.0/8388608.0)*((src[i++]&0xff) | (src[i++]&0xff)<<8 | src[i++]<<16); + } + + public static void shortToDouble(byte [] src, double [] dst, int off, int n) { + int i, j; + if (off<0) { i= 2*(-off); j=0; } else { i=0; j=off; } + while (j<n+off) dst[j++] = (1.0/32768.0)*((src[i++]&0xff) | src[i++]<<8); + } + + public static void byteToDouble(byte [] src, double [] dst, int off, int n) { + int i, j; + if (off<0) { i= -off; j=0; } else { i=0; j=off; } + while (j<n+off) dst[j++] = (1.0/128.0)*src[i++]; + } + + public static void doubleToInt(double[] src, byte [] dst, int off, int n, double k) { + k*=65536.0*32768; + for (int i=0, j=off; j<n+off; j++) { + int y = (int)(k*src[j]); + dst[i++] = (byte)(y&0xff); + dst[i++] = (byte)(y>>8 & 0xff); + dst[i++] = (byte)(y>>16 & 0xff); + dst[i++] = (byte)(y>>24); + } + } + + public static void doubleToMedium(double[] src, byte [] dst, int off, int n, double k) { + k*=256.0*32768; + for (int i=0, j=off; j<n+off; j++) { + int y = (int)(k*src[j]); + dst[i++] = (byte)(y&0xff); + dst[i++] = (byte)(y>>8 & 0xff); + dst[i++] = (byte)(y>>16); + } + } + + public static void doubleToShort(double[] src, byte [] dst, int off, int n, double k) { + k*=32768; + for (int i=0, j=off; j<n+off; j++) { + int y = (int)(k*src[j]); + dst[i++] = (byte)(y&0xff); + dst[i++] = (byte)(y>>8 & 0xff); + } + } + + public static void doubleToByte(double [] src, byte[] dst, int off, int n, double k) { + k*=128; + for (int i=0, j=off; j<n+off; j++) { + int y = (int)(k*src[j]) + 128; + dst[i++] = (byte)(y&0xff); + } + } +} +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/monofile.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +% monofile - Return single channel version of signal in an audiofile +% +% NB using sndfile with channels=1 option results in clipping due to +% crappy implementation of Tritonus PCM2PCM converter. +function s=monofile(n), s=mixdown(sndfile(n));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/mp3enc.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function s=mp3enc(ch,rate,file,varargin) + opts=prefs('quality',5,varargin{:}); + s=pipesink(ch,rate,sprintf('lame -h -V %d - "%s"',opts.quality,file));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/mp3file.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function s=mp3dec(file,varargin) + s=sndpipe(sprintf('mpg123 --au - "%s"',file),'stringfn',@()sprintf('mp3file(''%s'')',file),varargin{:}); +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/mp3read.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,205 @@ +function [Y,FS,NBITS,OPTS] = mp3read(FILE,N,MONO,DOWNSAMP) +% [Y,FS,NBITS,OPTS] = mp3read(FILE,N,MONO,DOWNSAMP) Read MP3 audio file +% FILE is an MP3 audio file name. Optional scalar N limits the number +% of frames to read, or, if a two-element vector, specifies +% the first and last frames to read. +% Optional flag MONO forces result to be mono if nonzero; +% Optional factor DOWNSAMP performs downsampling by 2 or 4. +% Y returns the audio data, one channel per column; FS is the +% sampling rate. NBITS is the bit depth (always 16). +% OPTS.fmt is a format info string. +% 2003-07-20 dpwe@ee.columbia.edu This version calls mpg123. +% 2004-08-31 Fixed to read whole files correctly +% 2004-09-08 Uses mp3info to get info about mp3 files too +% 2004-09-18 Reports all mp3info fields in OPTS.fmt; handles MPG2LSF sizes +% + added MONO, DOWNSAMP flags, changed default behavior. + +if nargin < 2 + N = 0; +else + if length(N) == 1 + % Specified N was upper limit + N = [1 N]; + end +end +if nargin < 3 + forcemono = 0; +else + forcemono = (MONO ~= 0); +end +if nargin < 4 + downsamp = 1; +else + downsamp = DOWNSAMP; +end +if downsamp ~= 1 & downsamp ~= 2 & downsamp ~= 4 + error('DOWNSAMP can only be 1, 2, or 4'); +end + +%%%%%%% Hard-coded behavior +%% What factor should we downsample by? (1 = no downsampling, 2 = half, 4=qtr) +%downsamp = 4; +%% Do we want to force the data to be single channel? (1 = yes, 0= keep orig) +%forcemono = 1; + +%%%%%% Location of the binaries +% SA: removed directory parts - let OS find them +mpg123 = 'mpg123'; +mp3info = 'mp3info'; + +%%%%%% Constants +NBITS=16; + +%%%%%% Probe file to find format, size, etc. using "mp3info" utility +% SA: removed bitrate query as VBR mp3 break the code +%cmd = [mp3info, ' -p "%Q %u %r %v * %C %e %E %L %O %o %p" "', FILE,'"']; +cmd = [mp3info, ' -p "%Q %u %v * %C %e %E %L %O %o %p" "', FILE,'"']; +% Q = samprate, u = #frames, r = bitrate, v = mpeg version (1/2/2.5) +% C = Copyright, e = emph, E = CRC, L = layer, O = orig, o = mono, p = pad +w = mysystem(cmd); +% Break into numerical and ascii parts by finding the delimiter we put in +starpos = findstr(w,'*'); +nums = str2num(w(1:(starpos - 2))); +strs = tokenize(w((starpos+2):end)); + +SR = nums(1); +nframes = nums(2); +nchans = 2 - strcmp(strs{6}, 'mono'); +layer = length(strs{4}); +% bitrate = nums(3)*1000; +mpgv = nums(3); +% Figure samples per frame, after +% http://board.mp3-tech.org/view.php3?bn=agora_mp3techorg&key=1019510889 +if layer == 1 + smpspfrm = 384; +elseif SR < 32000 & layer ==3 + smpspfrm = 576; + if mpgv == 1 + error('SR < 32000 but mpeg version = 1'); + end +else + smpspfrm = 1152; +end + +%OPTS.fmt.mpgBitrate = bitrate; +OPTS.fmt.mpgVersion = mpgv; +% fields from wavread's OPTS +%OPTS.fmt.nAvgBytesPerSec = bitrate/8; +OPTS.fmt.nSamplesPerSec = SR; +OPTS.fmt.nChannels = nchans; +%OPTS.fmt.nBlockAlign = smpspfrm/SR*bitrate/8; +OPTS.fmt.nBitsPerSample = NBITS; +OPTS.fmt.mpgNFrames = nframes; +OPTS.fmt.mpgCopyright = strs{1}; +OPTS.fmt.mpgEmphasis = strs{2}; +OPTS.fmt.mpgCRC = strs{3}; +OPTS.fmt.mpgLayer = strs{4}; +OPTS.fmt.mpgOriginal = strs{5}; +OPTS.fmt.mpgChanmode = strs{6}; +OPTS.fmt.mpgPad = strs{7}; +OPTS.fmt.mpgSampsPerFrame = smpspfrm; + +if SR == 16000 & downsamp == 4 + error('mpg123 will not downsample 16 kHz files by 4 (only 2)'); +end + +% SA: -1 causes mono output +if downsamp>1, + downsampstr = [' -',num2str(downsamp)]; +else + downsampstr = ''; +end + +FS = SR/downsamp; + +if forcemono == 1 + nchans = 1; + chansstr = ' -m'; +else + chansstr = ''; +end + +% Size-reading version +if strcmp(N,'size') == 1 + % SA: fixed this (actually, it's still wrong most of the time...) + Y = [smpspfrm*ceil(nframes/downsamp), nchans]; +% Y = [floor(smpspfrm*nframes/downsamp), nchans]; +else + + % Temporary file to use + tmpfile = ['/tmp/tmp',num2str(round(1000*rand(1))),'.wav']; + + skipx = 0; + skipblks = 0; + skipstr = ''; + sttfrm = N(1)-1; + if sttfrm > 0 + skipblks = floor(sttfrm*downsamp/smpspfrm); + skipx = sttfrm - (skipblks*smpspfrm/downsamp); + skipstr = [' -k ', num2str(skipblks)]; + end + + lenstr = ''; + endfrm = -1; + if length(N) > 1 + endfrm = N(2); + if endfrm > sttfrm + decblk = 1+ceil(endfrm*downsamp/smpspfrm) - skipblks; + lenstr = [' -n ', num2str(decblk)]; + end + end + % Run the decode + cmd=[mpg123, downsampstr, chansstr, skipstr, lenstr, ' -q -w ', tmpfile, ' ', '"',FILE,'"']; + %disp(cmd); + mysystem(cmd); + + % Load the data + [Y,SR] = wavread(tmpfile); + + %fprintf('%d blocks decoded producing %d samples.\n',decblk,length(Y)); + % Delete tmp file + mysystem(['rm ', tmpfile]); + + % Select the desired part + if endfrm > sttfrm + Y = Y(skipx+[1:(endfrm-sttfrm)],:); + elseif skipx > 0 + Y = Y((skipx+1):end,:); + end + +end + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +function w = mysystem(cmd) +% Run system command; report error; strip all but last line +[s,w] = system(cmd); +if s ~= 0 + error(['unable to execute ',cmd]); +end +% Keep just final line +w = w((1+max([0,findstr(w,10)])):end); +% Debug +%disp([cmd,' -> ','*',w,'*']); + +%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%%% +function a = tokenize(s) +% Break space-separated string into cell array of strings +% 2004-09-18 dpwe@ee.columbia.edu +a = []; +p = 1; +n = 1; +l = length(s); +nss = findstr([s(p:end),' '],' '); +for ns = nss + % Skip initial spaces + if ns == p + p = p+1; + else + if p <= l + a{n} = s(p:(ns-1)); + n = n+1; + p = ns+1; + end + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/oggenc.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function s=oggenc(ch,rate,file,varargin) + opts=prefs('quality',5,varargin{:}); + s=pipesink(ch,rate,sprintf('oggenc -q %d -o "%s" -',opts.quality,file));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/oggfile.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=oggdec(file) + s=sndpipe(sprintf('ogg123 -d au -f - "%s"',file),'stringfn',@()sprintf('oggfile(''%s'')',file));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/pipesink.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function s=pipesink(ch,rate,cmd,varargin) + str=sprintf('pipesink(''%s'')',cmd); + s=wavsink(ch,rate,@()pipeout(cmd),@()str,varargin{:}); +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/playaudio.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,72 @@ +function playaudio(Y,Rate,varargin) +% playaudio - Play stream of audio data using Java objects. +% +% playaudio :: +% X:seq [[C,N]] ~'sequence of arrays', +% R:nonneg ~'sampling rate', +% options { +% maxbuf :: natural/2*max(size(X)) ~'maximum buffer size'; +% pause :: natural ~'pause between buffers? (see optpause)'; +% hook :: cell { (S->S), S } ~'iterator and initial state'. +% iterator :: forall(A, (A->A,A,options {} -> A)) ~'iteration fn'; +% sync_delta :: nonneg ~'period of polling loop when waiting for audio sync'; +% sync_offset :: integer ~'offset in samples between audio playback and other activities' +% } +% -> action. +% +% The offset mechanism allows the playback loop to become (relatively) precisely +% timed with respect to audio playback. If some action is scheduled to run after +% each buffer is sent to the audio system (by using the hook mechanism), the call +% to the action is timed to coincide with the start of playback of the last submitted +% audio buffer plus the value of sync_offset (which is in frames). So, if your action +% takes, eg 1000 frames worth of time to produce its visible output, you could set +% sync_offset to -1000. +% +% The synchronisation mechanism works by waiting for audio playback to reach a certain +% point before returning from the function playbuf() (which submits data to the +% audio system.) The wait loop repeatedly checks the audio playback position while +% sleeping for sync_delta seconds between checks. If sync_delta is too large, precision +% will be off. If sync_delta is too small, CPU usage will be high. +% +% All options get passed to iterator too, so those options apply. + + opts=prefs('pause',0,'iterator',@iterate,varargin{:}); + it=feval(getparam(opts,'hook',@id),{@playbuf,Y}); + maxbuf=getparam(opts,'maxbuf',size(Y,2)); + sync_delta=getparam(opts,'sync_delta',0.005); + sync_offset=getparam(opts,'sync_offset',0); + + L=construct(lineout(size(Y,1),Rate)); + try + write=L.writer(maxbuf); + LL=L.getLine(); + + pos0=getLongFramePosition(LL); + pos=pos0+maxbuf+sync_offset; + + L.start(); + write(zeros(maxbuf,1)); + opts.iterator(it{1},it{2},opts); + write(zeros(maxbuf,1)); + L.stop(); + catch ex + L.dispose(); + rethrow(ex); + end + L.dispose(); + + function Y=playbuf(Y) + y=head(Y); + n=size(y,2); + if n>0, write(y); end + + % try to wait until audio playback reaches the start of the just + % submitted buffer + sync_offset. +% while getLongFramePosition(LL)<pos +% pause(sync_delta); +% if ~isActive(LL), break; end +% end + Y=next(Y); pos=pos+n; + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/playaudio_async.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,44 @@ +function [Sched,GetData]=playaudio_async(Y,Snk,varargin) +% playaudio_async - Play stream of audio data asynchronously +% +% playaudio :: +% X:seq [[N]] ~'sequence of arrays', +% R:nonneg ~'sampling rate', +% options { +% maxbuf :: natural/2*max(size(X)) ~'maximum buffer size'; +% hook :: (iterator(S)->iterator(T)) ~'fn to build iterator'; +% onstart :: A -> action ~'called BEFORE timer starts'; +% onstop :: A -> action ~'called AFTER timer stops'; +% onfinish:: A -> action ~'called when end of signal reached'; +% defer :: bool / 0 ~'if 1, don't start the timer' +% } +% -> sched(S) ~'scheduler api functions', +% (S -> [[N]]) ~'function to recover audio from iterator state'. +% +% iterator(S) ::= cell {(S->action S)~'state transformer', S~'initial state'}. +% +% sched(S) ::= struct { +% dispose :: unit -> action unit; +% isrunning :: unit -> action bool; +% startat :: real -> action unit; +% start :: unit -> action unit; +% stop :: unit -> action unit; +% rewind :: unit -> action unit; +% getstate :: unit -> action S; +% setstate :: S -> action unit +% }. +% +% The 'hook' option gives the caller an opportunity to elaborate on the +% 'iterator' used to drive the audio playback. The 'iterator' is a cell +% array contain a state transformer function and initial state. The caller +% can use this to build a more complex iterator the does other things +% for each buffer of samples. +% +% The third return value is a function which can be used in a state +% transformer function to recover a buffer of audio samples from the +% current state. +% +% NB: all the audio buffers must be the same size for this to work. +% NB: the rewind function should only be called when the timer is stopped. + [Sched,GetData]=playaudio_unfold(size(Y,2),@decons,Y,Snk),varargin{:}); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/playaudio_unfold.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,95 @@ +function [Sched,GetData]=playaudio_unfold(buflen,unfold_fn,S,Snk,varargin) +% playaudio_async - Play stream of audio data asynchronously +% +% playaudio :: +% N:natural ~'buflen', +% (S->[[C,N]],S) ~'unfolding function', +% sink(C,N) ~'sink', +% options { +% maxbuf :: natural/2*max(size(X)) ~'maximum buffer size'; +% hook :: (iterator(S)->iterator(T)) ~'fn to build iterator'; +% onstart :: A -> action ~'called BEFORE timer starts'; +% onstop :: A -> action ~'called AFTER timer stops'; +% onfinish:: A -> action ~'called when end of signal reached'; +% defer :: bool / 0 ~'if 1, don't start the timer' +% } +% -> sched(S) ~'scheduler api functions', +% (S -> [[N]]) ~'function to recover audio from iterator state'. +% +% iterator(S) ::= cell {(S->action S)~'state transformer', S~'initial state'}. +% +% sched(S) ::= struct { +% dispose :: unit -> action unit; +% isrunning :: unit -> action bool; +% startat :: real -> action unit; +% start :: unit -> action unit; +% stop :: unit -> action unit; +% rewind :: unit -> action unit; +% getstate :: unit -> action S; +% setstate :: S -> action unit +% }. +% +% The 'hook' option gives the caller an opportunity to elaborate on the +% 'iterator' used to drive the audio playback. The 'iterator' is a cell +% array contain a state transformer function and initial state. The caller +% can use this to build a more complex iterator the does other things +% for each buffer of samples. +% +% The third return value is a function which can be used in a state +% transformer function to recover a buffer of audio samples from the +% current state. +% +% NB: all the audio buffers must be the same size for this to work. +% NB: the rewind function should only be called when the timer is stopped. + + N=buflen; + opts=prefs('onstop',@nop,'onstart',@nop,'onfinish',@nop, ... + 'period_adjust',0.9,'preload',2,'sched',@iterate_timed,varargin{:}); + + it=feval(getparam(opts,'hook',@id),{@playbuf,S}); + + maxbuf=getparam(opts,'maxbuf',2*N); + sync_delta=getparam(opts,'sync_delta',0.02); + sync_offset=getparam(opts,'sync_offset',0); + + L=construct(Snk); + write=L.writer(maxbuf); + period=(N/rate(Snk))*opts.period_adjust; + + Sched=opts.sched(it{1},it{2},period, ... + 'exec_mode','fixedRate', 'busy_mode','drop', opts, ... + 'onstart',@onstart,'onstop',@onstop); + getstate=Sched.getstate; + odispose=Sched.dispose; + Sched.atend=@()isempty(getstate()); + Sched.dispose=@dispose; + Sched.setGain=L.setGain; + + GetData=@head; + + function dispose + odispose(); + L.dispose(); + end + + function onstart(S), + opts.onstart(S); + L.start(); + for i=1:opts.preload + write(zeros(maxbuf,1)); + end + end + + function onstop(S), + write(zeros(maxbuf,1)); + L.stop(); + opts.onstop(S); + end + + function S=playbuf(S) + [y,S]=unfold_fn(S); + n=size(y,2); + if n>0, write(y); end + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/private/austream.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function str=austream(str) + if ~str.markSupported, str=java.io.BufferedInputStream(str); end + str=javax.sound.sampled.AudioSystem.getAudioInputStream(str); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/private/isbigendian.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function f=isbigendian + import java.nio.ByteOrder; + f=(ByteOrder.nativeOrder==ByteOrder.BIG_ENDIAN); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/private/jfile.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function f=jfile(path) + % The problem was that file names with accents in where not being found + % when converted to Java file names. + % I have no idea what is going on here but it seems to work + f=java.io.File(java.lang.String(unicode2native(path,'latin1'),'UTF8'));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/private/pipein.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +function [str,cleanup]=pipein(cmd,q) + if nargin<2, q=false; end + if ~q, fprintf('Starting sub-process: %s\n',cmd); end + process=java.lang.Runtime.getRuntime().exec({'bash','-c',cmd}); + str=process.getInputStream(); + cleanup=@dispose; + + function dispose + if ~q, fprintf('Killing subprocess...\n'); end + process.destroy(); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/private/pipeout.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +function [str,cleanup]=pipeout(cmd) + fprintf('Starting sub-process: %s\n',cmd); + process=java.lang.Runtime.getRuntime().exec({'bash','-c',cmd}); + str=process.getOutputStream(); + cleanup=@dispose; + + function dispose + fprintf('Killing subprocess...\n'); + process.destroy(); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/rawpipe.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,26 @@ +% rawpipe - pipe reader implementation of sndstream (raw audio stream) +% +% rawpipe :: +% string ~'shell pipe', +% AudioFormat~'stream format', +% options { +% channels :: natural/nan ~'desired number of channels'; +% rate :: nonneg/nan ~'desired sampling rate'; +% bits :: natural/16 ~'desired bits per sample'; +% } +% -> signal(C,R). +% +% If channels or rate are not nan, audio format will be converted to match. +% If either of them are nan, the corresponding value from the audio file will +% be left unchanged. +function s=rawpipe(cmd,fmt,varargin) + s=sndstream(@pipestream,'stringfn',@()sprintf('rawpipe(''%s'')',cmd),varargin{:}); + + function [str,cleanup]=pipestream(q) + [str,cleanup]=pipein(cmd,q); + str=javax.sound.sampled.AudioInputStream(str,fmt,-1); + end +end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/sndfile.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,34 @@ +% sndfile - file reader implementation using samer.audio.alt.FileSource +% +% sndfile :: +% path ~'file name' +% options { +% channels :: natural/nan ~'desired number of channels'; +% rate :: nonneg/nan ~'desired sampling rate'; +% bits :: natural/16 ~'desired bits per sample'; +% } +% -> signal(C,R). +% +% If channels or rate are not nan, audio format will be converted to match. +% If either of them are nan, the corresponding value from the audio file will +% be left unchanged. +% +% Javazoom MP3 decoder does not get the length of the signal right. +% Would be better to use mpg123 on a pipe in this case. +function s=sndfile(file,varargin) + string=sprintf('sndfile(''%s'')',file); + if endswith(file,'mp3') || endswith(file,'MP3') + s=mp3file(file,'stringfn',@()string,varargin{:}); % Java version doesn't remove padding correctly + else + s=sndstream(@filestream,'stringfn',@()string,varargin{:}); + end + + function [str,cleanup]=filestream(q) + jf=jfile(file); + if ~jf.exists(), error(sprintf('File %s does not exist',file)); end + if ~q, fprintf('Opening sound file: %s\n',file); end + str=austream(java.io.FileInputStream(jf)); + cleanup=@nop; + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/sndpipe.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,25 @@ +% sndpipe - pipe reader implementation of sndstream +% +% sndpipe :: +% string ~'shell pipe' +% options { +% channels :: natural/nan ~'desired number of channels'; +% rate :: nonneg/nan ~'desired sampling rate'; +% bits :: natural/16 ~'desired bits per sample'; +% } +% -> signal(C,R). +% +% If channels or rate are not nan, audio format will be converted to match. +% If either of them are nan, the corresponding value from the audio file will +% be left unchanged. +function s=sndpipe(cmd,varargin) + s=sndstream(@pipestream,'stringfn',@()sprintf('sndpipe(''%s'')',cmd),varargin{:}); + + function [str,cleanup]=pipestream(q) + [str,cleanup]=pipein(cmd,q); + str=austream(str); + end +end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/audio/sndread.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,8 @@ +function X=sndread(file,FS,varargin) + opts=prefs('bs',1024,varargin{:}); + sig=sndfile(file,opts); + i=info(sig); + if isfinite(i.length), init=ceil(1.01*i.length*rate(sig)/opts.bs); + else init=fs; end + X=gather(sig,'chunk',opts.bs,'init',init); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/HRTimer.java Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,47 @@ + +package saml.sched; + +public class HRTimer { + + private static long min_sleep=1000000; // 1 ms + private static long wake_before=500000; // 0.1ms + + public static void setMinimumSleepTime(long t) { min_sleep=t; } + public static void setWakePrealarm(long t) { wake_before=t; } + + public static long now() { return System.nanoTime(); } + public static long sleepUntil(long t1) throws Exception { + long t0=System.nanoTime(); + long dt=t1-t0; + // System.out.println("need to wait for " + dt +"ns"); + if (dt>min_sleep) { + long sleep_time=dt-wake_before; + long millis=sleep_time/1000000; + int nanos=(int)(sleep_time-millis*1000000); + // System.out.println("will sleep for "+millis+"ms + "+nanos+"ns"); + Thread.sleep(millis,nanos); + } + + // go into a tight loop for the last few microseconds + t0=System.nanoTime(); + // System.out.println("need to spin for "+(t1-t0)+"ns"); + while (t0<t1) t0=System.nanoTime(); + return t0-t1; + } + + public static long estimateMinSleep() throws Exception { + long t0,t1; + + t0=System.nanoTime(); + Thread.sleep(0,1); + t1=System.nanoTime(); + return t1-t0; + } + + public static long estimateGranularity() { + long t0, t1; + t0=System.nanoTime(); + t1=System.nanoTime(); + return t1-t0; + } +};
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/README Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,31 @@ +Functions for timed execution + +nows - current time in seconds +nows_hr - current time in seconds, high resolution timer +now_ns_hr - current time in seconds, high resolution timer +sleeptill_hr + +sched - +msched - Each event is an action which returns the next event to schedule +ssched - Single action with threaded state, action returns time for next event +rsched - Schedule regular periodic events, single action, threaded state +rsched2 - +lsched - States and times are predermined in a sequence +rlsched - Sequences of states to be acted upon at regular intervals + +sch_wait.m +sched_at - Use given timer to schedule one-shot event +sched_rec +schedabs.m +schedabs_hr.m +iterate_sched.m + +timed_action - Call action and return actual time just after execution +isrunning.m +mrndnotes.m +srndnotes.m +statuscb.m + +timer_gc.m +timer_release.m +timer_wait.m
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/isrunning.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +% isrunning - true if timer is running +% +% isrunning :: timer -> bool. +function f=isrunning(T), f=isvalid(T) && strcmp(get(T,'Running'),'on');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/iterate_sched.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,23 @@ +function tm=iterate_sched(nextfn,X,T,varargin) +% iterate_sched - Iterate function under control of timer +% +% iterate_sched :: +% (A->action A) ~'state transformer action', +% A ~'initial state', +% real ~'time between updates in seconds' +% options { +% drawnow :: {0,1} /0 ~'call drawnow after each iteration'; +% busy_mode :: {'queue','drop'} /'queue' ~'See TIMER'; +% its :: natural / inf ~'iteration limit' +% -> timer. + + opts=prefs('its',inf,'drawnow',0,'busy_mode','queue','props',{},varargin{:}); + if opts.drawnow, post=@drawnow; else post=@nop; end + + tm=rlsched(@action,nows,T,opts.its,iterdata(nextfn,X)); + function t1=action(S,t0,t1) + disp(S) + post(); + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/lsched.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,73 @@ +function Timer=lsched(action,evs) +% lsched - SCHEDule using List of times and parameters to fixed action +% +% lsched :: +% ( S ~'action parameter' +% double ~'scheduled time', +% double ~'actual time' +% -> double ~'actual execution time' +% ) ~'the action to perform at each time', +% seq cell { +% double ~'time of event', +% S ~'argument to pass to action' +% } ~'the list of times and parameters to action' +% -> action timer ~'timer being used'. +% +% Note: this timer will DROP events if they cannot be scheduled roughly +% on time. However, if an event is scheduled with time to spare, but +% for some reason is called late, then it is not dropped. + + persistent ERROR % for estimating of timing errors + + ERROR=[]; + + warning('off','MATLAB:TIMER:STARTDELAYPRECISION'); + + Timer=timer; + if isempty(evs), return; end + + [t0,s0]=cdeal(head(evs)); + + % plan is to use a one shot timer to schedule next + % event. Then, after the timer stops, the StopFcn callback + % is called and we schedule the next event and restart the + % timer. This is really messy - should use my own timer + % facilities written in Java.. + set(Timer,'UserData',{t0,s0,next(evs)}); % fst event and rest + set(Timer,'TimerFcn',@onalarm,'StopFcn',@chain); + set(Timer,'StartDelay',max(0,t0-nows)); + start(Timer); + + function onalarm(o,e) + [t0,s0,evs]=cdeal(get(o,'UserData')); + % could potentially call a 'stalled' + % action if we are very late here + tt=a(s0,t0,e.Data.time); + ERROR=vertcat(ERROR,tt-t0); + end + + % called + function chain(o,e) + [t0,s0,evs]=cdeal(get(o,'UserData')); + + if ~isempty(evs) + correction=mean(ERROR); + + while 1 + [t1,s1]=cdeal(head(evs)); + delay=t1-correction-nows; + if delay>=0 break; end + fprintf('\n| dropping event, lag=%g',-delay); + evs=next(evs); + end + + set(o,'UserData',{t1,s1,next(evs)}); + set(o,'StartDelay',delay); + start(o); + else + fprintf('\n| stopping\n'); + plot(ERROR); + timer_release(o); + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/msched.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,62 @@ +function Timer=msched(e0) +% msched - Schedule events where each event returns the next event. +% +% msched :: +% cell { +% double ~'time of event', +% event ~'first event action' +% } +% -> action timer ~'timer being used'. +% +% event ::= +% ( double ~'scheduled time', +% double ~'actual time' +% -> action ( +% event ~'the next event action', +% double ~'time for next action', +% double ~'execution time of current event' +% ) +% ). + +% this is most like a Routine or Task in Supercollider, except +% that instead of coroutining via yield, each action explicitly +% returns the continuation action. + + persistent ERROR + + ERROR=[]; + warning('off','MATLAB:TIMER:STARTDELAYPRECISION'); + + [t0,a0]=cdeal(e0); + + Timer=timer; + set(Timer,'TimerFcn',@(o,e)timercb(o,e,t0,a0),'StopFcn',@chain); + set(Timer,'StartDelay',max(0,t0-nows)); % there will be some small error here.. + start(Timer); + + function timercb(o,e,t,a) + [a1,t1,tt]=a(t,e.Data.time); + set(o,'UserData',{a1,t1}); + ERROR=vertcat(ERROR,tt-t); + end + + function chain(o,e) + [a1,t1]=cdeal(get(o,'UserData')); + correction=mean(ERROR); + while ~isempty(t1) + tnow=nows; + delay=t1-correction-tnow; + if delay>=0, + set(o,'TimerFcn',@(oo,ee)timercb(oo,ee,t1,a1)); + set(o,'StartDelay',delay); + start(o); + return; + end + [a1,t1,tt]=a1(t1,tnow); + end + + fprintf('\n| stopping\n'); + set(o,'UserData',ERROR); + timer_release(o); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/now_ns_hr.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +function t=now_ns_hr +% now_ns_hr - Now in nanoseconds using high resolution timer in JVM +% +% now_ns_hr :: unit -> real ~'time in nanoseconds'. + +t=saml.sched.HRTimer.now; +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/nows.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function T=nows, T=now*86400; end +% nows - Current time in seconds +% +% nows :: () -> action double.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/nows_hr.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +function t=nows_hr +% nows_hr - Now using high resolution timer in JVM +% +% nows_hr :: unit -> real ~'time in seconds'. + +t=saml.sched.HRTimer.now/1e9; +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/rlsched.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,51 @@ +function Timer=rlsched(a,t0,dt,n,ss) +% rlsched - Schedule list of events at regular intervals +% +% rlsched :: +% ( S ~'state' +% double ~'scheduled time', +% double ~'actual time' +% -> action double ~'execution time of current event' +% ), +% double ~'start time', +% double ~'timer period' +% natural~'iterations' +% seq S ~'sequence of states' +% -> action timer ~'timer being used'. +% +% SEMANTICS; +% +% This scheduler will drop events that are definitely late, but some events may +% execute that may turn out to be late. + + warning('off','MATLAB:TIMER:STARTDELAYPRECISION'); + + Timer=timer; + set(Timer,'ExecutionMode','fixedrate','Period',dt,'BusyMode','drop'); + set(Timer,'UserData',{t0,ss},'TimerFcn',@timercb,'TasksToExecute',n); + set(Timer,'StartDelay',max(0,t0-nows)); + start(Timer); + + function timercb(o,e) + [t0,s0]=cdeal(get(o,'UserData')); + te=datevec(e.Data.time); + if t0>=te + tt=a(head(s0),t0,e.Data.time); + else + fprintf('\n| late by %g',te-t0); + end + t1=t0+dt; + s1=next(s0); + + while ~isempty(s1) + if t1>tt + set(o,'UserData',{t1,s1}); + return; + end + fprintf('\n| skipping'); + t1=t1+dt; + s1=next(s1); + end + stop(o); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/rsched.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,161 @@ +function api=rsched(a,S0,dt,T0,varargin) +% rsched - Schedule regular events with state using timer +% +% rsched :: +% ( S ~'state' +% nonneg ~'current period', +% double ~'scheduled time', +% datenum ~'actual time' +% -> action ( +% S ~'the next event', +% double ~'execution time of current event' +% ) +% ) ~'state transformer', +% S ~'first state', +% double ~'timer period', +% double ~'start time', +% options { +% its :: natural/inf ~'iteration limit'; +% defer :: bool/0 ~ 'if true, do not start timer'; +% error :: real/0 ~ 'estimate of timing error on timer start'; +% final :: bool/0 ~ 'make final state available?'; +% +% onstart :: ( +% S ~'current state', +% real ~'scheduled start time' +% datenum ~'actual time' +% -> action unit)/@nop ~ 'called on timer start'; +% +% onstop :: ( +% S ~'current state', +% datenum ~'actual time' +% -> action unit)/@nop ~ 'called on timer stop'; +% +% onfinish:: ( +% S ~'final state', +% datanum ~'actual time' +% -> action unit)/@nop ~ 'called if state seq finishes'; +% +% busy_mode :: {'queue','drop'}; +% exec_mode :: {'fixedRate','fixedDelay','fixedSpacing'} +% } +% -> action struct { +% timer :: timer ~'timer being used'; +% startat :: (double -> action unit) ~'start timer at given time'; +% start :: (unit -> action unit) ~'start timer asap'; +% stop :: (unit -> action unit) ~'stop timer'; +% rewind :: (unit -> action unit) ~'rewind to first state'; +% trim :: (double -> action double)~'trim timing errors'; +% dispose :: (unit -> action unit) ~'stop timer'; +% getstate :: (unit -> action S) ~'current state'; +% setstate :: (S -> action unit) ~'set state (only when stopped)'; +% isrunning:: (unit -> action bool) ~'true if scheduler is running' +% }. +% +% NB: switching on final state availability option 'final' can make +% timer callbacks much slower due to requirement for copying state. + + + warning('off','MATLAB:TIMER:STARTDELAYPRECISION'); + warning('off','MATLAB:TIMER:RATEPRECISION'); + + opts=prefs('defer',0,'its',inf,'final',0, ... + 'onstart',@nop,'onstop',@nop,'onfinish',@nop, ... + 'busy_mode','queue','exec_mode','fixedRate',varargin{:}); + + % Implementation note: it's MUCH faster to use a local variable + % as mutable state instead of using the timer getter and setter. + State={T0,S0}; + STARTERR=getparam(opts,'error',0); + DT=dt; + + if opts.final, timfn=@adv; else timfn=@adv2; end + Timer=timer('ExecutionMode',opts.exec_mode,'BusyMode',opts.busy_mode, ... + 'StartFcn',@startfn,'StopFcn',@stopfn,'TimerFcn',timfn, ... + 'Period',DT,'TasksToExecute',opts.its); + + api = struct(... + 'dispose', @()delete(Timer), ... + 'isrunning',@()isrunning(Timer), ... + 'startat', @startat, ... + 'start', @startnow, ... + 'stop', @()stop(Timer), ... + 'rewind', @()setstate(S0), ... + 'getstate', @getstate, ... + 'setstate', @setstate, ... + 'trim', @trim, ... + 'timer', @()Timer ... + ); + + if opts.final, api.finalstate=@()State{1}; end + if ~opts.defer, startat(T0); end + + function check(msg), if isrunning(Timer), error(msg); end; end + function err=trim(derr), STARTERR=STARTERR+derr; err=STARTERR; end + function s=getstate, s=State{2}; end + function setstate(s), + check('Cannot set state of running scheduler'); + State{2}=s; + end + + function startat(t0) % !! what if timer is already running? + check('Timer is already running'); + State{1}=t0; + start_delay = t0-nows-STARTERR + if start_delay<0 + fprintf('\n| WARNING: start delay=%f, starting now.',start_delay); + start_delay=0; + end + set(Timer,'StartDelay',start_delay); + start(Timer); + end + + function startnow % !! what if timer is already running? + check('Timer is already running'); + State{1}=nows+STARTERR; + set(Timer,'StartDelay',0); + start(Timer); + end + + function stopfn(o,e), + opts.onstop(State{2},e.Data.time); + if isempty(State{2}), + opts.onfinish(State{1},e.Data.time); + end + end + + function startfn(o,e) + DT=get(o,'Period'); % use current period in timer callback + opts.onstart(State{2},State{1},e.Data.time); + end + + % if final state not required we can use faster assign in place + function adv2(o,e) + t0=State{1}; + [State{2},tt]=a(State{2},DT,t0,e.Data.time); + % could accumulate stats about tt-t0 here + + if isempty(State{2}), + State{1}=[]; + stop(o); + else + State{1}=t0+DT; + end + end + + % final state required + function adv(o,e) + [t0,s0]=State{:}; + [s1,tt]=a(s0,DT,t0,e.Data.time); + % could accumulate stats about tt-t0 here + + if isempty(s1), + State{1}=s0; + State{2}=[]; + stop(o); + else + State{1}=t0+DT; + State{2}=s1; + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/rsched2.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,124 @@ +function api=rsched(schedfn,S0,dt,T0,varargin) +% rsched - Schedule regular events with state using timer +% +% rsched :: +% ( S ~'state' +% nonneg ~'current period', +% double ~'scheduled time', +% datenum ~'actual time' +% -> action ( +% S ~'the next event', +% double ~'execution time of current event' +% ) +% ) ~'action to schedule regularly', +% S ~'first state', +% double ~'timer period', +% double ~'start time', +% options { +% its :: natural/inf ~'iteration limit'; +% defer :: bool/0 ~ 'if true, do not start timer'; +% error :: real/0 ~ 'estimate of timing error'; +% +% onstart :: ( +% S ~'current state', +% real ~'scheduled start time' +% datenum ~'actual time' +% -> action unit)/@nop ~ 'called on timer start'; +% +% onstop :: ( +% S ~'current state', +% datenum ~'actual time' +% -> action unit)/@nop ~ 'called on timer stop'; +% +% onfinish:: ( +% S ~'final state', +% datanum ~'actual time' +% -> action unit)/@nop ~ 'called if state seq finishes'; +% +% busy_mode :: {'queue','drop'}; +% exec_mode :: {'fixedRate','fixedDelay','fixedSpacing'} +% } +% -> action struct { +% timer :: timer ~'timer being used'; +% startat :: (double -> action unit) ~'start timer at given time'; +% start :: (unit -> action unit) ~'start timer asap'; +% stop :: (unit -> action unit) ~'stop timer'; +% rewind :: (unit -> action unit) ~'rewind to first state'; +% trim :: (double -> action double)~'trim timing errors'; +% dispose :: (unit -> action unit) ~'stop timer'; +% getstate :: (unit -> action S) ~'current state'; +% setstate :: (S -> action unit) ~'set state (only when stopped)'; +% isrunning:: (unit -> action boo) ~'true if scheduler is running' +% }. +% +% !! What about collecting final state when done? + + + warning('off','MATLAB:TIMER:STARTDELAYPRECISION'); + warning('off','MATLAB:TIMER:RATEPRECISION'); + + opts=prefs('defer',0,'its',inf, ... + 'onstart',@nop,'onstop',@nop,'onfinish',@nop, ... + 'busy_mode','queue','exec_mode','fixedRate',varargin{:}); + + % Implementation note: it's MUCH faster to use a local variable + % as mutable state instead of using the timer getter and setter. + State=S0; SchedStart=T0; + STARTERR=getparam(opts,'error',0); + + Timer=timer('ExecutionMode',opts.exec_mode,'BusyMode',opts.busy_mode, ... + 'StartFcn',@startfn,'StopFcn',@stopfn,'TimerFcn',@timercb, ... + 'Period',dt,'TasksToExecute',opts.its); + + api = struct(... + 'dispose', @()delete(Timer), ... + 'isrunning',@()isrunning(Timer), ... + 'startat', @startat, ... + 'start', @startnow, ... + 'stop', @()stop(Timer), ... + 'rewind', @()setstate(S0), ... + 'getstate', @getstate, ... + 'setstate', @setstate, ... + 'trim', @trim ... + ); + + if ~opts.defer, startat(T0); end + + function check(msg), if isrunning(Timer), error(msg); end; end + function err=trim(derr), STARTERR=STARTERR+derr; err=STARTERR; end + function s=getstate, s=State; end + function setstate(s), + check('Cannot set state of running scheduler'); + State=s; + end + + function startat(t0) % !! what if timer is already running? + check('Timer is already running'); + SchedStart=t0; + set(Timer,'StartDelay',t0-nows-STARTERR); + start(Timer); + end + + function startnow % !! what if timer is already running? + check('Timer is already running'); + SchedStart=nows+STARTERR; + set(Timer,'StartDelay',0); + start(Timer); + end + + function stopfn(o,e), + opts.onstop(State,e.Data.time); + if isempty(State), + opts.onfinish([],e.Data.time); + end + end + + function startfn(o,e) + opts.onstart(State,SchedStart,e.Data.time); + end + + function timercb(o,e) + State=schedfn(State); + if isempty(State), stop(o); end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/sch_wait.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function sch_wait(S) + while S.isrunning(); pause(0.05); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/sched.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,26 @@ +function x=sched(f,dt,nout) +% sched - execute action after delay +% +% sched :: +% (unit -> action (A1,...,AN)) ~'action with N return values', +% nonneg ~'delay in seconds', +% M:natural ~'number of output arguments to collect' +% -> unit -> action (A1,...,AM). +% +% After use, timer is marked for deletion but you must call +% timer_gc to actually delete it. + + if nargin<3, nout=0; end + rc=cell(1,nout); + tim=timer('TimerFcn',@(t,e)timfn,'StopFcn',@stopfn,'StartDelay',dt); + start(tim); + x=@()collect(); + + function timfn, [rc{:}]=f(); end + function stopfn(t,e), timer_release(t); end + function varargout=collect(), + if isvalid(tim), wait(tim); end + varargout=rc; + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/sched_at.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +function sched_at(Timer,T,F) +% sched_at - Use one-shot timer to schedule action +% +% sched_at :: timer(off), double, (timer(on), timer_event -> action) -> action. +% +% Can only be used on a stopped timer, whereas callback executes with +% a running timer. +% sched_at - Use one-shot timer to schedule callback + +set(Timer,'TimerFcn',F,'StartDelay',quant(0.001,T-nows)); +start(Timer);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/sched_rec.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +function sched_rec(t,action) + + t=t*1e9; + t1=sleeptill_hr(t); + dt=action((t1-t)*1e-9); + while ~isempty(dt) + t=t+dt*1e9; + t1=sleeptill_hr(t); + dt=action((t1-t)*1e-9); + end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/schedabs.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +function schedabs(t,action) + + t=t*1e9; + t1=sleeptill_hr(t); + dt=action((t1-t)*1e-9); + while ~isempty(dt) + t=t+dt*1e9; + t1=sleeptill_hr(t); + dt=action((t1-t)*1e-9); + end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/schedabs_hr.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function schedabs_hr(t,action) + + t1=sleeptill_hr(t*1e9); + action(t1*1e-9-t);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/sleeptill_hr.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function sleeptill_hr(t), saml.sched.HRTimer.sleepUntil(t);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/ssched.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,62 @@ +function Timer=ssched(ee) +% ssched - Schedule events using timer with state threading through event calls +% +% ssched :: +% cell { +% ( S ~'state' +% double ~'scheduled time', +% double ~'actual time' +% -> S ~'next state', +% double ~'next execution time', +% double ~'actual execution time' +% ), +% double ~'time of first event', +% S ~'initial state' +% } +% -> action timer ~'timer being used'. +% +% Semantics: +% +% Because subsequent events are dependent on the return values from previous +% events, we must call each event action even if we know it is late. It is up +% the actions themselves to decide what to do if they are late. + + persistent ERROR + ERROR=[]; + + warning('off','MATLAB:TIMER:STARTDELAYPRECISION'); + + [a,t0,s0]=cdeal(ee); + + Timer=timer; + set(Timer,'UserData',{t0,s0}); + set(Timer,'TimerFcn',@timercb,'StopFcn',@chain); + set(Timer,'StartDelay',max(0,t0-nows)); % there will be some small error here.. + start(Timer); + + function timercb(o,e) + [t0,s0]=cdeal(get(o,'UserData')); + [s1,t1,tt]=a(s0,t0,e.Data.time); + set(o,'UserData',{t1,s1}); + ERROR=vertcat(ERROR,tt-t0); + end + + function chain(o,e) + [t1,s1]=cdeal(get(o,'UserData')); + correction=mean(ERROR); + while ~isempty(t1) + tnow=nows; + delay=t1-correction-tnow; + if delay>=0, + set(o,'StartDelay',delay); + start(o); + return; + end + [s1,t1,tt]=a(s1,t1,tnow); + end + + fprintf('\n| stopping\n'); + set(o,'UserData',ERROR); + delete(o); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/statuscb.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,10 @@ +function f=statuscb(msg) +% statuscb - Returns status message timer callback function handle +% +% statuscb :: string -> (timer(_), timer_event -> action). +% +% Eg, +% set(Timer,'StartFcn',statuscb('starting')); +% set(Timer,'StopFcn',statuscb('stopping')); + +f=@(t,e)fprintf('%s: %s\n',mat2str(e.Data.time),msg);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/timed_action.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,9 @@ +function a0=timed_action(x) + + a0=@aa; + + function [a1,tt]=aa(t0,ta), + a1=x(t0); + tt=nows; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/timer_gc.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +% gctimers - Deletes all timers that have been released using releasetimer +% +% gctimer :: unit -> action unit. +function gctimers, delete(timerfindall('Tag','defunct'));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/timer_release.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +% releasetimer - Mark timer for garbage collection +% +% release :: timer -> action unit. +function release(t), set(t,'Tag','defunct'); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sched/timer_wait.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +% waitfortimer - Wait for timer to stop running +% +% waitfortimer :: timer -> action unit. +% waitfortimer :: timer, nonneg ~'time quantum for waiting' -> action unit. +% +% If no wait quantum is supplied, the default is 50ms. + +function waittimer(T,dt) + + if nargin<2, dt=0.05; end + while isvalid(T) && strcmp(T.Running,'on') + pause(dt); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@bindcat/bindcat.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,41 @@ +function o=bindcat(X,F,varargin) +% bindcat - sort of monadic bind for sequences. +% +% bindcat :: +% data A ~ 'the first sequence', +% (data A->data A)~ 'function to return second sequence given last element of first' +% -> data A ~ 'resultant sequence'. +% +% The resulting sequence consists of the entire sequence represented by the +% first parameter, followed by the sequence obtained by applying the second +% parameter to the last nonempty element of the first sequence. +% +% Example: +% +% gather(2,bindcat(celldata({1,2,3,4}),@(x)take(head(x),0))) +% +% ans = 1 2 3 4 0 0 0 0 + + +if nargin==0, o=bindcat(0,@id); +elseif nargin==1 && isa(sources,'bindcat'), o=elems; +else + if isempty(X), o=F(X); % degenerate case + else + o.nfn=F; + o=class(o,'bindcat',ddata(X,size(X), ... + 'datafn',@datafn,'charfn',@stringfn,'nextfn',@nextfn, ... + varargin{:})); + end +end + + +function x=datafn(o), x=headsource(o); +function s=stringfn(o), s=sprintf('%s >>= %s',tostring(source(o)),char(o.nfn)); +function o1=nextfn(o), + o1=next_c(o); + if isempty(o1), o1=o.nfn(source(o)); end + + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@bindcat/extract.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function y=extract(o,dim,range) +% EXTRACT - Extract a sub-array + +y=extract(o.source,dim,range);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@bufferdata/bufferdata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,50 @@ +function a=bufferdata(source,L,varargin) +% bufferdata - collect elements of sequence into sequence of arrays +% +% bufferdata :: +% data [[N]] ~'source signal', +% L:natural ~'buffer width', +% -> data [[N,L]]. ~'buffered sequence (no-overlapping)'. + + +if nargin==1 && isa(source,'bufferdata'), a=source; +elseif nargin==0, a=bufferdata([],1); +else + sz=size1(source); + + a.dim = length(sz)+1; + a.width = L; + [a.buf,source] = readcat(a.dim,source,L); + + if isempty(a.buf), a=[]; + else + % sort out function table + ft.datafn=@datafn; + ft.stringfn=@stringfn; + ft.nextfn = @nextfn; + + a=class(a,'bufferdata',ddata(source,[sz L],ft)); + end +end + +function s=stringfn(a), s=sprintf('buffer(%d)',a.width); +function x=datafn(a), x=a.buf; +function a=nextfn(a) + % read next lot of values and make an array + src=source(a); + [a.buf,src]=readcat(a.dim,source(a),a.width); + if isempty(a.buf), a=[]; + else + a=setsource(a,src); + %!! what if i<L? + %a.length=size(source(a),a.dim); + end + +function [buf,src]=readcat(dim,src,L) + buf=[]; + for i=1:L + if isempty(src), break; end + buf=cat(dim,buf,head(src)); + src=next(src); + end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@bufferdata/hop.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function h=hop(o) +% HOP - Return hop size for windowed data object +h=o.hop; +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@bufferdata/subsref.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,10 @@ +function y=subsref(a,S) +% subsref - subsref for bufferdata + +switch S(1).type +case '()', y=paren(a,S(1)); +end + +if length(S)>1, y=subsref(y,S(2:end)); end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@bufferdata/width.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function h=width(o) +% width - return width of buffers +h=o.width; +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@cache/cache.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,25 @@ +function o=cache(source) +% CACHE- Cache each buffer to speed up multiple reads +% +% cache :: seq A -> seq A. +% +% The idea is that the data is cached on each call to NEXT, +% so that reading the array does not require calls to source. + +if nargin==0, o=cache(0); +elseif isa(source,'cache'), o=source; +else + ft.datafn=@datafn; + ft.stringfn=@stringfn; + ft.nextfn=@cachenext; + o.x=head(source); + o=class(o,'cache',ddata(source,size(source),ft)); +end + +function x=datafn(o), x=o.x; +function s=stringfn(o), s='cache'; +function o=cachenext(o) + o=next_c(o); + if ~isempty(o), o.x=head(source(o)); end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@celldata/celldata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,38 @@ +function o=celldata(elems,varargin) +% CELLDATA - Convert cell array directly to sequence +% +% celldata :: +% {[L]->[[[N,M]]A} ~ 'cell array of L N-by-M arrays', +% -> data [[N,M]]. ~ 'resultant sequence'. + + +if nargin==1 && isa(elems,'celldata'), o=elems; +elseif nargin==0, o=celldata({[]}); +elseif isempty(elems), o=[]; +else + o.elems=elems; + ft.datafn=@datafn; + ft.charfn=@stringfn; + ft.nextfn=@nextfn; + + o=class(o,'celldata',data(size(elems{1}),ft)); +end + +function x=datafn(o), x=o.elems{1}; +function s=stringfn(o), s=sprintf('celldata(%d)',length(o.elems)); +function o=nextfn(o), + if length(o.elems)>1, o.elems=o.elems(2:end); + else o=[]; + end + if ~isempty(o), + h=o.elems{1}; + if isa(h,'data') + o=setsize(o,[1,1]); + else + o=setsize(o,size(o.elems{1})); + end + end + + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@celldata/seq2cell.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +function Y=seq2cell(X) +% seq2cell - gather elements of sequence into a cell array +% +% seq2cell :: data A -> {[N]->A}. +% +% Note: this version is an optimised version for celldata +Y=X.elems;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@concat/concat.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,54 @@ +function o=concat(sources,varargin) +% concat - Concatenate sequences +% +% concat :: +% seq (seq A) ~ 'sequence of sequences' +% -> seq A ~ 'resultant sequence'. +% +% concat :: +% {[N]->seq A} ~ 'cell array of N data objects', +% -> seq A ~ 'resultant sequence'. + + +if nargin==0, o=concat(repeat(0)); +elseif nargin==1 && isa(sources,'concat'), o=elems; +else + if iscell(sources), sources=celldata(sources); end + if isempty(sources), o=[]; return; end + + hd=head(sources); + while isempty(hd) + sources=next(sources); + if isempty(sources), o=[]; return; end + hd=head(sources); + end + o.current=hd; + o.sources=next(sources); + ft.datafn=@datafn; + ft.charfn=@stringfn; + ft.nextfn=@nextfn; + + o=class(o,'concat',data(size(o.current),ft)); +end + + +function x=datafn(o), x=head(o.current); +function s=stringfn(o), s=sprintf('concat(%s|...)',tostring(o.current)); +function o=nextfn(o), + s1=next(o.current); + if ~isempty(s1), + o.current=s1; + o=setsize(o,size(o.current)); + else + if isempty(o.sources), o=[]; return; end + + hd=head(o.sources); + while isempty(hd) + o.sources=next(o.sources); + if isempty(o.sources), o=[]; return; end + hd=head(o.sources); + end + o.current=hd; + o.sources=next(o.sources); + o=setsize(o,size(hd)); + end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@concat/extract.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function y=extract(o,dim,range) +% EXTRACT - Extract a sub-array + +y=extract(o.current,dim,range);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@concat/source.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function s=source(o), s=o.current;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@cycle/cycle.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,24 @@ +function o=cycle(source) +% cycle - cycles through input sequence repeatedly +% +% cycle :: seq A -> seq A. + +if nargin==0 + o=cycle(singleton(0)); +elseif isa(source,'cycle') + o=source +elseif isempty(source), o=[] +else + ft.stringfn=@stringfn; + ft.datafn=@datafn; + ft.nextfn=@nextfn; + o=class(struct('head',source),'cycle',ddata(source,size(source),ft)); +end + +function x=datafn(o), x=head(source(o)); +function s=stringfn(o), s='cycle'; +function o1=nextfn(o), + o1=next_c(o); + if isempty(o1), + o1=setsize(setsource(o,o.head),size(o.head)); + end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@cycle/extract.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function y=extract(o,dim,range) +% EXTRACT - Extract a sub-array + +y=extract(source(o),dim,range);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/abs.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function y=abs(x) + +y=fndata(@abs,x,'size',size(x));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/binfun.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,28 @@ +function o=binfun(A,B,fn,op) +% BINFUN - Apply binary function to one or two sequences +% +% Three cases: +% binfun :: seq A, seq B, (A,B->C), string -> seq C +% binfun :: A, seq B, (A,B->C), string -> seq C +% binfun :: seq A, B, (A,B->C), string -> seq C + + if isa(A,'data'), + if isa(B,'data'), + o=zipdata(fn,2,A,B,'charfn',@zipcharfn); + else + o=fndata( @(x)fn(x,B), A, ... + 'charfn',bind(@charfn,'.',tostring(B))); + end + else + o=fndata( @(y)fn(A,y), B, ... + 'charfn',bind(@charfn,tostring(A),'.')); + end + + function s=zipcharfn(o) + s=sprintf('{ %s, %s } >> %s',tostring(sources(o,1)),tostring(sources(o,2)),op); + end + + function s=charfn(a,b,o) + s=sprintf('%s >> %s(%s,%s)',tostring(source(o)),op,a,b); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/binop.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +function o=binop(A,B,fn,op) +% BINOP - Binary operation +% +% binop :: seq A, seq B, (A,B->C), string -> seq C. +% +% Three cases +% A is data, B is an array +% A is array, B is data + + if isa(A,'data'), + if isa(B,'data'), + o=zipdata(fn,2,A,B,'charfn',@zipcharfn); + else + o=fndata(@(x)fn(x,B), A, 'charfn',bind(@charfn,'',tostring(B))); + end + else + o=fndata(@(y)fn(A,y),B, 'charfn',bind(@charfn,tostring(A),'')); + end + + function s=zipcharfn(o) + s=sprintf('{ %s, %s } >> %s',tostring(sources(o,1)),tostring(sources(o,2)),op); + end + + function s=charfn(a,b,o) + s=sprintf('%s >> (%s%s%s)',tostring(source(o)),a,op,b); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/buffer.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,15 @@ +function o=buffer(source,n,m,varargin) +% BUFFER - Buffer abstract data object +% +% buffer :: (source:data, frame:natural, overlap:natural)->data +% Works exactly like the usual buffer function but when applied +% to a data object, returns a fndata object. + +args=[{n,m} varargin]; +o=fndata(@(z)buf(args,z),source,'charfn',@(o)charfn(n,n-m,o)); + +function x=buf(args,y) + x=buffer(y,args{:}); + +function s=charfn(n,m,o) + s=sprintf('%s >> buffer(%d/%d)',tostring(source(o)),n,m);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/cat.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,8 @@ +function o=cat(dim,varargin) +% CAT - array concatenation for data sequences + +if length(varargin)==2 + o=binfun(varargin{1},varargin{2},@(a,b)cat(dim,a,b),'cat(1,...)'); +else + o=zipdata(bind(@cat,dim),length(varargin),varargin{:}); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/char.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=char(d) +s=feval(d.charfn,d);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/cos.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function y=cos(x), y=fndata(@cos,x,'size',size(x));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/ctranspose.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function o=ctranspse(A) +% CTRANSPOSE - complex transpose of data source + +o=fndata(@ctranspose,A,'size',fliplr(size(A)));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/cumsum.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,25 @@ +function y=cumsum(x,n) +% cumsum - cumsum for data sequences +% +% cumsum :: seq [[N,M]], D:natural -> seq [[N,M]]. +% +% cumulative sum taken along Dth dimension of the array + +if length(size(x))>2 + error('cumsum not supported for >2 dim array sequences'); +end + +switch n + case 1 + y=scandata(@cs1,zeros(1,size(x,2)),x); + case 2 + y=scandata(@cs2,zeros(size(x,1),1),x); + case 3 + error('cumsum(.,3) not supported for sequences'); +end + +function w=cs1(s,z) + w=row(cumsum([s(end,:);z],1),2:size(z,1)+1); + +function w=cs2(s,z) + w=col(cumsum([s(:,end),z],2),2:size(z,2)+1);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/data.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,34 @@ +function o=data(b,varargin) +% DATA - Base class for abstract data objects +% +% data :: (size:[1,E], ~ size of data arrays +% options...) ~ vararg options +% -> data ~ data object +% +% Options +% 'datafn': data[size] -> [size] # required +% 'nextfn': data[size] -> data[size] # @id +% 'charfn': data[size] -> string # def=\d->'' +% +% Usage d:data[size] +% next(d) :: data[size] ~ next buffer in sequence +% head(d) :: [size] ~ current array +% d.size, size(d): size ~ size of array +% d(i:natural,j:natural):real ~ extract one element +% d(i:[n],j:[m]): [n,m:real] ~ extract sub-array +% char(d): string ~ format as string + +if nargin==0 + o=data([1,1],'datafn',@(z)0); +elseif isa(b,'data'), o=b; +else + p=prefs('nextfn',@id,'charfn',@charfn,varargin{:}); + a.size =b; + a.datafn=p.datafn; + a.nextfn=p.nextfn; + a.charfn=p.charfn; + o=class(a,'data'); +end + +function s=charfn(o), s='<data>'; +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/datafn.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function f=datafn(o) +% datafn - return data function bound to this object + +f=bind(o.datafn,o);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/decons.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function [x,b]=decons(a) +% decons - Extract head and tail of sequence + +x=a.datafn(a); +b=a.nextfn(a);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/display.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function display(d) + +s=d.charfn(d); if ~isempty(s), s=[':' s]; end +display(sprintf(' [%s]%s\n',mat2str(size(d)),s));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/dispseq.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,20 @@ +function dispseq(x,n,varargin) +% dispseq - Display elements of sequence +% +% dispseq :: seq A -> action. +% display elements of sequence with a pause in between each. +% +% dispseq :: seq A, N:natural -> action. +% display first N elements without pause. +% +% dispset :: seq A, N:natural, options {} -> action. +% display first N elements passing given options to foreach. +% If N is inf or [], the defaults is to pause betweem each +% element unless overridded by supplied options. + + if nargin<2 || isempty(n) || isinf(n), + foreach(@disp,x,'pause',1,varargin{:}); + else + foreach(@disp,take(n,x),varargin{:}); + end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/double.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function x=double(a) +% DOUBLE - Convert data to double array + +x=a.datafn(a);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/dynfilter.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,15 @@ +function y=dynfilter(ab,x,z,dim) +% dynfilter - filter for sequences of array with dynamically varying filter coeffs +% +% dynfilter :: seq {[[P]],[[P]]}, seq [Size], [[P]], D:natural -> seq [Size]. +% dynfilter :: seq {[[P]],[[P]]}, seq [Size], [[P]] -> seq [Size]. +% dynfilter :: seq {[[P]],[[P]]}, seq [Size] -> seq [Size]. +% +% filtering is done along Dth dimension of the array (default=1) + +if nargin<5, + dim=find(size(x)>1,1); + if nargin<4, z=[]; end +end + +y = zipaccum(@(ab1,x1,z1)filter(ab1{1},ab1{2},x1,z1,dim),z,{ab,x});
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/end.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function n=end(a,k,m) + +if m==length(a.size), n=a.size(k); +else n=prod(a.size); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/eq.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function o=eq(A,B) +o=binop(A,B,@eq,'==');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/exp.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function y=exp(x), y=fndata(@exp,x,'size',size(x));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/extract.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function x=extract(a,dim,range) +% EXTRACT - Extract a sub-array + +x=extract(head(a),dim,range);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/fft.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function y=fft(x), y=fndata(@fft,x,'size',size(x));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/filter.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,16 @@ +function y=filter(a,b,x,z,dim) +% filter - filter for sequences of array +% +% filter :: [[P]], [[P]], seq [Size], [[P]], D:natural -> seq [Size]. +% filter :: [[P]], [[P]], seq [Size], [[P]] -> seq [Size]. +% filter :: [[P]], [[P]], seq [Size] -> seq [Size]. +% +% filtering is done along Dth dimension of the array (default=1) + +if nargin<5, + dim=find(size(x)>1,1); + if isempty(dim), dim=1; end + if nargin<4, z=[]; end +end + +y = sfndata(@(x1,z1)filter(a,b,x1,z1,dim),z,x);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/foldl.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,17 @@ +function x=foldl(fn,e,y) +% foldl - Foldl combinator for data sequences +% +% This function applies an associative operator to a list of arguments, +% starting from the left using the given starting element. +% +% foldl :: +% (X,Y->X) ~'associative binary operator', +% X ~'initial element', +% seq Y ~'a lazy data sequence' +% -> X. + +if ~isdata(y) + error('stupid dumb arse matlab method dispatch is wrong'); +end + +x=folddata(fn,e,y);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/foreach.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,13 @@ +function foreach(f,X,varargin) +% foreach - do an action for each element in a sequence in order +% +% foreach :: (A->action), seq A, options {} -> action. +% +% foreach takes the same options as iterate. + + iterate(@g,X,varargin{:}); + function x=g(x) + f(head(x)); + x=next(x); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/gather.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,76 @@ +function [Y,X0]=gather(dim,X,varargin) +% gather - make big array of all arrays in a sequence +% +% gather :: N:natural, data [D] -> [E], data [D]. +% gather :: +% N:natural ~'the dimension along which to collect arrays', +% data [D] ~'the data to gather', +% options { +% draw :: boolean /0 ~'whether or not to call plotfn every iteration'; +% plotfn :: data [D]->handle ~'plotting function'; +% save :: natural /0 ~'if >0, then save state every this many interations'; +% recover:: boolean / 0 ~'if 1, then attempt to restart from saved state'; +% id :: string /'@gather' ~'file to save state' +% } +% -> [E], data [D]. +% +% E is such that E(I) = D(I) if I~=N. The second return +% is the final data object in the sequence + +Y=[]; i=1; +if nargin<3 % simple version + if ~isempty(X), + Y=head(X); + while 1 + X0=X; X=next(X0); + if isempty(X), break; end + Y=cat(dim,Y,head(X)); + end + end +else + opts=prefs('save',0,'recover',0,'draw',0,'plotfn',@nullplot,varargin{:}); + draw=opts.draw; + savn=opts.save; + + if opts.recover && exist([opts.id,'.mat'],'file') + load(opts.id); + X=next(X0); + fprintf('recovering from i=%d\n',i); + end + + if savn==0 && ~draw + if ~isempty(X) + Y=head(X); + while 1 + X0=X; X=next(X0); + if isempty(X), break; end + Y=cat(dim,Y,head(X)); + end + end + else + if savn>0 + fprintf('Will save every %d iterations to %s.mat\n',savn,opts.id); + end + + if ~isempty(X) + Y=head(X); + while 1 + X0=X; X=next(X0); i=i+1; + if draw, opts.plotfn(X0); end + if mod(i,savn)==0, + fprintf('saving at %d.\n',i); + save(opts.id,'X0','Y','opts','i','dim'); + end + optpause(opts); + if isempty(X), break; end + Y=cat(dim,Y,head(X)); + end + end + if savn>0, delete([opts.id '.mat']); end + % hope nothing goes wrong here! + end +end + +function nullplot(A,B), return + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/ge.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function o=ge(A,B) +o=binop(A,B,@ge,'>=');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/gt.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function o=gt(A,B) +o=binop(A,B,@gt,'>');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/head.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function x=head(a) +% head - Extract head of sequence + +x=a.datafn(a);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/horzcat.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +function o=horzcat(varargin) +% horzcat - horizontal array concatenation for data sequences +% +% horzcat :: +% seq [[N,M1,L]], +% seq [[N,M2,L]] +% -> seq [[N,M1+M2,L]]. + + +if length(varargin)==2 + o=binfun(varargin{1},varargin{2},@horzcat,'[,]'); +else + o=zipdata(@horzcat,length(varargin),varargin{:}); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/ifft.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function y=ifft(x), y=fndata(@ifft,x,'size',size(x));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/imagesc.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function h=imagesc(A,varargin) + +h=imagesc(head(A),varargin{:});
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/integrate.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +function y=integrate(x,n,a,ff) +% integrate - integrate data sequence +% +% integrate :: +% seq [[N1,N2]] ~'sequence to integrate', +% D:natural ~'dimension to integrate along', +% [[M1,M2]] ~'initial value', +% ( [[M1,M2]] -> [[M1,M2]]) ~'function to filter initial value each block' +% -> seq [[N,M]]. +% +% cumulative sum taken along Dth dimension of the array + + if length(size(x))>2 + error('cumsum not supported for >2 dim array sequences'); + end + + if nargin<4, ff=@(t)t; end + + switch n + case 1, y=scandata(@cs1,a,x); + case 2, y=scandata(@cs2,a,x); + case 3, error('integrate(.,3) not supported for sequences'); + end + + function w=cs1(s,z), w=row(cumsum([ff(s(end,:));z],1),2:size(z,1)+1); end + function w=cs2(s,z), w=col(cumsum([ff(s(:,end)),z],2),2:size(z,2)+1); end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/isfinite.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function o=isfinite(A) +% isfinite - isfinite for sequences. + +o=fndata(@isfinite, A,'size',size(A));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/isinf.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function o=isinf(A) +% isinf - isinf for sequences. + +o=fndata(@isinf, A,'size',size(A));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/isnan.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function o=isnan(A) +% isnan - isnan for sequences. + +o=fndata(@isnan, A,'size',size(A));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/ldivide.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +function o=ldivide(A,B) +% TIMES - Matrix multiplication for data objects +% +% usage: C=times(A,B)=A.*B +% +% Three cases +% A is data, B is an array +% A is array, B is data +% A and B are both data - can't handle this yet + +o=binop(A,B,@ldivide,'.\');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/le.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function o=le(A,B) +o=binop(A,B,@le,'<=');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/length.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function l=size(a,n) + +l=max(a.size);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/limit.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,29 @@ +function [y,its]=limit(d,X,varargin) +% limit - Get the limit of an infinite sequence if it exists +% +% limit :: +% (A,A->nonneg) ~ 'metric', +% seq A, ~ 'sequence of converging values', +% options { +% maxit/10e6 ~ 'maximum iterations'; +% tol/1e-5 ~ 'convergence tolerance' +% } +% -> A, natural. + opts=prefs('maxit',10e6,'tol',1e-5,varargin{:}); + + tol=opts.tol; + S.x=head(X); + S.X=next(X); + S.f=false; + S.its=0; + S=iterate(@converger,S,'its',opts.maxit); + y=S.x; + its=S.its; + + function S=converger(S) + xx=head(S.X); + S.X=next(S.X); + S.its=S.its+1; + if d(S.x,xx)<tol, S=[]; else S.x=xx; end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/log.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function y=log(x) + +y=fndata(@log,x,'size',size(x));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/log10.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function y=log(x) + +y=fndata(@log10,x,'size',size(x));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/log2.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function y=log(x) + +y=fndata(@log2,x,'size',size(x));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/logmap.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function y=logmap(x,varargin), + + argpos=1+(1:length(varargin)); + y=fndata(bindat(@logmap,argpos,varargin{:}),x,'size',size(x));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/lt.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function o=lt(A,B) +o=binop(A,B,@lt,'<');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/magspec.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function y=magspec(x), y=fndata(@magspec,x,'size',[1+size(x,1)/2 size(x,2)]);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/map.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,10 @@ +function x=map(fn,e,varargin) +% map - map function over data sequences +% +% map :: (Y->X), seq X -> seq Y. + +if ~isa(e,'data') + error('stupid dumb arse matlab method dispatch is wrong'); +end + +x=fndata(fn,e,varargin{:});
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/mapaccum.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +function x=mapaccum(fn,s0,y) +% mapaccum - map function over data sequences with accumulating state +% +% mapaccum :: (Y,S->X,S), S, seq X -> seq Y. +% +% This is just another name for sfndata. + +if ~isa(y,'data') + error('stupid dumb arse matlab method dispatch is wrong'); +end + +x=sfndata(fn,s0,y);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/max.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,9 @@ +function o=max(A,B,DIM), +% max - max mapped over data sequence (ie NOT aggregate) + +if nargin==2 && ~isempty(B), o=binfun(A,B,@max,'max'); +else + if nargin<3, o=fndata(@max,A); + else o=fndata(bindat(@max,2:3,[],DIM),A); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/mean.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function o=mean(A,DIM), + +if nargin<2, o=fndata(@mean,A); +else o=fndata(bindat(@mean,2,DIM),A); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/merge.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,9 @@ +function y=merge(f,varargin) +% mergedata - Combine several data sources using a given function +% +% mergedata :: +% ( (A1,...,An)->natural ~ chooser function, +% data A1,...,data An ~ n data sources, +% ) -> seq B + +y=mergedata(f,varargin);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/min.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,9 @@ +function o=min(A,B,DIM), +% min - min mapped over data sequence (ie NOT aggregate) + +if nargin==2 && ~isempty(B), o=binfun(A,B,@min,'min'); +else + if nargin<3, o=fndata(@min,A); + else o=fndata(bindat(@min,2:3,[],DIM),A); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/minmax.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,9 @@ +function R=minmax(X,dim) +% minmax - minmax for sequences operates over ENTIRE sequence +% +% minmax :: [D:[[1,E]]], I:[E] -> [set(D,I,2)]. +% +% If you want minmax on a per-buffer basis, use fndata: +% R=fndata(@(x)minmax(x,dim),X) + +R=folddata(@(r,t)minmax(cat(dim,r,t),dim),[],X);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/minus.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function o=minus(A,B) +% minus - +% usage: C=minus(A,B)=A-B +o=binop(A,B,@minus,'-');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/mldivide.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function o=mldivide(A,B) +% mldivide - Matrix left divide for data objects +% + +o=binop(A,B,@mldivide,'\');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/mod.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function o=mod(A,B) +% mod - mod for sequences +% + +o=binop(A,B,@mod,'mod');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/mrdivide.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function o=mrdivide(A,B) +% mrdivide - Matrix right divide for data objects + +o=binop(A,B,@mrdivide,'/');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/mtimes.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +function o=mtimes(A,B) +% MTIMES - Matrix multiplication for data objects +% +% usage: C=mtimes(A,B)=A*B +% +% Three cases +% A is data, B is an array +% A is array, B is data +% A and B are both data - can't handle this yet + +o=binop(A,B,@mtimes,'*');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/next.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function b=next(a) +% NEXT - Return next buffer in sequence. +% +b=a.nextfn(a);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/numel.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +function n=numel(a, varargin) +% numel - number of elements in each array of a sequence +if nargin>1, + error('PANIC! data.numel called with multiple arguments.'); +end + +n=prod(a.size);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/paren.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +function y=paren(a,S) +% paren - Map application of subsref with parentheses to sequence +% +% paren :: seq A, subs -> seq B :- (subsref :: A, subs -> B). + +% NOTE TO SELF: it would be good to work out the size of the +% array that will result when the function is evaluated, to +% save fndata evaluating it once on construction. +y=fndata(@(z)subsref(z,S),a,... + 'charfn',@(o)charfn(tostring(S.subs{:}),o)); + +function s=charfn(argstr,o) + s=sprintf('%s >> (%s)',tostring(source(o)),argstr); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/phasespec.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function y=phasespec(x), y=fndata(@phasespec,x,'size',[1+size(x,1)/2 size(x,2)]);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/plot.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function varargout=plot(varargin) + +varargin=cellmap(@instantiate,varargin); +[varargout{1:nargout}]=plot(varargin{:}); + +function a=instantiate(a), if isa(a,'data'), a=head(a); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/plus.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function o=plus(A,B) +% plus - Addition for data objects +o=binop(A,B,@plus,'+');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/power.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function o=power(A,B), o=binop(A,B,@power,'.^');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/powspec.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function y=powspec(x), y=fndata(@powspec,x,'size',[1+size(x,1)/2 size(x,2)]);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/rdivide.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +function o=rdivide(A,B) +% TIMES - Matrix multiplication for data objects +% +% usage: C=times(A,B)=A.*B +% +% Three cases +% A is data, B is an array +% A is array, B is data +% A and B are both data - can't handle this yet + +o=binop(A,B,@rdivide,'./');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/reshape.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +function o=reshape(source,varargin) +% reshape - Map reshape over elements of sequence +% +% reshape :: seq [Size->A], ... - > seq [Size1->A]. +% Works exactly like the usual reshape function but when applied +% to a sequence object, returns a new sequence. + +sz=tosize(varargin{:}); +o=fndata(@(x)reshape(x,varargin{:}),source,'charfn',@(o)charfn(sz,o), 'size',sz); + +function s=charfn(sz,o) + s=sprintf('%s >> reshape[%s]',tostring(source(o)),tostring(sz));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/scanl.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,17 @@ +function x=scanl(fn,e,y,varargin) +% scanl - scanl combinator for data sequences +% +% This function applies an associative operator to a list of arguments, +% starting from the left using the given starting element. +% +% foldl :: +% (X,Y->X) ~'associative binary operator', +% X ~'initial element', +% seq Y ~'a lazy data sequence' +% -> seq X. + +if ~isdata(y) + error('stupid dumb arse matlab method dispatch is wrong'); +end + +x=scandata(fn,e,y,varargin{:});
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/setsize.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function o=setsize(o,sz) +% SETSIZE - Changes size of data object + +o.size=sz;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/sin.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function y=sin(x), y=fndata(@sin,x,'size',size(x));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/size.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function [s1,s2]=size(a,n) + +s=a.size; +if nargin>1, s1=s(n); +elseif nargout>1, s1=s(1); s2=s(1); +else s1=s; end;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/soundsc.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,8 @@ +function t=soundsc(D,varargin) +% SOUNDSC - Play sound from sequence of arrays +% +% soundsc :: data [[N,T]], maybe real~'sampling rate' +% -> natural~'total samples played'. + +foreach(@(z)soundsc(z,varargin{:}),D); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/specfilt.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,8 @@ +function Y=specfilt(X,S,varargin) + opts=varargin; + Y=zipdata(@specfiltf,X,S); + + function Y=specfiltf(opts,x,s), + Y=unbuffer(ipowspec(s,phasespec(x)),opts{:}); end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/sqrt.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function y=sqrt(x) + +y=fndata(@sqrt,x,'size',size(x));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/subsref.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,16 @@ +function y=subsref(a,S) +% SUBSREF - Subscripted referencing + +switch S(1).type +case '()', y=paren(a,S(1)); +case '.', fn=S(1).subs; y=fndata(@(z)getfield(z,fn),a); +% switch S(1).subs +% case 'size', y=a.size; +% case 'data', y=feval(a.datafn,a); +% case 'next', y=feval(a.nextfn,a); +% end +end + +if length(S)>1, y=subsref(y,S(2:end)); end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/sum.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function o=sum(A,DIM), + +if nargin<2, o=fndata(@sum,A); +else o=fndata(@(x)sum(x,DIM),A); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/tanh.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function y=tanh(x) + +y=fndata(@tanh,x,'size',size(x));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/times.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +function o=times(A,B) +% TIMES - Matrix multiplication for data objects +% +% usage: C=times(A,B)=A.*B +% +% Three cases +% A is data, B is an array +% A is array, B is data +% A and B are both data - can't handle this yet + +o=binop(A,B,@times,'.*');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/tostring.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=tostring(d) +s=d.charfn(d);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/uminus.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function o=uminus(A) +% Unary minus + +o=fndata(@uminus, A,'size',size(A));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/unbuffer.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,68 @@ +function Y=unbuffer(X,hop) +% UNBUFFER - Opposite of buffer using overlap and add (for sequences) +% +% Usage: x=unbuffer(X,hop) +% X: sequences of [[N]] frames of signal data +% hop: Determines how much overlap there is between neighbouring frames + + + if isa(hop,'data') + Y=zipaccum(@olap2,[],{hop,X}); + else + if isscalar(hop) + N=max(size(X)); + ol=N-hop; + if ol<=hop + I=1:hop; J=1:ol; K=hop+1:N; + Y=sfndata(@olap1,zeros(ol,1),X); + else + I=1:hop; J=hop+1:ol; K=ol+1:N; + Y=sfndata(@olap3,zeros(ol,1),X); + end + else + Y=zipaccum(@olap2,[],{windowdata(repeat(hop)),X}); + end + end + + function [y,s1]=olap1(x,s) + y=x(I)'; + y(J)=y(J)+s'; + s1=x(K); + end + + function [y,s1]=olap3(x,s) + y=(s(I)+x(I))'; + s1=[s(J)+x(J);x(K)]; + end + + function [y,s1]=olap2(hop,x,s) + ls=length(s); + lx=length(x); + if lx>=hop + if ls>=hop + % NB: this will fail if ls>lx, but this shouldn't happen since ls<=lx-hop + y=(x(1:hop)+s(1:hop))'; + s1=[s(hop+1:ls)+x(hop+1:ls);x(ls+1:end)]; + else + y=[x(1:ls)+s;x(ls+1:hop)]'; + s1=x(hop+1:end); + end + else + if ls>=hop + y=[s(1:lx)+x;s(lx+1:hop)]'; + s1=s(hop+1:end); + else + y=zeros(1,hop); + y(1:ls)=y(1:ls)+s'; + y(1:lx)=y(1:lx)+x'; + end + end + + % y=x(1:hop)'; + % ch=min(hop,ls); + % J=(1:ch)'; + % y(J)=y(J)+s(J)'; + % s1=x(hop+1:end)+[s(ch+1:end);zeros(lx-max(hop,ls),1)]; + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/unzip.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +function xx=unzip(y) +% unzip - Separate sequence of tuples into several sequences +% +% unzip :: +% seq {I:[D]->A(I)}. +% -> {I:[D]->seq A(I)}. +% +% Note: input MUST be a sequence of constant size cell arrays. +% Output is a cell array of sequences of the same size and shape. + +xx=cell(size(y)); +for i=1:numel(xx) + xx{i}=fndata(@(a)a{i},y); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/vecop.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +function Z=vecop(F,X,Y) +% vecop - apply binary function to different sized array sequences +% +% vecop :: +% ([[D]],[[D]]->[[D]]) ~'some function requiring equal size args', +% seq [[DX]] ~'first arg of size DX', +% seq [[DY]] ~'second arg of size DY' +% -> seq [[DZ]] ~'result of size DZ' :- DZ=max(DX,DY). +% +% The input sequences must maintain the same size throughout. + +DX=size(X); DY=size(Y); +E=max(length(DX),length(DY)); +EDX=pad1s(E,DX); +EDY=pad1s(E,DY); +if all(EDX>=EDY) + S=EDX./EDY; + Z=binop(X,Y,@(x,y)F(x,repmat(y,S)),['<' tostring(F) '>']); +elseif all(EDY>=EDX) + S=EDY./EDX; + Z=binop(X,Y,@(x,y)F(repmat(x,S),y),['<' tostring(F) '>']); +else + DZ=max(EDX,EDY); + Z=binop(X,Y,@(x,y)F(repmat(x,DZ./EDX),repmat(y,DZ./EDY)),['<' tostring(F) '>']); +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/vertcat.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +function o=vertcat(varargin) +% vertcat - horizontal array concatenation for data sequences +% +% vertcat :: +% seq [[N1,M]], +% seq [[N2,M]] +% -> seq [[N1+N2,M]]. + + +if length(varargin)==2 + o=binfun(varargin{1},varargin{2},@vertcat,'[,]'); +else + o=zipdata(@vertcat,length(varargin),varargin{:}); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/wienerfilt.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function Y=wienerfilt(T,S,X,varargin) + +Y=zipdata(bind(@worker,varargin),3,T,S,X); + +function Y=worker(opts,T,S,X) + Y=unbuffer(wiener(X,T,S),opts{:});
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/zip.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,17 @@ +function x=zip(varargin) +% zip - combine several sequences into one +% +% zip :: +% seq A, seq B, ... +% -> seq {A,B,...}. + +%sz=size(args); +%if sz(1)==1 && length(sz)<=2 + x=zipdata(@tuple,varargin); +%else +% x=zipdata(@rtuple,args) +%end + +function z=rtuple(varargin), z=reshape(varargin,sz); end + +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@data/zipwith.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,9 @@ +function x=zipwith(fn,varargin) +% zipwith - map function over data sequences +% +% zipwith :: +% (A,B,...->X), +% seq A, seq B, ... +% -> seq X. + +x=zipdata(fn,varargin);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@ddata/ddata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +function o=ddata(source,b,varargin) +% DDATA - Base class for all derived data sources + +if nargin==1 && isa(source,'ddata'), o=source; +else + ft=prefs('stringfn','*','nextfn',@nfn,'charfn',@cfn,varargin{:}); + o.source=source; + o.stringfn=ft.stringfn; + o=class(o,'ddata',data(b,ft)); +end + +function o=nfn(o), o=next_nc(o); +function s=cfn(o), s=sprintf('%s >> %s',tostring(o.source),feval(o.stringfn,o)); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@ddata/headsource.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function x=headsource(o), x=head(o.source); +% headsource - Convenience function to get head of current source
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@ddata/next_c.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +function o=next_c(o) +% NEXT_C - Next with size adjustment + +o.source=next(o.source); +if isempty(o.source), o=[]; +else + oldsize=size(o); + newsize=size(o.source); + if any(newsize~=oldsize) +% fprintf('-- ddata: size changed to %s\n',mat2str(newsize)); + o=setsize(o,newsize); + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@ddata/next_nc.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function o=next_nc(o) +% NEXT_NC - Next with no check on size of next source. + +o.source=next(o.source); +if isempty(o.source), o=[]; end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@ddata/nextsource.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function o=nextsource(o) +% NEXTSOURCE - Returned derived data using next source object + +o.source=next(o.source); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@ddata/setsource.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function o=setsource(o,s), o.source=s; +% setsource - set source of derived data sequence.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@ddata/source.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function s=source(o) +s=o.source;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@extractdata/extractdata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,17 @@ +function o=extractdata(source,dim,range) +% extractdata - Sequence of extracts from source sequence +% +% extractdata :: seq [[Size]], D:natural, [[2]->[Size(D)]] -> seq [[Size2]]. +% +% extractdata is basically the same as fndata extract but more efficient. + + sz=size(source); + sz(dim)=range(2)-range(1)+1; + o.dim=dim; + o.range=range; + o=class(o,'extractdata',ddata(source,sz,'datafn',@dfn,'stringfn',@sfn,'nextfn',@next_c)); + + +function x=dfn(o), x=extract(source(o),o.dim,o.range); +function s=sfn(o) + s=sprintf('[%d/%d:%d]', o.dim, o.range(1), o.range(2));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@filterdata/extract.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function y=extract(o,dim,range) +% EXTRACT - Extract a sub-array +% +% extract :: seq [[D]], natural, [[2]->natural]] -> [[D2]]. + +y=extract(source(o),dim,range);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@filterdata/filterdata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,44 @@ +function d=fndata(a,b,varargin) +% filterdata - Use arbitrary function to test and filter elements of another sequence +% +% filterdata :: +% ((A->bool) ~ test function, +% data(A), ~ source data, +% ... ~ options) +% -> data(A). +% +% Options +% 'datafn':: Data A->A ~ override function to get data +% 'stringfn':: Data A->String ~ override conversion to string +% 'nextfn':: Data A->(Data A | []) ~ override next function +% +% Methods +% +% testfn :: filterdata(A) -> (A->bool). +% source :: filterdata(A) -> data(A). + +if nargin==0, a=filterdata(@(t)true,singleton(0)); end +if isa(a,'filterdata'), d=a; +else + d.fn=a; % function to apply + + + + opts=prefs('datafn',@datafn,'stringfn',@stringfn,'sizecheck',0,varargin{:}); + opts.nextfn=@nextfn; + d=class(d,'filterdata',ddata(b,size(b),opts)); + + if ~d.fn(head(d)), d=next(d); end +end + + +function x=datafn(d), x=head(source(d)); +function s=stringfn(d), s=sprintf('%s?',tostring(d.fn)); +function o=nextfn(o) + while 1 + o=next_c(o); + if isempty(o) || o.fn(head(source(o))), break; end + end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@filterdata/testfn.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function f=testfn(o) +% testfn - Get filter function from filterdata +f=o.fn;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@fndata/fn.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,3 @@ +function f=fn(o) +% FN - Get function from fndata +f=o.fn;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@fndata/fndata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,51 @@ +function d=fndata(a,b,varargin) +% FNDATA - Data source where data is a stateless function of another data source +% +% fndata :: +% ((A->B) ~ function to apply to each buffer, +% Data A, ~ source data, +% ... ~ options) +% -> Data B +% +% Options +% 'size':: [[1,D]] ~ size of array returned by function +% If not specified, FNDATA applies the function once to work +% out what size data is going to be returning. +% 'datafn':: Data A->A ~ override function to get data +% 'stringfn':: Data A->String ~ override conversion to string +% 'nextfn':: Data A->(Data A | []) ~ override next function +% +% Methods +% +% fn :: fndata(A,B) -> (A->B). +% source :: fnddata(A,B) -> data(A). + +if nargin==0, a=fndata(@(t)t,singleton(0)); end +if isa(a,'fndata'), d=a; +else + opts=prefs('datafn',@datafn,'stringfn',@stringfn, ... + 'sizecheck',0,'compose',0,varargin{:}); + + if opts.compose && isa(b,'fndata') + % if b is a fndata, we could do an optimisation where we + d=fndata(compose(a,fn(b)),source(b),varargin{:}); + % !! source will be wrong!! + else + d.fn=a; % function to apply + + if opts.sizecheck, opts.nextfn=@next_sizecheck; + else opts.nextfn=@next_nc; end + if ~isfield(opts,'size'), opts.size=size(d.fn(head(b))); end + d=class(d,'fndata',ddata(b,opts.size,opts)); + end +end + + +function x=datafn(d), x=d.fn(head(source(d))); +function s=stringfn(d), s=tostring(d.fn); +function d=next_sizecheck(d) + d=next_nc(d); + if ~isempty(d), + d=setsize(d,size(d.fn(head(source(d))))); + end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@iterdata/iterdata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,28 @@ +function x=iterdata(f,s0,varargin) +% iterdata - Construct sequence by recursive application of arbitrary function +% +% iterdata :: (A->A), A, options {} -> seq A. + + if nargin==1 && isa(s0,'iterdata'), x=s0; + elseif nargin==0 + x=iterdata(0,@id); + else + x.s=s0; + opts.datafn=@(t)t.s; + opts.nextfn=@(t)nfn(f,t); + opts.charfn=@(t)cfn(f,t); + x=class(x,'iterdata',data(size(s0),prefs(opts,varargin{:}))); + end +end + + +function x=nfn(f,x) + s1=f(x.s); + if isempty(s1), x=[]; else x.s=s1; end +end + +function c=cfn(f,t) + c=['iter(' tostring(f) ')']; +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@mergedata/mergedata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,48 @@ +function d=mergedata(c,sources,varargin) +% mergedata - Combine several data sources using a given function +% +% mergedata :: +% ( (A1,...,An)->natural ~ chooser function, +% n:natural ~ number of sources to combine, +% data A1,...,data An ~ n data sources, +% ... ~ options +% ) -> seq B +% +% Options: +% 'size'::[[1 E]] ~ size of result if known + +if nargin==0, d=mergedata(@(x)1,1,[0]); +elseif isa(c,'mergedata'), d=c; +else + d.fn=c; + d.head=[]; + d.sources=sources; + + opts=prefs('datafn',@datafn,'nextfn',@nextfn,'charfn',@charfn,varargin{:}); + if ~isfield(opts,'size'), opts.size=size(datafn(d)); end + d=nextfn(class(d,'mergedata',data(opts.size,opts))); +end + + +function x=datafn(d) + x=d.head; + +function d=nextfn(d) + data=cellmap(@head,d.sources); + if isempty(data), d=[]; + else + k=d.fn(data); + d.head=data{k}; + nk=next(d.sources{k}); + if isempty(nk), d.sources(k)=[]; + else d.sources{k}=nk; end + end + + + +function s=charfn(d) + s=char(d.sources{1}); + for i=2:length(d.sources) + s=[s ', ' char(d.sources{i})]; + end + s=sprintf('{ %s } >> merge(%s)',s,tostring(d.fn));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@mergedata/sources.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function s=sources(o,i) +% SOURCES - Cell array of sources for zipdata + +if nargin==1, s=o.sources; +else s=o.sources{i}; end;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@mp3data/channels.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function c=channels(o) +c=o.channels;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@mp3data/extract.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function y=extract(a,dim,range) +% EXTRACT - Extract a sub-array from wavefile + +if dim~=2, error('Can only subrange times, not channels'); end +% fprintf('-- partial read %s %s\n',mat2str(range),a.file); +y=mp3read(a.file,range,a.args{:})';
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@mp3data/file.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function fn=file(o) +fn=o.file;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@mp3data/length.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function l=length(o) +% LENGTH - Length of wave file in samples + +l=o.length;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@mp3data/mp3data.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,55 @@ +function a=mp3data(fn,varargin) +% MP3DATA - abstract data object for reading an MPEG-1 layer III audio file +% +% mp3data :: +% text ~'file name', +% options { +% 'rate':real ~'attempt to return signal at this sampling rate', +% 'mono':{0,1}/0 ~'if 1, then return a single channel signal' +% } +% -> data [Ch,l:-1--1]. ~'Data object for n by l arrays of bounded reals + + +if isa(fn,'mp3data'), D=fn; +else + fprintf('reading MP3 header...'); + [sz,fs] = mp3read(fn,'size'); + opts=prefs('rate',fs,'mono',0,varargin{:}); + + % first extra argument is whether or not we want mono + mp3args={opts.mono}; + + % downsample as nearest power of 2, maximum of 4 + ds=min(pow2(round(log2(fs/opts.rate))),4); + if ds>1, + mp3args=[mp3args {ds}]; + [sz,fs] = mp3read(fn,'size',mp3args{:}); + end + + a.file = fn; + a.rate = fs; + a.length = floor(sz(1)); + a.channels = sz(2); + a.args = mp3args; + + % sort out function table (default nextfn=id) + ft.datafn=@datafn; + ft.charfn=@charfn; + ft.nextfn=@nextfn; + + a=class(a,'mp3data',data([a.channels a.length],ft)); + fprintf('done.\n'); +end + + +function o=nextfn(o), o=[]; + +function X=datafn(a), + fprintf('-- reading %s\n',a.file); + X=mp3read(a.file,0,a.args{:})'; + +function s=charfn(a) + k=strfind(a.file,filesep); + if isempty(k), fn=a.file; else fn=a.file(k(end)+1:end); end + s=sprintf('%s(%d Hz)', fn,a.rate); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@mp3data/play.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,39 @@ +function play(w,prog) +% PLAY - Play wavedata object using external player +% +% play :: wavedata, maybe text~'optional player command' -> unit. +% +% This plays the audio in a wave file without loading it all into +% MATLAB's workspace, by using a system dependent external player, +% which can be overridden (second parameter). + +if nargin<2, % got to find a player application + switch computer, + case 'LNX86', + if system('which mpg123')==0, prog='mpg123'; + elseif system('which mpg321')==0, prog='mpg321'; + else error('No player application found'); + end + + case 'PCWIN', + prog='mplayer2'; + + case 'MAC', + if system('which mpg123')==0, prog='mpg123'; + elseif system('which mpg321')==0, prog='mpg321'; + elseif system('which qtplay')==0, prog='qtplay'; + else prog='open'; % NOTE: open returns immediately + end + end +end +% have to check if file begins with ~ +if w.file(1)=='~' + slash=strfind(w.file,filesep); + arg=[w.file(1:slash(1)) '"' w.file(slash(1)+1:end) '"']; +else + arg=['"' w.file '"']; +end +system( [prog ' ' arg]); + +system([prog ' "' w.file '"']); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@mp3data/rate.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function r=rate(o) +r=o.rate;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@mp3data/subsref.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,42 @@ +function y=subsref(a,S) +% subsref - subsref for mp3data class + +subs=S(1).subs; +switch S(1).type +case '()', y=lparen(a,S(1)); +%case '.' +% switch subs +% case 'data', y=head(a); +% case 'next', y=next(a); +% otherwise, +% if ispublic(subs), y=a.(subs); +% else y=subsref(a.data,S); end +% end +end +if length(S)>1, y=subsref(y,S(2:end)); end + + +%function f=ispublic(f) +% f=ismember(f,{'file', 'rate','channels','length'}); + + + +function y=lparen(a,S) + + subs=S.subs; + if length(subs)==1, + if subs{1}(1)==':' || a.channels>1, y=paren(a,S); + else + range=[min(subs{1}) max(subs{1})]; + y=extractdata(a,2,range); + y=y(1+subs{1}-range(1)); + end + else + if subs{2}(1)==':', y=paren(a,S); + else + range=[min(subs{2}) max(subs{2})]; + y=extractdata(a,2,range); + y=y(subs{1},1+subs{2}-range(1)); + end + end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@oggdata/channels.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function c=channels(o) +c=o.channels;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@oggdata/extract.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function y=extract(a,dim,range) +% EXTRACT - Extract a sub-array from wavefile + +if dim~=2, error('Can only subrange times, not channels'); end +% fprintf('-- partial read %s %s\n',mat2str(range),a.file); +y=oggread(a.file,range,a.args{:})';
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@oggdata/file.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function fn=file(o) +fn=o.file;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@oggdata/length.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function l=length(o) +% LENGTH - Length of wave file in samples + +l=o.length;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@oggdata/oggdata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,24 @@ +function a=oggdata(fn) +% OGGDATA - abstract data object for reading an MPEG-1 layer III audio file +% +% oggdata :: +% text ~'file name', +% options { +% 'rate':real ~'attempt to return signal at this sampling rate', +% 'mono':{0,1}/0 ~'if 1, then return a single channel signal' +% } +% -> data [Ch,l:-1--1]. ~'Data object for n by l arrays of bounded reals + + +if isa(fn,'oggdata'), D=fn; +else + fs=ogginfo(fn); + Y=oggread(fn)'; + + a.file = fn; + a.rate = fs; + a.length = size(Y,2); + a.channels = size(Y,1); + + a=class(a,'oggdata',cons(Y,[])); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@oggdata/play.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,39 @@ +function play(w,prog) +% PLAY - Play wavedata object using external player +% +% play :: wavedata, maybe text~'optional player command' -> unit. +% +% This plays the audio in a wave file without loading it all into +% MATLAB's workspace, by using a system dependent external player, +% which can be overridden (second parameter). + +if nargin<2, % got to find a player application + switch computer, + case 'LNX86', + if system('which ogg123')==0, prog='ogg123'; + if system('which mplayer')==0, prog='mplayer'; + if system('which xmms')==0, prog='xmms'; + else error('No player application found'); + end + + case 'PCWIN', + prog='mplayer2'; + + case 'MAC', + if system('which ogg123')==0, prog='ogg123'; + elseif system('which qtplay')==0, prog='qtplay'; + else prog='open'; % NOTE: open returns immediately + end + end +end +% have to check if file begins with ~ +if w.file(1)=='~' + slash=strfind(w.file,filesep); + arg=[w.file(1:slash(1)) '"' w.file(slash(1)+1:end) '"']; +else + arg=['"' w.file '"']; +end +system( [prog ' ' arg]); + +system([prog ' "' w.file '"']); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@oggdata/rate.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function r=rate(o) +r=o.rate;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@oggdata/subsref.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,34 @@ +function y=subsref(a,S) +% subsref - subsref for oggdata class + +subs=S(1).subs; +switch S(1).type +case '()', y=lparen(a,S(1)); +end +if length(S)>1, y=subsref(y,S(2:end)); end + + +%function f=ispublic(f) +% f=ismember(f,{'file', 'rate','channels','length'}); + + + +function y=lparen(a,S) + + subs=S.subs; + if length(subs)==1, + if subs{1}(1)==':' || a.channels>1, y=paren(a,S); + else + range=[min(subs{1}) max(subs{1})]; + y=extractdata(a,2,range); + y=y(1+subs{1}-range(1)); + end + else + if subs{2}(1)==':', y=paren(a,S); + else + range=[min(subs{2}) max(subs{2})]; + y=extractdata(a,2,range); + y=y(subs{1},1+subs{2}-range(1)); + end + end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@rnddata/model.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function X=model(a), X=a.model; +% model - extract random variable model from rnddata +% +% model :: rnddata(M,SZ) -> M.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@rnddata/rnddata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,64 @@ +function d=rnddata(model,sdom,k) +% RNDDATA - Sequence of values sampled from a random variable model +% +% rnddata :: +% model xdom:[[1,XD]] ~ random variable model, data size is xdom, +% sdom:[[1,SD]], ~ size of sample, +% -> rnddata [[xdom sdom]] ~ size of rnddata is product of xdom and sdom +% +% rnddata :: +% model xdom:[[1,XD]] ~ random variable model, data size is xdom, +% sdom:[[1,SD]], ~ size of sample, +% rndstate ~ initial state of generators +% -> rnddata [[xdom sdom]] ~ size of rnddata is product of xdom and sdom +% +% If an initial rndstate is supplied, rnddata is purely functional +% and referentially transparent. Otherwise, the initial construction +% uses the current state of the random generators. After this, the +% entire sequence is fully determined. +% +% EXAMPLE +% +% rnddata(gaussian,[2,200]) :: seq [[2,200]] +% rnddata(dirichlet(3,0.5),6) :: seq [[3,6]] + +if isa(model,'rnddata'), d=model; +else + if nargin<2, sdom=1; end + if isa(model,'struct') + if model.nparams>0, + error('Model has unbound parameters'); + end + gen=sampler(model.sample,sdom); + % gen=rndwrap(model.sample,'vu',[0,1],sdom); + elseif iscell(model) + gen=sampler(model{1},sdom); + % gen=rndwrap(model{1},'vu',[0,1],sdom); + end + d.model=model; + + if nargin>2, + if ~iscell(k), s={k,k}; else s=k; end + else + s=getrndstate; + end + + d=class(d,'rnddata',unfold(gen,s,'charfn',@(o)char(gen))); +end + +end + + +% this creates a rand-state-managed version of g applied to args, +% ie, +% sampler :: +% ((A1,A2,....) -> random B) ~'an action which generates a value' +% -> (rndstata -> B, rndstate) ~'a deterministic random state transformer'. + +function f=sampler(g,varargin) + f=@ufn; + function [x,s]=ufn(s) + setrndstate(s); x=g(varargin{:}); + s=getrndstate; + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@rnddata/rndstate.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function s=rndstate(X) +% rndstate - Get rndstate for rnddata sequence + +s=X.nextstate;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@scandata/scandata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,41 @@ +function d=scandata(a,b,c,varargin) +% SCANDATA - Data source where data is accumulated while scanning through a source sequence +% +% This works like scanl in a functional language (see eg, Haskell) +% +% scandata:: +% (S,A)->S) ~ function to apply to each buffer, +% S ~ initial state, +% data A, ~ source data, +% options {} ~ options +%-> scandata(S,A) < data S ~ ie result is a sequence of S. +% +% Options +% datafn :: data A->A ~ override function to get data +% stringfn :: data A->String ~ override conversion to string +% nextfn :: data A->(Data A | []) ~ override next function +% +% Methods +% scanfn::scandata(S,A) -> ((S,A)->S) + +if nargin==0, d=scandata(@(a,b)a,[],singleton(0)); +elseif isa(a,'scandata'), d=a; +elseif isempty(c), d=[]; +else + opts=prefs('datafn',@datafn,'stringfn',@stringfn,'nextfn',@nextfn,varargin{:}); + + d.scanfn=a; % function to apply + d.x=d.scanfn(b,head(c)); + d=class(d,'scandata',ddata(c,size(d.x),opts)); +end + + +function x=datafn(d), x=d.x; +function s=stringfn(d), s=[ 'scan(' tostring(d.scanfn) ')']; +function d=nextfn(d), + d=next_nc(d); + if ~isempty(d) + d.x=d.scanfn(d.x,head(source(d))); + d=setsize(d,size(d.x)); + end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@scandata/scanfn.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function f=scanfn(o) +% scanfn - Get scanning function +% +% sfndata(A,B) -> ((A,B)->B) +f=o.scanfn;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@sfndata/sfn.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function f=fn(o) +% SFN - Get state-transformer function from sfndata data +% +% sfndata S A B -> ((A,S)->(B,S)) +f=o.sfn;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@sfndata/sfndata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,43 @@ +function d=sfndata(a,b,c,varargin) +% SFNDATA - Data source where data is a stateful function of another data source +% +% sfndata:: +% (((A,S)->(B,S)) ~ function to apply to each buffer, +% S ~ initial state, +% data A, ~ source data, +% ... ~ options) +% -> sfndata S A B < data B +% +% Options +% 'datafn':: Data A->A ~ override function to get data +% 'stringfn':: Data A->String ~ override conversion to string +% 'nextfn':: Data A->(Data A | []) ~ override next function +% +% Methods +% sfn :: sfndata(S,A,B) -> ((A,S)->(B,S)). +% state :: sfndata(S,A,B) -> S. +% +% state returns the state after the current value but but before the next + +if nargin==0, d=sfndata(@deal,[],singleton(0)); +elseif isa(a,'sfndata'), d=a; +elseif isempty(c), d=[]; +else + opts=prefs('datafn',@datafn,'stringfn',@stringfn,'nextfn',@nextfn,varargin{:}); + + d.sfn=a; % function to apply + [d.x,d.state]=d.sfn(head(c),b); + d=class(d,'sfndata',ddata(c,size(d.x),opts)); +end + + +function x=datafn(d), x=d.x; +function s=stringfn(d), s=tostring(d.sfn); +function d=nextfn(d), + d=next_nc(d); + if ~isempty(d) + [d.x,d.state]=feval(d.sfn,head(source(d)),d.state); + % !! might like to allow sfn to terminate sequence by returning something special + d=setsize(d,size(d.x)); + end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@sfndata/state.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function f=state(o) +% state - Get state of sfndata object +% +% state :: sfndata(S,A,B) -> S. +f=o.state;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@subsampdata/extract.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function y=extract(o,dim,range) +% EXTRACT - Extract a sub-array +% +% extract :: seq [[D]], natural, [[2]->natural]] -> [[D2]]. + +y=extract(source(o),dim,range);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@subsampdata/subsampdata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,38 @@ +function d=subsampdata(a,b,varargin) +% subsampdata - Use arbitrary function to test and filter elements of another sequence +% +% subsampdata :: +% natural ~ sample rate, +% data(A), ~ source data, +% ... ~ options) +% -> data(A). +% +% Options +% 'datafn':: Data A->A ~ override function to get data +% 'stringfn':: Data A->String ~ override conversion to string +% 'nextfn':: Data A->(Data A | []) ~ override next function +% +% Methods +% +% source :: filterdata(A) -> data(A). + +if nargin==0, a=subsampdata(1,singleton(0)); end +if isa(a,'subsampdata'), d=a; +else + d.n=a; + + opts=prefs('datafn',@datafn,'stringfn',@stringfn,'sizecheck',0,varargin{:}); + opts.nextfn=@nextfn; + d=class(d,'subsampdata',ddata(b,size(b),opts)); +end + +function x=datafn(d), x=head(source(d)); +function s=stringfn(d), s=sprintf('subsamp(%d)',tostring(d.n)); +function o=nextfn(o) + for i=1:o.n + o=next_c(o); + if isempty(o), break; end + end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@take/extract.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function y=extract(o,dim,range) +% EXTRACT - Extract a sub-array +% +% extract :: seq [[D]], natural, [[2]->natural]] -> [[D2]]. + +y=extract(source(o),dim,range);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@take/take.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,29 @@ +function o=take(n,source) +% TAKE - Take first n alements of sequence then stop +% +% take :: natural, seq A -> seq A + +if nargin==0, o=take(1,0); +elseif n==0, o=[]; +elseif isa(source,'take'), + o=source; + o.n=min(o.n,n); +else + ft.datafn=@datafn; + ft.stringfn=@stringfn; + ft.nextfn=@nextfn; + o.n=n; + o=class(o,'take',ddata(source,size(source),ft)); +end + +function x=datafn(o), x=head(source(o)); +function s=stringfn(o), s=sprintf('take(%d)',o.n); +function o=nextfn(o) + if o.n==1, o=[]; + else + o=next_c(o); + if ~isempty(o), o.n=o.n-1; end + end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@takewhile/extract.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function y=extract(o,dim,range) +% EXTRACT - Extract a sub-array +% +% extract :: seq [[D]], natural, [[2]->natural]] -> [[D2]]. + +y=extract(source(o),dim,range);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@takewhile/takewhile.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,29 @@ +function o=takewhile(f,source) +% takewhile - Take elements of seq while a condition is met. +% +% takewhile :: (A->bool), seq A -> seq A + +if nargin==0, o=takewhile(@(e)true,0); +elseif isa(source,'takewhile'), o=source; +elseif isempty(source), o=[]; +elseif ~f(head(source)), o=[]; +else + ft.datafn=@datafn; + ft.stringfn=@stringfn; + ft.nextfn=@nextfn; + o.f=f; + o.x=head(source); + o=class(o,'takewhile',ddata(source,size(source),ft)); +end + +function x=datafn(o), x=o.x; +function s=stringfn(o), s=sprintf('takewhile(%s)',tostring(o.f)); +function o=nextfn(o) + o=next_c(o); + if ~isempty(o), + o.x=headsource(o); + if ~o.f(o.x), o=[]; end + end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@uidata/eventadder.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,19 @@ +function f=eventadder(o) + + global UIDATA UITIMER + + idx=o.index; + f=@addevent; + + function addevent(type,varargin) + ev.time=now; + ev.type=type; + ev.args=varargin; + UIDATA{idx} = [ UIDATA{idx} {ev} ]; + + % hiccough the timer to notify waiters +% stop(UITIMER); +% start(UITIMER); + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@uidata/ready.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function b=ready(o) + +global UIDATA + +b = length(UIDATA{o.index})>=o.evnum;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@uidata/uidata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,30 @@ +function o=uidata(a) + +global UIDATA UITIMER + +if nargin>0 && isa(a,'uidata'), X=a; +else + UIDATA=[UIDATA {{}}]; + if isempty(UITIMER) + % this is good for 23 days... + UITIMER=timer('startdelay',2e6,'TimerFcn',@nop); +% start(UITIMER); + end + + d.index=length(UIDATA); + d.evnum=1; + + ft.stringfn=@stringfn; + ft.datafn=@datafn; + ft.nextfn=@nextfn; + o=class(d,'uidata',data([1,1],ft)); +end + +function x=datafn(o), + global UIDATA + x=UIDATA{o.index}{o.evnum}; + +function s=stringfn(o), s='uidata'; +function o=nextfn(o), + o.evnum=o.evnum+1; +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@uidata/wait.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function wait(o) + + global UIDATA UITIMER + + wait(UITIMER);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@unfold/fn.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function f=fn(o) +% FN - Get unfolding function +% +% fn :: unfolddata(S,A) -> (S->A,S) +f=o.fn;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@unfold/state.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function f=state(o) +% state - Get state of unfolddata object +% +% state :: unfolddata(S,A) -> S. +f=o.state;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@unfold/unfold.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,48 @@ +function d=unfold(a,b,varargin) +% unfold - Data source where data is a stateful function of another data source +% +% unfold:: +% ((S->(A,S)) ~ function to apply to each buffer, +% S ~ initial state, +% ... ~ options) +% -> unfold(S,A) < seq A +% +% Options +% 'datafn':: seq A->A ~ override function to get data +% 'stringfn':: seq A->string ~ override conversion to string +% 'nextfn':: seq A->(seq A | []) ~ override next function + +if nargin==0, d=unfold(@(s)deal(0,s),0); +elseif isa(a,'unfold'), d=a; +else + opts=prefs('datafn',@datafn,'charfn',@stringfn,'inf_constsize',0,varargin{:}); + if opts.inf_constsize && ~isfield(opts,'nextfn') + opts.nextfn=@nextfn_infnc; + else + opts.nextfn=@nextfn; + end + + [x,s]=a(b); + if ~isempty(x), + d.value=x; + d.state=s; + d.fn=a; % function to apply + d=class(d,'unfold',data(size(x),opts)); + end +end + + +function x=datafn(d), x=d.value; +function s=stringfn(d), s=sprintf('unfold(%s)',tostring(d.fn)); +function d=nextfn(d), + [x,s]=d.fn(d.state); + if isempty(x), d=[]; + else + d=setsize(d,size(x)); + d.value=x; d.state=s; + end + +% optimised version for infinite sequences with no size check +function d=nextfn_infnc(d), + [d.value,d.state]=d.fn(d.state); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@wavedata/channels.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function c=channels(o) +c=o.channels;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@wavedata/extract.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function y=extract(a,dim,range) +% EXTRACT - Extract a sub-array from wavefile + +if dim~=2, error('Can only subrange times, not channels'); end +% fprintf('-- partial read %s %s\n',mat2str(range),a.file); +y=mywavread(a.file,range)';
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@wavedata/file.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function fn=file(o) +fn=o.file;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@wavedata/length.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function l=length(o) +% LENGTH - Length of wave file in samples + +l=o.length;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@wavedata/play.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,39 @@ +function play(w,prog) +% PLAY - Play wavedata object using external player +% +% play :: wavedata, maybe text~'optional player command' -> unit. +% +% This plays the audio in a wave file without loading it all into +% MATLAB's workspace, by using a system dependent external player, +% which can be overridden (second parameter). + +if nargin<2, % got to find a player application + switch computer, + case 'LNX86', % Linux: assume alsa sound aplay is present! + if system('which aplay')==0, prog='aplay'; + elseif system('which play')==0, prog='play'; + elseif system('which xmms')==0, prog='xmms'; + else error('No player application found'); + end + + case 'PCWIN', + prog='mplayer2'; + + case 'MAC', + if system('which qtplay')==0, prog='qtplay'; + elseif system('which play')==0, prog='play'; + else prog='open'; % NOTE: open returns immediately + end + end +end +% have to check if file begins with ~ +if w.file(1)=='~' + slash=strfind(w.file,filesep); + arg=[w.file(1:slash(1)) '"' w.file(slash(1)+1:end) '"']; +else + arg=['"' w.file '"']; +end +system( [prog ' ' arg]); + +system([prog ' "' w.file '"']); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@wavedata/rate.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function r=rate(o) +r=o.rate;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@wavedata/subsref.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,34 @@ +function y=subsref(a,S) +% subsref - subsref for wavedata + +subs=S(1).subs; +switch S(1).type +case '()', y=lparen(a,S(1)); +end +if length(S)>1, y=subsref(y,S(2:end)); end + + +%function f=ispublic(f) +% f=ismember(f,{'file', 'rate','channels','length'}); + + + +function y=lparen(a,S) + + subs=S.subs; + if length(subs)==1, + if subs{1}(1)==':' || a.channels>1, y=paren(a,S); + else + range=[min(subs{1}) max(subs{1})]; + y=extractdata(a,2,range); + y=y(1+subs{1}-range(1)); + end + else + if subs{2}(1)==':', y=paren(a,S); + else + range=[min(subs{2}) max(subs{2})]; + y=extractdata(a,2,range); + y=y(subs{1},1+subs{2}-range(1)); + end + end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@wavedata/wavedata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,46 @@ +function a=wavdata(fn) +% WAVDATA - abstract data object for reading a wavefile as seq of arrays +% +% wavdata :: +% string ~'file name', +% -> Data [ch,l:-1--1]. ~'Data object for n by l arrays of bounded reals + + +if nargin==0, + a=struct('file','','rate',0,'length',0,'channels',0); + ft.datafn=@datafn; + ft.charfn=@charfn; + ft.nextfn=@nextfn; + a=class(a,'wavedata',data([a.channels a.length],ft)); +elseif isa(fn,'wavedata'), D=fn; +else + fprintf('reading wave header...'); + sz = mywavread(fn,'size'); + [y,fs] = mywavread(fn,[1 1]); + + a.file = fn; + a.rate = fs; + a.length = floor(sz(1)); + a.channels = sz(2); + + % sort out function table (default nextfn=id) + ft.datafn=@datafn; + ft.charfn=@charfn; + ft.nextfn=@nextfn; + + a=class(a,'wavedata',data([a.channels a.length],ft)); + fprintf('done.\n'); +end + + +function o=nextfn(o), o=[]; + +function X=datafn(a), + fprintf('-- reading %s\n',a.file); + X=mywavread(a.file)'; + +function s=charfn(a) + k=strfind(a.file,filesep); + if isempty(k), fn=a.file; else fn=a.file(k(end)+1:end); end + s=sprintf('%s(%d Hz)', fn,a.rate); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@windowdata/hop.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function h=hop(o) +% HOP - Return hop size for windowed data object +h=o.hop; +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@windowdata/length.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function h=length(o) +% LENGTH - Return length of window for windowed data object +h=o.span; +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@windowdata/options.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function h=options(o) +% options - Get options used to create window datat +h=o.opts; +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@windowdata/position.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function p=position(o) +% POSITION - Current position of window in main signal (1 based) + +p=o.pos+1;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@windowdata/subsref.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,19 @@ +function y=subsref(a,S) +% subsref - subsref for windowdata + +switch S(1).type +case '()', y=paren(a,S(1)); +%case '.' +% field=S(1).subs; +% switch field +% case 'hop', y=a.m; +% case 'frame', y=a.n; +% case 'source', y=a.source; +% case 'data', y=double(a); +% case 'next', y=next(a); +% otherwise, y=subsref(a.data,S); end +end + +if length(S)>1, y=subsref(y,S(2:end)); end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@windowdata/windowdata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,135 @@ +function a=windowdata(src,span,hop,varargin) +% windowdata - abstract data object for extracting window from another data +% +% windowdata :: +% X:data[C,_] ~'source signal', +% N:natural ~'window size', +% natural ~'hop size', +% options { +% dim :: natural/ndims(X) ~'dimension to window along (default is last)'; +% wrap:: bool /1 ~ if 1, then source is treated as a contiguous stream in +% the dimth dimension; otherwise, each buffer is windowed +% independently.' +% } +% -> data [C,N]. ~'data object for n by l'. + + + if nargin==1 && isa(src,'windowdata'), a=src; + elseif nargin==0, a=windowdata([],0,0); + else +% if nargin<4, +% l = []; + if nargin<3, + if nargin<2, span=1; end + hop=span; + end +% end + sz=size(src); + opts=prefs('wrap',1,'truncate',0,'random',[],'dim',length(sz),'strict',1,varargin{:}); + + dim=opts.dim; wrap=opts.wrap; trunc=opts.truncate; + a.hop=hop; a.span=span; + + % mutable state + a.length=sz(dim); + a.pos = 0; + a.opts =opts; + a.curr =[]; + + + % this trucates any remaining samples that don't fit the + % buffering structure so that the rewind always goes back to + % the first sample. + if trunc, + if wrap, error('ERROR: setting both truncate and wrap no longer supported'); + else disp('WARNING: truncate option no longer has any effect'); + end + end + + if ~isempty(opts.random), + error('Random option is deprecated, use rndwindow instead'); + end + + % sort out function table + ft.stringfn=@stringfn; + + if wrap + ft.datafn=@(a)a.curr; + ft.nextfn=@next_caching; + + [a.curr,src,a.pos,a.length]=itread(dim,span,src,0,a.length); + if size(a.curr,dim)<span, a=[]; return; end; % !! Strict window length? + a=class(a,'windowdata',ddata(src,arrset(sz,dim,span),ft)); + else + ft.datafn=@(a)extract(source(a),dim,a.pos+[1 span]); + ft.nextfn=@next_seq_nowrap; + + a=class(a,'windowdata',ddata(src,arrset(sz,dim,span),ft)); + if a.length<span, a=next_seq_nowrap(a); end; + end + end + + + % optimised next (assumes wrap=1) + function a=next_caching(a) + src=source(a); + if isempty(src) + a=[]; + else + [x,src,a.pos,a.length]=itread(dim,hop,src,a.pos,a.length); + if size(x,dim)<hop, + if opts.strict, + a=[]; % strict window length + else + a.curr=cat(dim,extract(a.curr,dim,[hop+1 span]),x); + a=setsize(setsource(a,src),size(a.curr)); + end + else + a.curr=cat(dim,extract(a.curr,dim,[hop+1 span]),x); + a=setsource(a,src); + end + end + end + + function a=next_seq_nowrap(a) + a.pos=a.pos+hop; % next window position + while a.pos+span>a.length % next window would overrun + a=next_nc(a); if isempty(a), break; end + a.length=size(source(a),dim); + a.pos=0; + end + end +end + + +% iterative read - read len samples starting at pos in head +% buffer of source. Returns tail source and pos for subsequent +% reads. +function [chunk,source,pos,max]=itread(dim,len,source,pos,max) + if len==0 || isempty(source), chunk=[]; return; end + + chunk=[]; + if pos+len>=max + chunk=extract(source,dim,[pos+1 max]); + len=pos+len-max; + source=next(source); + if ~isempty(source), + max=size(source,dim); + while len>=max + chunk=cat(dim,chunk,head(source)); len=len-max; + source=next(source); + if isempty(source), break; end + max=size(source,dim); + end + pos=0; + end + end + if ~isempty(source), + ex=extract(source,dim,pos+[1 len]); + if isempty(chunk), chunk=ex; else chunk=cat(dim,chunk,ex); end + pos=pos+len; + end +end + +function s=stringfn(a), s=sprintf('window(%d/%d)',a.span,a.hop); end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@zipaccum/fn.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function f=fn(o) +% FN - Get state-transformer function from zipaccum +% +f=o.fn;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@zipaccum/sources.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function s=sources(o,i) +% SOURCES - Cell array of sources for zipdata + +if nargin==1, s=o.sources; +else s=o.sources{i}; end;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@zipaccum/state.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function f=state(o) +% state - Get state of zipaccum object +% +f=o.state;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@zipaccum/zipaccum.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,58 @@ +function d=zipaccum(a,b,c,varargin) +% zipaccum - Combine several sequences with stateful function +% +% zipaccum :: +% ( (A(1),...,A(N),S)->(B,S)) ~ 'zipping function with state', +% S ~ 'initial state', +% {I:[N]->seq A(I)} ~ 'cell array of N sequences', +% options { +% size::[[1,E]] ~ 'size of result if known' +% } +% -> seq B. + +if nargin==0, d=zipaccum(@deal,1,{singleton(0)}); +elseif isa(a,'zipaccum'), d=a; +elseif any(cell2mat(cellmap(@isempty,c))), d=[]; +else + opts=prefs('datafn',@datafn,'nextfn',@nextfn2,'charfn',@charfn,varargin{:}); + + d.fn=a; + d.sources=c; + heads=cellmap(@head,c); + [d.x,d.state]=d.fn(heads{:},b); + + if ~isfield(opts,'size'), opts.size=size(datafn(d)); end + d=class(d,'zipaccum',data(opts.size,opts)); +end + + +function x=datafn(d), x=d.x; + +function d=nextfn1(d) + for i=1:length(d.sources), + d.sources{i}=next(d.sources{i}); + if isempty(d.sources{i}), d=[]; break; end + end + if ~isempty(d) + args=cellmap(@head,d.sources); + [d.state,d.x]=d.fn(d.state,args{:}); + d=setsize(d,size(d.x)); + end + +function d=nextfn2(d) + for i=1:length(d.sources), + d.sources{i}=next(d.sources{i}); + if isempty(d.sources{i}), d=[]; break; end + end + if ~isempty(d) + args=cellmap(@head,d.sources); + [d.x,d.state]=d.fn(args{:},d.state); + d=setsize(d,size(d.x)); + end + +function s=charfn(d) + s=char(d.sources{1}); + for i=2:length(d.sources) + s=[s ', ' char(d.sources{i})]; + end + s=sprintf('{ %s } >> %s',s,tostring(d.fn));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@zipdata/sources.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function s=sources(o,i) +% SOURCES - Cell array of sources for zipdata + +if nargin==1, s=o.sources; +else s=o.sources{i}; end;
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/@zipdata/zipdata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,49 @@ +function d=zipdata(a,n,varargin) +% ZIPDATA - Combine several data sources using a given function +% +% zipdata :: +% ( (A1,...,An)->B ~ zipping function, +% n:natural ~ number of sources to combine, +% data A1,...,data An ~ n data sources, +% ... ~ options +% ) -> data B +% +% Options: +% 'size'::[[1 E]] ~ size of result if known + +if nargin==0, d=zipdata(@id,1,singleton(0)); +elseif isa(a,'zipdata'), d=a; +else + d.fn=a; + if isnumeric(n) + d.sources=varargin(1:n); + varargin=varargin(n+1:end); + else + d.sources=n; + end + + if any(cell2mat(map(@isempty,d.sources))), d=[]; + else + opts=prefs('datafn',@datafn,'nextfn',@nextfn,'charfn',@charfn,varargin{:}); + if ~isfield(opts,'size'), opts.size=size(datafn(d)); end + d=class(d,'zipdata',data(opts.size,opts)); + end +end + + +function x=datafn(d) + data=cellmap(@head,d.sources); + x=feval(d.fn,data{:}); + +function d=nextfn(d) + for i=1:length(d.sources), + d.sources{i}=next(d.sources{i}); + if isempty(d.sources{i}), d=[]; break; end + end + +function s=charfn(d) + s=char(d.sources{1}); + for i=2:length(d.sources) + s=[s ', ' char(d.sources{i})]; + end + s=sprintf('{ %s } >> %s',s,tostring(d.fn));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/README Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,168 @@ +DATA CLASSES + +These class manage a variety of virtualised data sources. A data +object here is thought of as a lazy list or sequence of arrays, +where subsequent elements of the sequence are created only when +necessary. For example, an audio file can be read block by block +without loading the whole thing. + + + +SRC_ FUNCTIONS + +The src_ functions can handle data in the form of a cell array +of arrays, a data sequence object (see saml-1.0/data) or a +big array with an array of subranges. They are a simpler way of +providing some of the functionally of the data objects to +functions that need data but don't care where it comes from. + +The point of these is to decouple algorithms that just want to +read data from all the heavy Matlab classes in saml-1.0/data, +which are useful for constructing and manipulating data +sources, but are not necessary for simple batch data applications. +This way, the code can be extracted from the library without +having to bring along all the data classes. + + +HASKELL LIST FUNCTIONS + +head :: [a] -> a +tail :: [a] -> [a] +null :: [a] -> bool +length :: [a] -> natural +last :: [a] -> a + +cons :: a -> [a] -> [a] +map :: (a->b) -> [a] -> [b] +append :: [a] -> [a] -> [a] +concat :: [[a]] -> [a] +concatMap :: (a->[b]) -> [a] -> [b] +interleave:: [a] -> [a] -> [a] +scanl :: (a->b->a) -> a -> [b] -> [a] +scanl1 :: (a->a->a) -> [a] -> [a] +mapAccumL :: (a->b->(a,c)) -> a -> [b] -> (a,[c]) +unfold :: (b->maybe(a,b)) -> b -> [a] +zipWith :: (a->b->c) -> [a] -> [b] -> [c] +iterate :: (a->a) -> a -> [a] +repeat :: a -> [a] +replicate :: natural -> a -> [a] +cycle :: [a] -> [a] +take :: natural -> [a] -> [a] +splitAt :: natural -> [a] -> ([a],[a]) +filter :: (a->bool) -> [a] +takeWhile :: (a->bool) -> [a] -> [a] +span :: (a->bool) -> [a] -> ([a],[a]) +break :: (a->bool) -> [a] -> ([a],[a]) +partition :: (a->bool) -> [a] -> ([a],[a]) +init :: [a] -> [a] + +foldl :: (a->b->a) -> a -> [b] -> a +foldl1 :: (a->a->a) -> [a] -> a +drop :: natural -> [a] -> [a] +dropWhile :: (a->bool) -> [a] -> [a] + + +concat = foldl append [] +append x y = concat [x,y] +replicate n = take n . repeat +repeat x = cycle [x] +cycle = concat . repeat +concatMap = concat . map +once = take 1 + +naturals :: [natural] +fromTo :: natural -> natural -> [natural] +from :: natural -> [natural] +linseq :: real -> real -> natural -> [real]. +expseq :: real -> real -> natural -> [real]. +buflinear :: real -> real -> natural -> natural -> [arr(real)]. + + +naturals = iterate (+1) 0 +from = iterate (+1) +fromTo x y = take (y-x) (from x) +fromTo x y = takeWhile (<=y) (from x) + + +My classes + +data +ddata +bindcat +concat +rnddata +subseqdata + +arraydata = repeat +fndata = map +iterdate = iterate +loop = cycle +concat +take = take +scandata = scanl +sfndata = mapAccumL +zipdata = zip +cachedata +celldata + +wavelist = concatMap wavedata OR cycle . concatMap wavedata +bufferdata + (sort of (cons (gather (take n x)) (buffer n (drop n))) + +windowdata = concatScanl window1 (sort of) + +extractdata + + +My functions + +once = take 1 +drop = drop +repeat = loop . (take 1) +folddata = foldl +meandata = foldl accum init +scandatacols f = scanl (y\scancols f (last y)) +squirt f x = buffer (f (window x 1 1)) (size x 2) +expdata = +lindata = + + +gather dim = foldl (cat dim) [] +seq2cell = foldl \x\y[x {y}] {} + + +TO RESOLVE + + optimisation of constructors: + data, ddata, fndata, sfndata + !lindata by start and increment? + !rate conversion, interpolation + !continuous spectral synthesis with phase adjustment + + !the extract method belongs in a DIFFERENT type class: we need a class + of virtual arrays. This is essentially a function which: + (a) has a domain of tuples of natural numbers + (b) knows what its domain (size) is + (c) can be applied to arrays of values and maps over them + +Possible renamings: + scandata -> scanl (overloaded) + folddata -> foldl (ditto) + cachedata -> cache (actually just a strict head) + iterdata -> ? (class with iterate) + zipdata -> zip or zipWith + sfndata -> mapaccum + new zipaccum? + fndata -> map + extractdata -> ? + meandata? + + tricky:` + windowdata + bufferdata + framedata + + phasedata, spectraldata + + gather vs seq2cell +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/append.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +function x=append(varargin), x=concat(celldata(varargin)); +% append - Append one or more sequences +% +% append :: seq A, seq A -> seq A. +% append :: seq A, seq A, ... -> seq A. +% +% etc.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/chunk.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +function B=chunk(A,n,step) +% CHUNK: return chunk from inside matrix +% B=chunk(A,n,hop): returns nth block of rows of size hop from A +% A: source matrix +% n: index of chunk +% hop: size of chunk + +i=n*step+1; +B=A(i:i+step-1,:); + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/cons.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,8 @@ +function Y=cons(X,Z) +% cons - Make sequence given head and tail +% +% cons :: A, seq A -> seq A. + +Y=data(size(X),'datafn',@(o)X,'nextfn',@(o)Z, ... + 'charfn',@(o)[tostring(X) ' | (' tostring(Z) ')']); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/cumsum_reset.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function y=cumsum_reset(n,x,dim) +% cumsum with periodic reset + +y=bindcat(take(n,cumsum(x,dim)),@(z)cumsum_reset(n,next(source(source(z))),dim));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/diffwith.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,16 @@ +function Y=diffwith(F,X) +% diffwith - Generalised diff using argbitrary binary function +% +% diffwith :: (A,A->B), seq A -> seq B. +% +% The given function gets called with the current value as the +% first arguments and the previous value as the second. + +Y=sfndata(@diffst,head(X),next(X)); + +function [y,s]=diffst(x,s) + y=F(x,s); + s=x; +end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/drop.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,9 @@ +function s=drop(n,s) +% drop - Drop the first n alements of sequence +% +% drop :: natural, seq A -> seq A + +for i=1:n, s=next(s); end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/dropwhile.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,14 @@ +function s=dropwhile(f,s) +% drop - Drop elements of sequence that satisfy condition +% +% drop :: (A->bool), seq A -> seq A + +% if isempty(s) return s; end +x=head(s); +while f(x), + s=next(s); + if isempty(s), break; end + x=head(s); +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/expdata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,30 @@ +function y=expdata(A,B,N,M) +% expdata - exponential data sequence +% +% expdata :: +% real ~'initial value', +% real ~'final value', +% natural ~'number of steps (sequence length is steps+1), +% M:natural ~'buffer size' +% -> seq [[1,M]]. + +if nargin<4, M=1; end + +lA=log(A); +k=(log(B)-lA)/N; +y=unfold(@ls1,0:M-1); +%y=windowdata(linspace(A,B,N),M,M); + +function [X,I]=ls1(I), + surp=I(end)-N; + if surp>=0, + X=exp(lA+k*I(1:end-surp)); + if surp<M, X(end)=B; end + else + X=exp(lA+k*I); + end + I=I+M; +end + +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/extract.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,25 @@ +function y=extract(x,dim,range) +% EXTRACT - Extract a sub-array +% +% extract :: +% [[size:[E]]], +% n:1..E, +% [[2]->natural]~'start and end indices' +% -> [[size1:[E]]. +% +% Examples (assuming A is 3D): +% extract(A,2,[4 20]) = A(:,4:20,:) +% extract(A,3,[2 10]) = A(:,:,2:10) + +persistent colons + +n=ndims(x); +if length(colons)<n, + colons=repmat({':'},1,n); +end + +s=colons(1:n); %cell(1,n); s(:)={':'}; +s{dim}=range(1):range(2); +S.type='()'; +S.subs=s; +y=subsref(x,S);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/folddata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,28 @@ +function x=folddata(fn,e,y,varargin) +% folddata - Fold combinator for data sequences +% +% This function applies an associative operator to a list of arguments, +% starting from the left using the given starting element. +% +% folddata :: +% (X,Y->X) ~'associative binary operator', +% X ~'initial element', +% seq Y ~'a lazy data sequence' +% -> X. + +if nargin<4, + x=e; + while ~isempty(y) + x=fn(x,head(y)); + y=next(y); + end +else + opts=prefs('quiet',1,varargin{:}); + x=e; + while ~isempty(y) + x=fn(x,head(y)); + y=next(y); + if ~opts.quiet, fprintf('.'); end + optpause(opts); + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/framedata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,44 @@ +function a=framedata(signal,frame,hop,width,varargin) +% FRAMEDATA - return abstract data object for buffering signal frames +% +% framedata :: +% ( s:data[C,T] ~'C-channel signal of length T', +% N:natural ~'frame size', +% M:natural ~'hop size', +% L:natural ~'frames per buffer' | ([] => whole file) +% options... ) +% -> data[N,L]. +% +% Options: +% wrap/0 if 1, then buffer samples as if one continuous circular signal +% otherwise, don't return buffers that wrap round from end to start +% random/0: if [], return buffers sequentially, if number or random state +% vector, return buffers in random order, using value as seed. +% filter/[] optional filter function to apply to long windows before buffering +% jump/J number of samples to skip per large buffer. Default is calculated +% to produce seamless buffering with chosen width and hop. +% +% Note: if the signal is a multichannel signal, ie of size CxT with C>1, +% the samples for each channel are interleaved. + + + if nargin<4, width = []; end + opts=prefs('wrap',0,'random',[],'dim',2,varargin{:}); + if isempty(width), opts.truncate=0; end + + [span,jump]=windowparams(size(signal),frame,hop,width,opts); + if isempty(opts.random), + wd=windowdata(signal,span,jump,'wrap',opts.wrap,'dim',opts.dim); + else + wd=rndwindow(signal,span,opts.dim); + end + + if isfield(opts,'filter'), wd=opts.filter(wd); end + if size(wd,1)>1, wd=flatten(wd); end + if hop<frame, args={'nodelay'}; else args={}; end + + % NB: makes sense to cache large windows to save repeated calls + % extract current large window from data source while processing + % the buffered window. + a=buffer(cache(wd),frame,frame-hop,args{:}); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/gathern.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +function [z,zx]=gathern(dim,n,x) +% gathern - Gather first n elements of sequence +% +% gathern :: natural, natural, seq X -> [Size]. bah. +[z,zx]=gather(dim,take(n,x)); +if nargout==2, zx=next(source(zx)); end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/head.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +function y=head(x), y=x{1}; % if iscell(x), y=x{1}; else y=x; end; +% head - Head for cell arrays (first element) +% +% head :: {[Size]->A} -> A. + +% old header +% head - Head for non-sequences objects (shouldn'y be used) +% +% head :: A -> A. + +% disp('*** WARNING: head called for non-sequence');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/isdata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,1 @@ +function f=isdata(d), f=isa(d,'data');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/last.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +function z=last(y) +% last - get the last array in a sequence (there must be at least one element) +% +% last :: seq(A) -> A. + +while ~isempty(y) + x=y; + y=next(x); +end + +z=head(x);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/lazy_cons.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,8 @@ +function Y=lazy_cons(X,Z) +% lazy_cons - Make sequence given head and tail +% +% lazy_cons :: A, (unit -> seq A) -> seq A. + +Y=data(size(X),'datafn',@(o)X,'nextfn',@(o)Z(), ... + 'charfn',@(o)[tostring(X) ' | ' tostring(Z) '()']); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/lindata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,28 @@ +function y=lindata(A,B,N,M) +% lindata - linear data sequence +% +% lindata :: +% real ~'initial value', +% real ~'final value', +% natural ~'number of steps (sequence length is steps+1), +% M:natural ~'buffer size' +% -> seq [[1,M]]. + +if nargin<4, M=1; end +k=(B-A)/N; +y=unfold(@ls1,0:M-1); +%y=windowdata(linspace(A,B,N),M,M); + +function [X,I]=ls1(I), + surp=I(end)-N; + if surp>=0, + X=A+k*I(1:end-surp); + if surp<M, X(end)=B; end + else + X=A+k*I; + end + I=I+M; +end + +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/meandata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,80 @@ +function m=meandata(x,dim,varargin) +% MEANDATA - Mean of a sequence of arrays +% +% meandata :: +% seq [D] ~ sequence of E dimensional arrays of size D, ie D::[[E]] +% I:[[N]->[E]] ~ array of dimension numbers (between 1 and E) to do mean over +% options { +% check_nans :: {0,1}/0 ~'whether to check for (and ignore) nans' +% } +% -> [R] ~ array of size R, where R=set(D,I,1). +% +% if X is a sequence of 5 x 12 x 50 arrays, then +% M=meandata(X,[1,3]) +% returns a 1 x 12 array. +% +% Options: See ITERATE for applicable options + + opts=prefs('check_nans',0,varargin{:}); + + S.total=0; + S.count=0; + + if opts.check_nans, % world of pain + if isempty(dim) + S=folddata(@mean0_nan_st,S,x,varargin{:}); + elseif isscalar(dim) + S=folddata(@mean_nan_st,S,x,varargin{:}); + else + S=folddata(@meandims_nan_st,S,x,varargin{:}); + end + m=S.total./S.count; + else + if isempty(dim) + S=folddata(@mean0_st,S,x,varargin{:}); + elseif isscalar(dim) + S=folddata(@mean_st,S,x,varargin{:}); + else + S=folddata(@meandims_st,S,x,varargin{:}); + end + m=S.total/S.count; + end + + + % non-nan checking accumulators + function S=meandims_st(S,X) + S.total=S.total+sumdims(X,dim); + S.count=S.count+prod(sizedims(X,dim)); + end + + function S=mean_st(S,X) + S.total=S.total+sum(X,dim); + S.count=S.count+size(X,dim); + end + + function S=mean0_st(S,X) + S.total=S.total+X; + S.count=S.count+1; + end + + % nan checking accumulators + function S=meandims_nan_st(S,X) + I=isnan(X); X(I)=0; + S.total=S.total+sumdims(X,dim); + S.count=S.count+sumdims(~I,dim); + end + + function S=mean_nan_st(S,X) + I=isnan(X); X(I)=0; + S.total=S.total+sum(X,dim); + S.count=S.count+sum(~I,dim); + end + + function S=mean0_nan_st(S,X) + I=isnan(X); X(I)=0; + S.total=S.total+X; + S.count=S.count+(~I); + end +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/naturals.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function N=naturals, N=iterdata(@(n)n+1,0,'charfn',@(o)sprintf('%d..',head(o))); +% naturals - Sequence of natural numbers starting at 0 +% +% natural :: seq natural.
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/next.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function b=next(a) +% NEXT - Default next function for ordinary arrays -just returns the same array + +if isempty(a), error('NEXT called for empty array'); end +b=[]; +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/nth1.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,8 @@ +function [x,tail]=nth1(n,X) +% nth1 - Get nth element of a sequence starting at 1 +% +% nth1 :: natural, seq X -> X, seq X ~'tail of sequence'. + +z=drop(n-1,X); +x=head(z); +if nargout>=2, tail=next(z); end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/once.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +function Y=once(X), Y=take(1,X); +% once - read data once, next is null +% +% once :: seq A -> seq A. +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/phasedata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,16 @@ +function a=phasedata(source,windowfn) +% PHASEDATA - Spectral data from buffered frames +% +% phasedata :: ( +% source: data[n,l], ~ source data +% windowfn: (n:natural->[n]) ~ function to compute window, eg hanning +% ) -> data[m,l] + +H=spdiag(feval(windowfn,size(source,1))); +a=fndata(@(x)phasespec(H*x),source,'charfn',@charfn); + +function s=charfn(o) + s=sprintf('%s >> phase(%s)',char(source(o)),tostring(windowfn)); +end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/repeat.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +function Y=repeat(X) +% repeat - Make infinite sequence of the same given element +% +% repeat :: A -> seq A. + +Y=data(size(X),'datafn',@(o)X,'nextfn',@id,'charfn',@(o)[tostring(X) '>> repeat']); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/rndscanl.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,42 @@ +function X=rndscanl(gen,s0,varargin) +% rndscanl - Random scanl +% +% rndscanl :: +% (S,A -> rndgen S) ~'random scanner', +% S ~'initial state', +% seq A, +% rndstate ~'initial random state' +% -> seq S. + + n=length(varargin)-1; + rs0=varargin{n+1}; + if n>1, + X=zipaccum(@zafn,{s0,rs0},varargin(1:n)); + elseif n==1 + X=mapaccum(@mafn,{s0,rs0},varargin{1}); + else + X=unfold(@ufn,{s0,rs0}); + end + + function [x,s]=ufn(s0) + setrndstate(s0{2}); + x=gen(s0{1}); + s={x,getrndstate}; + end + + function [x,s]=mafn(y,s0) + setrndstate(s0{2}); + x=gen(s0{1},y); + s={x,getrndstate}; + end + + function [x,s]=zafn(varargin) + s0=varargin{n+1}; + setrndstate(s0{2}); + x=gen(s0{1},varargin{1:n}); + s={x,getrndstate}; + end +end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/rndwindow.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,43 @@ +function Y=rndwindow(X,span,dim,varargin) +% rndwindow - extract random windows of a signal +% +% rndwindow :: +% [Size:[1,E]] ~'E-dimensional signal array', +% L:natural ~'span of windows to extract', +% D:1..E ~'dimension to operate along', +% randstate ~'intial state of rngs' +% -> seq [arrset(Size,D,L)] ~'seq of arrays of size L in Dth dimension'. + + opts=prefs('state',rndstate,'circular',0,varargin{:}); + + sz=size1(X); + if nargin<3, dim=length(sz); end + len=sz(dim); + ran=[0,span-1]; + + if opts.circular, + ithresh=len-span+1; + Y=fndata(@exwin_circ,rndzip(@()randnat(len),opts.state),'stringfn',@strfn); + else + Y=fndata(@exwin,rndzip(@()randnat(len-span+1),opts.state),'stringfn',@strfn); + end + + function y=exwin(i), y=extract(X,dim,i+ran); end + function y=exwin_circ(i), + if i<=ithresh + y=extract(X,dim,i+ran); + else + y=cat(dim,extract(X,dim,[i,len]),extract(X,dim,[1,span-(1+len-i)])); + end + end + + function s=strfn(a) + s=sprintf('rndwindow(%s,%d)',tostring(X),span); + end +end + + + + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/rndzip.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,31 @@ +function X=rndzip(gen,varargin) +% rndzip - Random sequence by zipping argument sequences +% +% rndzip :: +% (A1, ..., An -> rndgen B) ~'sampling function', +% seq A1, ..., seq An ~'argument sequences', +% rndstate ~'initial random state' +% -> seq B. + + n=length(varargin)-1; + if n>0 + X=zipaccum(@zipfn,varargin{n+1},varargin(1:n)); + else + X=unfold(@ufn,varargin{1}); + end + + function [x,s]=ufn(s0) + setrndstate(s0); + x=gen(); + s=getrndstate; + end + + function [x,s]=zipfn(varargin) + setrndstate(varargin{n+1}); + x=gen(varargin{1:n}); + s=getrndstate; + end +end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/rndzipaccum.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,33 @@ +function X=rndzipaccum(gen,s0,varargin) +% rndzipaccum - Random sequence by zipping argument sequences with state +% +% rndzipaccum :: +% (A1, ..., An, S -> rndgen (B, S)) ~'stateful sampling function', +% S ~'initial state', +% seq A1, ..., seq An ~'argument sequences', +% rndstate ~'initial random state' +% -> seq B. + + n=length(varargin)-1; + if n>0 + X=zipaccum(@zafn,{s0,varargin{n+1}},varargin(1:n)); + else + X=unfold(@ufn,{s0,varargin{1}}); + end + + function [x,s]=ufn(s0) + setrndstate(s0{2}); + [x,t]=gen(s0{1}); + s={t,getrndstate}; + end + + function [x,s]=zafn(varargin) + s0=varargin{n+1}; + setrndstate(s0{2}); + [x,t]=gen(varargin{1:n},s0{1}); + s={t,getrndstate}; + end +end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/scandatacols.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +function Y=scandatacols(Fn,Y0,X) +% scandatacols - Scan over columns of array sequence + +Y=scandata(@(y,x)scancols(Fn,y(:,end),x),Y0,X);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/seq2cell.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,10 @@ +function Y=seq2cell(X) +% seq2cell - gather elements of sequence into a cell array +% +% seq2cell :: data A -> {[N]->A}. + +Y={}; +while ~isempty(X) + Y=[Y {head(X)}]; + X=next(X); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/singleton.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,6 @@ +function y=singleton(x) +% singleton - Make sequence with exactly one element +% +% singleton :: A -> seq A. + +y=data(size(x),'datafn',@(o)x,'nextfn',@(o)[],'charfn',@(o)'singleton');
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/skip.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,10 @@ +function s=skip(n,s) +% SKIP - Skip the first n alements of sequence +% +% skip :: natural, seq A -> seq A + +disp('*** DEPRECATED: use drop instead'); +for i=1:n, s=next(s); end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/span.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,9 @@ +function [h,x]=span(f,x) +% span - divide sequence using a test function +% +% span :: (A->bool), seq A -> seq A, seq A. +% +% span f x = (takeWhile f x,dropWhile f x) +% Will not terminate if head segments turns out to be infinite. +[Y,x]=spanc(f,x); +h=celldata(Y);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/spanc.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,22 @@ +function [Y,x]=spanc(f,x) +% spanc - divide sequence using a test function +% +% spanc :: (A->bool), seq A -> {[N]->A}, seq A. +% +% spanc f x = (seq2cell (takeWhile f x),dropWhile f x) +% Will not terminate if head segments turns out to be infinite. +% +% Note: this is like span but returns a cell array for the head sequence + +if isempty(x), Y={}; return +else + Y={}; + y=head(x); + while f(y) + Y=horzcat(Y,y); + x=next(x); + if isempty(x), break; end + y=head(x); + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/spectraldata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,18 @@ +function a=spectraldata(source,specfn,windowfn) +% SPECTRALDATA - Spectral data from buffered frames +% +% spectraldata :: ( +% source: data[n,l], ~ source data +% specfn: [n,l]->[m,l], ~ compute spectrum from frames +% windowfn: (n:natural->[n]) ~ function to compute window, eg hanning +% ) -> data[m,l] + + H=spdiag(feval(windowfn,size(source,1))); + a=fndata(@(x)specfn(H*x),source); + %a=fndata(fn,source,'charfn',@charfn); + +% function s=charfn(o) +% s=sprintf('%s >> %s/%s',char(source(o)),tostring(specfn),tostring(windowfn)); +% end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/split.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +function [h,t]=split(dim,n,s) +% split - gather first n elements and return with rest of sequence +% +% split :: D:natural, N:natural, seq A -> [[N]->A], seq A + +h=[]; +for i=1:n, x=head(s); h=cat(dim,h,x); s=next(s); end +t=s; + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/squirt.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,10 @@ +function y=squirt(f,x,varargin) +% squirt - send buffered data sequence through a single-item data transformer +% +% squirt :: +% (seq [[N]] -> seq [[M]]) ~'data transforming function', +% seq [[N,L]] ~'buffered sequence', +% options {} ~'any options passed to windowdata' +% -> seq [[M,L]] ~'re-buffered output'. + +y=bufferdata(f(windowdata(x,1,1,varargin{:})),size(x,2));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/src_cell.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +function S=src_cell(D), S=@(z)next_cell(D); +% src_cell - Data source for cell array of arrays +% +% src_cell :: +% {[P]->[[N,_]]} ~'cell array containing P N-by-? arrays' +% -> source(N) ~'returns a source of N-dim data sequences'. + +function [x,F]=next_cell(D), + x=D{1}; + if length(D)==1, F=[]; + else F=@(z)next_cell(D(2:end)); end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/src_data.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +function F=src_data(D), S=@(z)next_data(D); +% src_data - Data source for data objects +% +% src_data :: +% seq [[N,_]] ~'data object representing sequence of arrays' +% -> source(N) ~'returns a source of N-dim data sequences'. +F=@(z)next_data(Data); + +function [x,F]=next_data(D) + x=head(D); + F=@(z)next_data(next(D)); +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/src_subseq.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,16 @@ +function F=src_subseq(X,T) +% src_subseq - Data source for subsequences of a big array +% +% src_subseq :: +% [[N,T]] ~'big array', +% [[2,P]] ~'subranges for each of P subsequences' +% -> source(N) ~'returns a source of N-dim data sequences'. + +if nargin<2 || isempty(T), T=[1;size(X,2)]; end; +F=@(z)next_subseq(X,T,1); + +function [x,F]=next_subseq(X,T,n), + x=X(:,T(1,n):T(2,n)); + if n==size(T,2), F=[]; + else F=@(z)next_subseq(X,T,n+1); end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/subseqdata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,17 @@ +function o=subseqdata(X,ranges,varargin) +% SUBSEQDATA - Sequence of subranges of a large array +% +% subseqdata :: +% [[N,M]] ~ 'big array', +% [[2,K]] ~ 'start and end indices' +% -> data [[N,M]]. ~ 'resultant sequence'. + + R=windowdata(ranges,1,1); + o=fndata(@(r)extract(X,2,r),R,'sizecheck',1,'charfn',@(o)'subseqdata'); + + function x=getrange(r), x=extract(X,2,r'); end +end + + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/wavelist.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,2 @@ +function o=wavelist(files,varargin) + o=concat(cellmap(@wavedata,files));
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/window.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +function Y=window(X,varargin), Y=windowdata(X,varargin{:}); +% window - Window a sequnce of arrays in a given dimension +% +% window :: seq [[N,M]] -> seq [[N]]. +% window :: seq [[N,M]], L:natural -> seq [[N,L]]. +% window :: seq [[N,M]], L:natural, natural ~'hop size' -> seq [[N,L]]. +% +% This is just short for windowdata(...) +% Possible optimisation: +% when the span and hop are much less than the input buffer size +% and the source data does not have an efficient extract method, +% then it is worth caching the source data, ie window(cache(x),...)
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/window_ns.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,12 @@ +function Y=window_ns(X,W,H), +% window_ns - Window a sequnce of arrays in a given dimension (no strict size) +% +% window_ns :: seq [[N,M]] -> seq [[N]]. +% window_ns :: seq [[N,M]], L:natural -> seq [[N,L]]. +% window_ns :: seq [[N,M]], L:natural, natural ~'hop size' -> seq [[N,L]]. + +if nargin<2, W=1; H=1; +elseif nargin<3, H=W; +end + +Y=windowdata(X,W,H,'strict',0);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sequences/windowparams.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +function [span,jump]=windowparams(sz,frame,hop,width,opts) +% windowparams - compute windowing parameters to get buffers of a certain size +% +% windowparams :: +% [[1,2]] ~ 'size of signal [channels,length]', +% natural ~ 'desired frame length', +% natural ~ 'desired hop per frame', +% natural|[] ~ 'desired number of frames per buffer or [] for all', +% options { +% natural : jump/[] ~'override window jump' +% } +% -> natural ~ 'recommended window span', +% natural ~ 'recommended window jump'. + + channels = sz(1); + length = sz(2); + + if isempty(width) + width=channels*(floor((length-frame)/hop)+1); + end + + span = (hop*(width-1)+frame)/channels; + jump = (hop*width)/channels; + + if nargin>4 && isfield(opts,'jump'), jump = channels*hop*opts.jump; end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sink/or.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,11 @@ +% or - parallel sink combinator +function s=or(s1,s2), + c1=1:channels(s1); + c2=channels(s1) + (1:channels(s2)); + s=sinkbinop(@vertsplit,@plus,s1,s2); + function [y1,y2]=vertsplit(x) + y1=x(c1,:); + y2=x(c2,:); + end +end +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sink/sink.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,51 @@ +% sink - Base class for sink +% +% sink :: sink(C:natural,R:nonneg). +% +% The sink(C,R) type denotes the type of a sink with C +% channels and a sampling rate of R. +% +% The base sink class cannot be used without subclassing since +% any attempt to instantiate the live sink will throw +% an exception. +% +% METHODS +% channels :: sink(C,R) -> natural. +% rate :: sink(C,R) -> nonneg. +% construct:: sink(C,R) -> livesink(C,_). +% capacity :: sink(C,R) -> natural. +% +% livesink(C,Z) :== struct { +% start :: void->void; +% stop :: void->void; +% dispose :: void->Z; +% writer :: N:natural -> ([[C,N]] -> natural); +% } + +classdef sink + methods + function o=sink, end + function s=and(s1,s2), s=sinkcat(s1,s2); end + function r=rate(s), error('sampling rate undefined'); end + function c=channels(s), error('number of channels undefined'); end + function s=construct(sig), error('Cannot construct base sink class'); end + + function display(a) + disp(sprintf(' %s :: sink(%s,%s)',tostring(a),fmt(channels(a)),fmt(rate(a)))); + function s=fmt(x), if isnan(x), s='_'; else s=num2str(x); end; end + end + + function y=map(f,chf,x), y=sinkmap(f,chf,x); end + function y=drop(n,x), y=sinkdrop(n,x); end + function y=take(n,x), y=sinktake(n,x); end + function y=dropt(t,x), + if isnan(rate(x)), error('Cannot dropt without definite sampling rate'); end + y=sinkdropt(round(t*rate(x)),x); + end + + function y=taket(t,x), + if isnan(rate(x)), error('Cannot taket without definite sampling rate'); end + y=sinktake(round(t*rate(x)),x); + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sink/supply.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,28 @@ +% supply - squirt data from an array into a sink +% supply :: sink(C,R), [[C,L]], options -> [[C,N]]. +function varargout=supply(sink,x,varargin) + opts=prefs('chunk',256,varargin{:}); + + s=construct(sink); + try % to make sure we dispose of s once opened + chunk=uint32(opts.chunk); + n=uint32(0); CHUNK=1:chunk; + r=s.writer(opts.chunk); + rem=0; + s.start(); + while rem==0 + rem=r(x(:,n+CHUNK)); + n=n+chunk; + end + n=n-rem; % remove rem samples from end + catch ex + s.dispose(); + rethrow(ex); + end + s.stop(); + varargout{1}=rem; + [varargout{2:nargout}]=s.dispose(); +end + + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sink/tee.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,7 @@ +% tee - T-junction sink, sends copies to two sub-sinks. +function s=tee(snk1,snk2) + if ~unify_channels(channels(snk1),channels(snk2)) + error('Channel number mismatch'); + end + s=sinkbinop(@dup,@(c1,c2)unify_channels(c1,c2),snk1,snk2); +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sinkarray/sinkarray.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,63 @@ +% sinkarray - sink that collects data in an array +% +% sinkarray :: +% ([[C,L]] -> action void) ~'function to do something with array on dispose', +% C:natural ~'number of channels, +% L:natural ~'capacity of sink', +% R:nonneg ~'sampling rate' +% -> sink(C,R). + +classdef sinkarray < sink + properties (GetAccess=private,SetAccess=immutable) + chans % natural + length % natural + fs % nonneg + cont % [[C,N]] -> void + end + methods + function s=sinkarray(cont,ch,len,rate) + if nargin<4, rate=nan; end + s.chans=ch; + s.length=len; + s.fs=rate; + s.cont=cont; + end + + function s=tostring(sig), + s=sprintf('sinkarray(%s,<%dx%d>)',tostring(sig.cont),sig.chans,sig.length); + end + + function c=channels(s), c=s.chans; end + function c=rate(s), c=s.fs; end + function s=construct(sig) + + length=sig.length; + ch=channels(sig); + array=zeros(ch,length); + pos=0; + + s.start = @nop; + s.stop = @nop; + s.dispose = @dispose; + s.writer = @writer; + + function dispose, sig.cont(array(:,1:pos)); end + + function r=writer(n) + r = @next; + CHUNK = 1:uint32(n); + function rem=next(x) + n=size(x,2); + if pos+n<=length + array(:,pos+CHUNK)=x; rem=0; + pos=pos+n; + else + rem=n-(length-pos); + array(:,pos+1:end)=x(:,1:rem); + pos=length; + end + end + end + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sinkbinop/sinkbinop.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,62 @@ +% sinkbinop - sink that uses arbitrary function to distribute to two subsinks +% +% sinkbinop :: +% ([[C,N]] -> [[C1,N]], [[C2,N]]) ~'distribution function', +% (C1:natural, C2:natural -> C:natural) ~'channel count function', +% sink(C1,R), +% sink(C2,R) +% -> sink(C,R). + +classdef sinkbinop < sink + properties (GetAccess=private,SetAccess=immutable) + op % [[C1,N]], [[C2,N]] -> [[C3,N]] + sig1 % signal(C1,R) + sig2 % signal(C2,R) + ch % natural + end + + methods + function s=sinkbinop(f,chf,sig1,sig2) + s.op=f; + s.sig1=sig1; + s.sig2=sig2; + s.ch=chf(channels(sig1),channels(sig2)); + if isinf(unify_rates(rate(sig1),rate(sig2))) + error('Sample rate mismatch'); + end + end + + function s=tostring(sig) + s=sprintf('(%s <%s> %s)',tostring(sig.sig1),tostring(sig.op),tostring(sig.sig2)); + end + + function c=channels(s), c=s.ch; end + function r=rate(s), r=rate(s.sig1); end + function s=construct(sig) + + s1=construct(sig.sig1); + s2=construct(sig.sig2); + op=sig.op; + + s.start = @start; + s.stop = @stop; + s.dispose = @dispose; + s.writer = @writer; + + function start, s1.start(); s2.start(); end + function stop, s1.stop(); s2.stop(); end + function dispose, s1.dispose(); s2.dispose(); end + function r=writer(n) + r1=s1.writer(n); + r2=s2.writer(n); + r =@next; + function rem=next(x) + [x1,x2]=op(x); + rem1=r1(x1); + rem2=r2(x2); + rem=max(rem1,rem2); % !!! this could be wrong + end + end + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sinkcat/construct.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +function s=construct(sig) + sc=construct(sig.sinks{1}); + sx=sig.sinks(2:end); + + s.start = @start; + s.stop = @stop; + s.dispose = @dispose; + s.writer = @writer; + + function start, sc.start(); end + function stop, sc.stop(); end + function dispose, sc.dispose(); end + + function r=writer(n) + rc=sc.writer(n); + r = @next; + function rem=next(x) + rem=rc(x); + while rem>0 && ~isempty(sx) % current signal exhausted, try next + sc.dispose(); + sc=construct(sx{1}); sx=sx(2:end); + rem=sinkwriten(sc,n,x(end-rem+1:end)); + rc=sc.writer(n); + end + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sinkcat/sinkcat.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,37 @@ +% sinkcat - sink concatentation combinator +% +% sinkcat :: S1:sink(C,R), S2:sink(C,R), ... -> sink(C,R). +% +% The resulting sink writes to S1 until it reports full,then +% to S2, then S3 and so on, until the last one, then it reports full. +classdef sinkcat < sink + properties (GetAccess=private,SetAccess=immutable) + sinks % {[M]->sink(C,R)} + chans % natural + fs % nonneg + end + methods + function s=sinkcat(varargin) + % use 0 to signal <any> sampling rate and nan to indicate failure + fs=foldl(@unify_rates,nan,map(@rate,varargin)); + if isinf(fs), error('sampling rate mismatch'); end + ch=foldl(@unify_channels,nan,map(@channels,varargin)); + if isinf(ch), error('channel count mismatch'); end + s.sinks=varargin; + s.fs=fs; + s.chans=ch; + end + + function s=tostring(sig) + n=length(sig.sinks); + strx=map(@tostring,sig.sinks); + if n==1, s=strx{1}; + elseif n==2, s=sprintf('%s & %s',strx{1},strx{2}); + else s=sprintf('sinkcat(%s,...)',strx{1}); + end + end + + function c=rate(s), c=s.fs; end + function c=channels(s), c=s.chans; end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sinkdrop/sinkdrop.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,44 @@ +% sinkdrop - sink that discards first N samples before sending to subsink. +% +% sinkdrop :: N:natural, sink(C,R) -> sink(C,R). +classdef sinkdrop < sink + properties (GetAccess=private,SetAccess=immutable) + todrop % natural + dest % sink(C,R) + end + methods + function s=sinkdrop(n,sig) + s.todrop=n; + s.dest=sig; + end + function s=tostring(sig) + s=sprintf('drop(%d,%s)',sig.todrop,tostring(sig.dest)); + end + function c=rate(s), c=rate(s.dest); end + function c=channels(s), c=channels(s.dest); end + function s=construct(sig) + s1=construct(sig.dest); + todrop=sig.todrop; + + s.start=s1.start; + s.stop=s1.stop; + s.dispose=s1.dispose; + s.writer=@writer + + function f=writer(n) + w1=s1.writer(n); + f=@next + function rem=next(x) + n=uint32(size(x,2)); + if todrop==0, rem=w1.next(x); + elseif n<=todrop + todrop=todrop-n; + else + rem=sinkwriten(s1,n-todrop,x(:,todrop+1:end)); + todrop=0; + end + end + end + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sinkempty/sinkempty.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +% sinkempty - A sink with zero capacity. +classdef sinkempty < sink + properties (GetAccess=private,SetAccess=immutable) + chans % natural + fs % nonneg + end + methods + function s=sinkempty(channels,rate) + if nargin<2, rate=nan; end + if nargin<1, channels=nan; end + s.chans=channels; + s.fs=rate; + end + + function s=tostring(sig), s='sinkempty'; end + function c=channels(s), c=s.chans; end + function c=rate(s), c=s.fs; end + function s=construct(sig) + s.start = @nop; + s.stop = @nop; + s.dispose = @nop; + s.writer = @(n)@next; + + function rem=next(x), rem=size(x,2); end + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sinkfun/sinkfun.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,42 @@ +% sinkfun - sink that calls given function with samples. +classdef sinkfun < sink + properties (GetAccess=private,SetAccess=immutable) + fun % [[C,N]]->void + chans % natural + fs % nonneg + end + methods + function s=sinkfun(fun,channels,rate) + s.fun=fun; + s.fs=rate; + s.chans=channels; + end + + function s=tostring(sig) + s=sprintf('sinkfun(%s)',tostring(sig.fun)); + end + + function c=channels(s), c=s.chans; end + function c=rate(s), c=s.fs; end + function s=construct(sig) + fun=sig.fun; + t=0; + + s.start = @nop; + s.stop = @nop; + s.dispose = @nop; + s.writer = @writer; + + function w=writer(n) + w = @next; + T=(0:n-1)/rate(sig); + dt=1/rate(sig); + function rem=next(x), + m=size(x,2); + fun(t+T(1:m),x); rem=0; + t=t+n*dt; + end + end + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sinkmap/sinkmap.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,42 @@ +% sinkmap - sink that applies arbitrart function before sending to subsink. +% +% sinkmap :: +% ([[C1,N]] -> [[C2,N]]) ~'function to tranform samples', +% (C2:natural -> C1:natural) ~'function to compute number of channels', +% sink(C2,R) +% -> sink(C1,R). +classdef sinkmap < sink + properties (GetAccess=private,SetAccess=immutable) + fun + dest + chans + end + methods + function s=sinkmap(f,chf,sig) + s.fun=f; + s.sig=sig; + s.chans=chf(channels(dest)); + end + + function c=channels(s), c=s.chans; end + function c=rate(s), c=rate(s.dest); end + function s=construct(sig) + + f=sig.fun; + s1=construct(sig.dest); + s.start = s1.start; + s.stop = s1.stop; + s.dispose = s1.dispose; + s.writer = @writer; + + function r=writer(n) + r1=s1.writer(n); + r =@(x)r1(f(x)); + end + end + function s=tostring(sig) + s=sprintf('map(%s,%s)',tostring(sig.fun),tostring(sig.dest)); + end + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sinknull/sinknull.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,27 @@ +% sinknull - A sink that discards all data +% +% sinknull :: C:natural -> sink(C,_). +% sinknull :: C:natural, R:nonneg -> sink(C,R). +classdef sinknull < sink + properties (GetAccess=private,SetAccess=immutable) + chans + fs + end + methods + function s=sinknull(channels,rate) + if nargin<2, rate=nan; end + if nargin<1, channels=nan; end + s.chans=channels; + s.fs=rate; + end + function s=tostring(sig), s='sinknull'; end + function c=rate(s), c=s.fs; end + function c=channels(s), c=s.chans; end + function s=construct(sig) + s.start = @nop; + s.stop = @nop; + s.dispose = @nop; + s.writer = @(n)@(x)0; + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/@sinktake/sinktake.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,50 @@ +% sinktake - limit capacity of sink +% +% sinktake :: N:natural, sink(C,R) -> sink(C,R). +classdef sinktake < sink + properties (GetAccess=private,SetAccess=immutable) + length + dest + end + methods + function s=sinktake(n,dest) + s.length=n; + s.dest=dest; + end + + function s=tostring(sig) + s=sprintf('take(%d,%s)',sig.length,tostring(sig.dest)); + end + end + + function c=channels(s), c=channels(s.dest); end + function c=rate(s), c=rate(s.dest); end + + function s=construct(sink) + sc=construct(sink.dest); + len=uint32(sink.length); + + s.start = sc.start; + s.stop = sc.stop; + s.dispose = sc.dispose; + s.writer = @writer; + + function r=writer(n) + rc=sc.writer(n); + r = @write; + n=uint32(n); + function rem=write(x) + n=size(x,2); % how much to write this time + if len>n % not planning to stop this time + rem=rc(x); + len=len-(n-rem); % reduce n by amount written + elseif len>0 % only write upto len samples + rem=rc(x(:,1:len))+(n-len); + else + rem=n; + end + end + end + end + end +end
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/sinkdata.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,31 @@ +% sinkdata - write sequence of arrays to sink +% +% sinkdata :: +% seq [[C,N]] ~'sequence of arrays of C channel signal', +% sigsink(C,R) ~'sink' +% natural ~'maximum size of arrays in input' +% -> action. +% +% Third argument defaults to maximum dimension of signal arrays. +% This function does not control the timing of the writes and +% so is suitable for non-real-time writes to eg audio files. + +function res=sinkdata(Y,S,maxbuf) + if nargin<3, maxbuf=max(size(Y)); end + u=construct(S); + try + W=u.writer(maxbuf); + u.start(); foreach(@write,Y); u.stop(); + catch ex + u.dispose(); + rethrow(ex); + end + u.dispose(); + + function write(x) + rem=W(x); + if rem>0, error('Sink is full'); end + end +end + +
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/sinkwriten.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,4 @@ +% sinkwriten - write samples to an active sink. +function rem=sinkwriten(src,n,x) + r=src.writer(n); + rem=r(x);
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/sinks/sinkws.m Wed Dec 19 22:38:28 2012 +0000 @@ -0,0 +1,5 @@ +% sinkws - sink that produces an array in the base workspace. +function s=sinkws(name,ch,len,rate) + if nargin<4, rate=nan; end + s=sinkarray(@(x)assignin('base',name,x),ch,len,rate); +end