function varargout=ndstest(TOL)
%Performs numerous tests of ndSparse math operations,
%
%  ndstest(TOL)
%
%TOL is a tolerance value on the percent error. Execution will pause in debug
%mode for inspection if any one of the tests exhibits an error greater than
%TOL.

if nargin<1
 TOL=inf; %default tolerance value on discrepancies
end

CHECKTYPES=false;

%%function for measuring error

 err=@(x,y) DiscrepancyMeasure(x,y,TOL,CHECKTYPES);

Pf=srand(3,3,2,4);
Qf=srand(size(Pf));
Af=srand(3,2)*1i;
Bf=srand(3,2);
Cf=srand(3,2);
Sf=srand(3);
Vrf=1:(numel(Pf)-3);
Vcf=Vrf.';
three=single(3);

%%Representations of the above as ndSparse objects
P=ndSparse(Pf(:),size(Pf));   % =Pf
Q=ndSparse(Qf(:),size(Qf));   % =Qf
A=ndSparse(Af);   % =Af
B=ndSparse(Bf);   % =Bf
C=ndSparse(Cf);   % =Cf
S=ndSparse(Sf);   % =Sf
Vc=ndSparse(Vcf);   % =Vcf
Vr=ndSparse(Vrf);   % =Vrf

%%%%%%%%%%%%%%%%%%%%%%%%%%%TESTS%%%%%%%%%%%%%%%%%%%%%%%%%%

%%Test of full()
Error(1)=     err( full(P), Pf  );
Error(end+1)= err( full(Q), Qf  );
Error(end+1)= err( full(S), Sf );

%%Test of sparse2d, sparse

  %Error(end+1)= ~isequal( sparse(A), A ); %obsolete test of sparse(ndSparse)

Error(end+1)= ~isequal( sparse2d(A), reshape(sparse(Af),[],size(Af,ndims(Af)) ) );
Error(end+1)= ~isequal( sparse(A), sparse(Af) );

   %%No sense in proceding if the tests so far didn't pass - the error
   %%calculations rely on the functionality of full@ndSparse()
    if max(Error)>TOL,
        Error,
        error 'Something wrong with sparse() and full() methods';
    end

%Test of logical, double

Error(end+1)=err( class(logical(P)), class(logical(Pf)));
Error(end+1)=err( class(double(P)), class(double(Pf)));

%%Test isnumeric, islogical, isempty, issparse, isfloat, isreal,isinf,
%      isnan, isfinite, isequal, isequalwithequalnans
Error(end+1)= err( isnumeric(P),1);
Error(end+1)= err( ~isnumeric(P>0),1);
Error(end+1)= err( isfloat(P),1);
Error(end+1)= err( ~isfloat(P>0),1);
Error(end+1)= err( ~islogical(P),1);
Error(end+1)= err( islogical(P>0),1);
Error(end+1)= err( ~isempty(P),1);
Error(end+1)= err( isempty(ndSparse([])),1);
Error(end+1)= err( issparse(P),1);
Error(end+1)= err( issparse(A), 1 );
Error(end+1)= err( ~isreal(A), 1 );
Error(end+1)= err( isreal(B), 1 );

     Z=P; Z(1)=nan; Z(2)=inf;
     Zf=full(Z);

Error(end+1)= err( isnan(Z), isnan(Zf) );
Error(end+1)= err( isinf(Z), isinf(Zf) );
Error(end+1)= err( isfinite(Z), isfinite(Zf) );
Error(end+1)= err( ~isequal(Z,Zf), 1 );
Error(end+1)= err( ~isequal(Zf,Z), 1 );
Error(end+1)= err( ~isequal(Z,Zf,Z), 1 );
Error(end+1)= err( ~isequal(Zf,Z,Z), 1 );
Error(end+1)= err( isequalwithequalnans(Z,Zf), 1 );
Error(end+1)= err( isequalwithequalnans(Zf,Z), 1 );
Error(end+1)= err( isequalwithequalnans(Z,Zf,Z), 1 );
Error(end+1)= err( isequalwithequalnans(Zf,Z,Zf), 1 );

%Test of real, imag, conj, abs,sqrt

     Z=ndSparse(Bf+Af); %complex result
     Zf=full(Z);

Error(end+1)= err( real(Z), real(Zf) );
Error(end+1)= err( imag(Z), imag(Zf) );
Error(end+1)= err( conj(Z), conj(Zf) );
Error(end+1)= err( abs(Z), abs(Zf) );
Error(end+1)= err( sqrt(Z), sqrt(Zf) );

%%Test of size

Error(end+1)=err( size(P), size(Pf) );
Error(end+1)=err( size(P,2), size(Pf,2) );

       [mm,nn]  =size(Q);
       [mmm,nnn]=size(Qf);

Error(end+1)=err( [mm,nn] , [mmm,nnn] );

%%Test of reshape

Error(end+1)= err( reshape(P,size(P,1),[]) , reshape(Pf,size(Pf,1),[]));

%%Test of permute, ipermute

       ord=randperm(ndims(Pf));
       Z=permute(P,ord);
       Zf=permute(Pf,ord);

Error(end+1)= err( Z , Zf );
Error(end+1)= err( ipermute(Z,ord) ,  Pf );

%%Test of transpose, ctranspose
Error(end+1)= err( A.' ,  Af.'   );
Error(end+1)= err( A'  ,  Af'   );

%%Test of uplus, uminus

Error(end+1)= err( +P  , +Pf );
Error(end+1)= err( -Q  , -Qf );

%%Test of plus, minus

Error(end+1)= err( P+Q  , Pf+Qf );
Error(end+1)= err( P-Q ,  Pf-Qf );

%%Test of inv

Error(end+1)= err( inv(S)  , inv(Sf) );

%%Test of find

            [II,JJ,KK]=find(P);
            [IIf,JJf,KKf]=find(Pf);

Error(end+1)= err( II  , IIf );
Error(end+1)= err( JJ  , JJf );
Error(end+1)= err( KK  , KKf );

%%Test of mtimes

Error(end+1)= err( A*three , Af*three  );  %scalar with ndSparse
Error(end+1)= err( three*P , three*Pf  );

Error(end+1)= err( S*A , Sf*Af  ); % 2 ndSparses

   x=Af(end,:).';
   y=Af(:,end).';

Error(end+1)= err( A*[x,x] , Af*[x,x]  ); %pre-mult with columnized data
Error(end+1)= err( [y;y]*A , [y;y]*Af  ); %post-mult with columnized data

Error(end+1)= err( S*Af , Sf*Af  ); %mixed op

%%Test of mldivide
Error(end+1)= err( three\P , three\Pf  );  %scalar with ndSparse
Error(end+1)= err( three\A , three\Af  );
Error(end+1)= err( B\A , Bf\Af  ); % 2 ndSparses
Error(end+1)= err( B\Af , Bf\Af  );

%%Test of mrdivide

    Bt=B.'; Btsp=Bf.';

Error(end+1)= err( Bt/three , Btsp/three  );%scalar with ndSparse

Error(end+1)= err( P/three , Pf/three  );%scalar with ndSparse
Error(end+1)= err( A.'/Bt , Af.'/Btsp ); % 2 ndSparses
Error(end+1)= err( Af.'/Bt , Af.'/Btsp );

%%Test of times

Error(end+1)= err( P.*three , Pf.*three  );  %scalar with ndSparse
Error(end+1)= err( three.*P , three.*Pf  );

Error(end+1)= err( P.*Q , Pf.*Qf  ); % 2 ndSparses
Error(end+1)= err( Pf.*Q , Pf.*Qf  );

%%Test of rdivide

Error(end+1)= err( Q./three , Qf./three  );  %scalar with ndSparse
Error(end+1)= err( three./Q , three./Qf  );

Error(end+1)= err( P./Q , Pf./Qf  ); %2 ndSparses
Error(end+1)= err( Q./P , Qf./Pf  ); %2 ndSparses
Error(end+1)= err( Qf./P , Qf./Pf  ); %mixed

%%Test of ldivide

Error(end+1)= err( Q.\three , Qf.\three  );  %scalar with ndSparse
Error(end+1)= err( three.\Q , three.\Qf  );

Error(end+1)= err( Q.\P , Qf.\Pf  ); %2 ndSparses
Error(end+1)= err( P.\Q , Pf.\Qf  ); %2 ndSparses
Error(end+1)= err( Pf.\Q , Pf.\Qf  );

%%Test of power, mpower
Error(end+1)= err( P.^three ,  Pf.^three   );
Error(end+1)= err( three.^P ,  three.^Pf   );
Error(end+1)= err( Q.^P ,  Qf.^Pf   );
Error(end+1)= err( Qf.^P ,  Qf.^Pf   );

%%Test of mpower
Error(end+1)= err( S^three  ,  Sf^three   );

%%Test of relops

Error(end+1)= err( P>P ,  Pf>Pf   );
Error(end+1)= err( P>Pf ,  Pf>Pf   );
Error(end+1)= err( P>three/6  , Pf>three/6   );

Error(end+1)= err( P>=P ,  Pf>=Pf   );
Error(end+1)= err( P>=Pf ,  Pf>=Pf   );
Error(end+1)= err( P>=three/6  , Pf>=three/6   );

Error(end+1)= err( P<P ,  Pf<Pf   );
Error(end+1)= err( P<Pf ,  Pf<Pf   );
Error(end+1)= err( P<three/6  , Pf<three/6   );

Error(end+1)= err( P<=P ,  Pf<=Pf   );
Error(end+1)= err( P<=Pf ,  Pf<=Pf   );
Error(end+1)= err( P<=three/6  , Pf<=three/6   );

Error(end+1)= err( P==P ,  Pf==Pf   );
Error(end+1)= err( P==Pf ,  Pf==Pf   );
Error(end+1)= err( P==three/6  , Pf==three/6   );

Error(end+1)= err( P~=P ,  Pf~=Pf   );
Error(end+1)= err( P~=Pf ,  Pf~=Pf   );
Error(end+1)= err( P~=three/6  , Pf~=three/6   );

%%Test of logical ops

Error(end+1)= err( P&P ,  Pf&Pf   );
Error(end+1)= err( P&Pf ,  Pf&Pf   );
Error(end+1)= err( P|three/6  , Pf|three/6   );

Error(end+1)= err( ~P ,   ~Pf   );
Error(end+1)= err( ~Q  ,  ~Qf  );

%%Test of sum

Error(end+1)= err( sum(P,1)  , sum(Pf,1) );
Error(end+1)= err( sum(Q,2)  , sum(Qf,2) );
Error(end+1)= err( sum(P)    , sum(Pf) );
Error(end+1)= err( sum(P,'native')    , sum(Pf,'native') );
Error(end+1)= err( sum(P,3,'double')    , sum(Pf,3,'double') );
Error(end+1)= err( sum(P,4)    , sum(Pf,4) );
Error(end+1)= err( sum(P,5)    , sum(Pf,5) );

%%Test of cat, horzcat, vertcat

Error(end+1)= err([P,P] ,[Pf,Pf]);
Error(end+1)= err([Pf,P] ,[Pf,Pf]);
Error(end+1)= err([P,Pf] ,[Pf,Pf]);

Error(end+1)= err([P;P] ,[Pf;Pf]);
Error(end+1)= err([Pf;P] ,[Pf;Pf]);
Error(end+1)= err([P;Pf] ,[Pf;Pf]);

Error(end+1)= err([P,P] ,[Pf,Pf]);
Error(end+1)= err([Pf,P] ,[Pf,Pf]);
Error(end+1)= err([P,Pf] ,[Pf,Pf]);

Error(end+1)= err(cat(3,P,P,P) ,cat(3,Pf,Pf,Pf));
Error(end+1)= err(cat(3,Pf,P) ,cat(3,Pf,Pf));
Error(end+1)= err(cat(3,P,Pf) ,cat(3,Pf,Pf));

Error(end+1)= err(cat(4,P,Pf) ,cat(4,Pf,Pf));
Error(end+1)= err(cat(5,P,Pf) ,cat(5,Pf,Pf));

%%Test of spfun

 f=@(x) cos(x).^2;

Error(end+1)= err( spfun(f,P) ,    reshape(full(spfun(f,Pf(:))) ,size(Pf)) );

%%Test of subsindex

   idx=1:3;
   Zf=rand(3);

Error(end+1)= err( Zf(ndSparse(idx)) , Zf(idx) );

%%Test of subsref

Error(end+1)= err( P(P<.5) ,  Pf(Pf<.5)   ); %logical indexing
Error(end+1)= err( Pf(P<.5) ,  Pf(Pf<.5)   );
Error(end+1)= err( P(Pf<.5) ,  Pf(Pf<.5)   );

Error(end+1)= err( P(:) ,  Pf(:)   );  %linear indexing
Error(end+1)= err( P(1) ,  Pf(1)   );
Error(end+1)= err( P(1:4) ,  Pf(1:4)   );
Error(end+1)= err( P((1:4).') ,  Pf((1:4).')   );
Error(end+1)= err( Vc(1:3) ,  Vcf(1:3)   );
Error(end+1)= err( Vr(1:3) ,  Vrf(1:3)   );

Error(end+1)= err( P(Vc(1:3)) ,  Pf(Vcf(1:3))   ); %indexing vectors test different shaping rules
Error(end+1)= err( Pf(Vc(1:3)) ,  Pf(Vcf(1:3))   );
Error(end+1)= err( P(Vcf(1:3)) ,  Pf(Vcf(1:3))   );
Error(end+1)= err( Pf(Vcf(1:3)) ,  Pf(Vcf(1:3))   );

Error(end+1)= err( P(2,1,2,2) ,  Pf(2,1,2,2)   ); %subscript indexing
Error(end+1)= err( P(2,:,2,2) ,  Pf(2,:,2,2)   );
Error(end+1)= err( P(:,1,:,2) ,  Pf(:,1,:,2)   );
Error(end+1)= err( P(:,2,2,2) ,  Pf(:,2,2,2)   );
Error(end+1)= err( P(1,2,2,:) ,  Pf(1,2,2,:)   );
Error(end+1)= err( P(:,:,:,2) ,  Pf(:,:,:,2)   );

Error(end+1)= err( P(2,1,2) ,  Pf(2,1,2)   ); %truncated subscript indexing
Error(end+1)= err( P(2,:,2) ,  Pf(2,:,2)   );
Error(end+1)= err( P(:,1,:) ,  Pf(:,1,:)   );
Error(end+1)= err( P(:,2,2) ,  Pf(:,2,2)   );

            lidx=logical([1 0]);

Error(end+1)= err( P(lidx,lidx,1:2) ,  Pf(lidx,lidx,1:2)   ); %combine all types of indexing
Error(end+1)= err( P(lidx,lidx,:) ,  Pf(lidx,lidx,:)   );
Error(end+1)= err( P(lidx,:,lidx) ,  Pf(lidx,:,lidx)   );

%%Test of subsasgn

        Z=P;
        Zf=Pf;

        Z(Z<.5)=6;   Zf(Zf<.5)=6;

Error(end+1)= err(  Z, Zf); %logical indexing

        Z(1)=7;   Zf(1)=7;

Error(end+1)= err(  Z, Zf); %scalar indexing

        Z(Zf<.5)=13; Zf(Zf<.5)=13;

Error(end+1)= err( Z ,  Zf   );

           Z(:)=999; Zf(:)=999;

Error(end+1)= err(  Z, Zf    );

           Z(1:4)=88;  Zf(1:4)=88;

Error(end+1)= err( Z ,  Zf   );

          Z((1:4).')=77;  Zf((1:4).')=77;

Error(end+1)= err(Z,Zf);

          d=rand;
          Z(2,1,2,2)=d;   Zf(2,1,2,2)=d;

Error(end+1)= err(Z,Zf); %subscript indexing

           d=rand;
          Z(2,:,2,2)=d;  Zf(2,:,2,2)=d;

Error(end+1)= err(Z,Zf);

          d=rand;
          Z(:,2,2,2)=d;  Zf(:,2,2,2)=d;

Error(end+1)= err(Z,Zf);

          d=rand;
          Z(:,:,:,2)=d;  Zf(:,:,:,2)=d;

Error(end+1)= err(Z,Zf);

           mm=size(Z,1)+3;
           nn=size(Z,2)+3;

          Z(mm,nn,:,:)=5;  Zf(mm,nn,:,:)=5; %matrix expansion test

Error(end+1)= err(Z,Zf);

          Z(:,1:2:end,:,:)=[];  Zf(:,1:2:end,:,:)=[]; %null assignment test

Error(end+1)= err(Z,Zf);

           Z=P; Zf=Pf;
           Z(:,mod(1:2:end,2)==1,:,:)=[];  %null assignment test logical indexing
           Zf(:,mod(1:2:end,2)==1,:,:)=[];

Error(end+1)= err(Z,Zf);

      Z=P; Zf=Pf;
      Z(:,:,:,:,1)=0;  Zf(:,:,:,:,1)=0; %matrix expansion with n-1 colons
      Z(:,:,:,:,1)=[];  Zf(:,:,:,:,1)=[]; %null assignment with n-1 colons

Error(end+1)= err(Z,Zf);

           Z=P; Zf=Pf;

           d=rand(size(Zf(:,:,1)));

           Z(:,:,1)=d;  Zf(:,:,1)=d; %nonscalar assignment

Error(end+1)= err( Z , Zf   );

            idx={':'};

            Z=P; Zf=Pf;
            d=rand(size(Zf(idx{:})));

            Z(idx{:})=d;  Zf(idx{:})=d;%nonscalar assignment

Error(end+1)= err(Z,Zf);

            lidx=logical([1 0]);

            idx={lidx,lidx,1:2};

            Z=P; Zf=Pf;
            d=rand(size(Zf(idx{:})));

            Z(idx{:})=d;  Zf(idx{:})=d;%combine all types of indexing

Error(end+1)= err( Z , Zf   );

%%Test of all(), any(), mean(), max/min

      Z=P>.5; Zf=Pf>.5;

      Z(:,1,1,1)=0; Zf(:,1,1,1)=0;

      Args={ {},{1},{2},{3},{4},{5} };
      for jj=1:length(Args)

          args=Args{jj};

Error(end+1)= err( all(Z,args{:})  , all(Zf,args{:}) );

Error(end+1)= err( any(Z,args{:})  , any(Zf,args{:}) );

Error(end+1)= err( mean(Z,args{:})  , mean(Zf,args{:}) );

Error(end+1)= err( all(P,args{:})  , all(Pf,args{:}) );

Error(end+1)= err( any(P,args{:})  , any(Pf,args{:}) );

Error(end+1)= err( mean(P,args{:})  , mean(Pf,args{:}) );
      end

        Args={ {1},{2},{3},{4},{5} };

      for jj=1:length(Args)

          args=Args{jj};

          [Z,idx]=max(P,[],args{:});
          [Zf,idxf]=max(Pf,[],args{:});

Error(end+1)= err( Z ,Zf );
Error(end+1)= err( idx ,idxf );

      end

Error(end+1)= err( max(P,Q) , max(Pf,Qf) );
Error(end+1)= err( max(P,Qf) , max(Pf,Qf) );
Error(end+1)= err( max(Pf,Q) , max(Pf,Qf) );

      for jj=1:length(Args)

          args=Args{jj};

          [Z,idx]=min(P,[],args{:});
          [Zf,idxf]=min(Pf,[],args{:});

Error(end+1)= err( Z ,Zf );
Error(end+1)= err( idx ,idxf );

      end

Error(end+1)= err( min(P,Q) , min(Pf,Qf) );
Error(end+1)= err( min(P,Qf) , min(Pf,Qf) );
Error(end+1)= err( min(Pf,Q) , min(Pf,Qf) );

       %%%%%%2D cases%%%%%

      Z=B>.5; Zf=Bf>.5;

      Z(:,1,1,1)=0; Zf(:,1,1,1)=0;

      Args={ {},{1},{2},{3},{4},{5} };
      for jj=1:length(Args)

          args=Args{jj};

Error(end+1)= err( all(Z,args{:})  , all(Zf,args{:}) );

Error(end+1)= err( any(Z,args{:})  , any(Zf,args{:}) );

Error(end+1)= err( mean(Z,args{:})  , mean(Zf,args{:}) );

      end

        Args={ {1},{2},{3},{4},{5} };

      for jj=1:length(Args)

          args=Args{jj};

          [Z,idx]=max(B,[],args{:});
          [Zf,idxf]=max(Bf,[],args{:});

Error(end+1)= err( Z ,Zf );
Error(end+1)= err( idx ,idxf );

      end

Error(end+1)= err( max(B,C) , max(Bf,Cf) );
Error(end+1)= err( max(B,Cf) , max(Bf,Cf) );
Error(end+1)= err( max(Bf,C) , max(Bf,Cf) );

      for jj=1:length(Args)

          args=Args{jj};

          [Z,idx]=min(B,[],args{:});
          [Zf,idxf]=min(Bf,[],args{:});

Error(end+1)= err( Z ,Zf );
Error(end+1)= err( idx ,idxf );

      end

Error(end+1)= err( min(B,C) , min(Bf,Cf) );
Error(end+1)= err( min(B,Cf) , min(Bf,Cf) );
Error(end+1)= err( min(Bf,C) , min(Bf,Cf) );

%Test of numel
Error(end+1)= err( numel(P) , numel(Pf) );

%Test of repmat, circshift

       N=ndims(Pf)+1;
       z=ones(1,N);

       for kk=0:N

           idx=nchoosek(1:N,kk);

           for jj=1:size(idx,1)

             arg2=z;
             arg2(idx(jj,:))=2;

Error(end+1)= err( repmat(P,arg2) , repmat(Pf,arg2) );
Error(end+1)= err( repmat(P,arg2-1) , repmat(Pf,arg2-1) );
Error(end+1)= err( circshift(P,arg2) , circshift(Pf,arg2) );
Error(end+1)= err( circshift(P,arg2-1) , circshift(Pf,arg2-1) );
Error(end+1)= err( circshift(A,arg2) , circshift(Af,arg2) );
Error(end+1)= err( circshift(A,arg2-1) , circshift(Af,arg2-1) );

           end
       end

              Z=P*0; Zf=full(Z);

Error(end+1)= err( repmat(Z,arg2) , repmat(Zf,arg2) );
Error(end+1)= err( circshift(Z,arg2) , circshift(Zf,arg2) );
Error(end+1)= err( repmat(Z,arg2-1) , repmat(Zf,arg2-1) );
Error(end+1)= err( circshift(Z,arg2-1) , circshift(Zf,arg2-1) );

%Test of squeeze, shiftdim

     N=ndims(Pf);
     z=ones(1,2*N); z(2:2:end)=size(P);
     Z=reshape(P,[1 1 z]); %add some singleton dimensions
     Zf=full(Z);

Error(end+1)= err( squeeze(Z) , squeeze(Zf) );

    [Z,n]=shiftdim(Z); [Zf,nf]=shiftdim(Zf);

Error(end+1)= err( Z , Zf);
Error(end+1)= err( n , nf);

Error(end+1)= err( shiftdim(Z,3) , shiftdim(Zf,3));
Error(end+1)= err( shiftdim(Z,-3) , shiftdim(Zf,-3));

%Test of bsxfun

     funcs={@plus,@minus,@times,@rdivide,@ldivide,@power,...
            @max,@min,@rem,@mod,@atan2,@hypot,@(a,b) a.^2-b};

     lfuncs={@eq,@ne,@lt,@le,@gt,@ge,@and,@or,@xor};

     HH=P;
     for qq=1:2

     %test non-logical funcs
     H=HH; Hf=full(H);
     Z=mean(H,1); Z=mean(Z,3);   Zf=full(Z);

     for kk=1:2
        for ii=1:length(funcs)

          fun=funcs{ii};

Error(end+1)= err( bsxfun(fun,Z,H) ,     bsxfun(fun,Zf,Hf)  );
Error(end+1)= err( bsxfun(fun,Z,Hf) ,     bsxfun(fun,Zf,Hf)  );
Error(end+1)= err( bsxfun(fun,Zf,H) ,     bsxfun(fun,Zf,Hf)  );
Error(end+1)= err( bsxfun(fun,three,H) ,     bsxfun(fun,three,Hf)  );
Error(end+1)= err( bsxfun(fun,Zf,three) ,     bsxfun(fun,Zf,three)  );

       end

      Z=mean(H,2); Zf=full(Z);

      end

      %test logical lfuncs
      H=(HH<0.5); Hf=full(H);
      Z=mean(H,1); Z=mean(Z,3);
      Z=(Z>0.5);  Zf=full(Z);

      onebit=(rand>=0.5);

      for kk=1:2
       for ii=1:length(lfuncs)

          fun=lfuncs{ii};

Error(end+1)= err( bsxfun(fun,Z,H) ,     bsxfun(fun,Zf,Hf)  );
Error(end+1)= err( bsxfun(fun,Z,Hf) ,     bsxfun(fun,Zf,Hf)  );
Error(end+1)= err( bsxfun(fun,Zf,H) ,     bsxfun(fun,Zf,Hf)  );
Error(end+1)= err( bsxfun(fun,onebit,H) ,     bsxfun(fun,onebit,Hf)  );
Error(end+1)= err( bsxfun(fun,Zf,onebit) ,     bsxfun(fun,Zf,onebit)  );

       end

      Z=mean(H,2);
      Z=(Z>0.5); Zf=full(Z);

      end

      HH=repmat(P,[1,1,1,0]);

     end

%Test of ndSparse.build, nzmax, nonzeros

      nzm=10;
      Z=ndSparse.build([1 1 1; 2 2 2; 3 3 3; 4 4 4], 1:4,[4 4 6],nzm);
      Zf=zeros(4,4,6); for ii=1:4, Zf(ii,ii,ii)= ii; end

Error(end+1)= err( Z , Zf  );
Error(end+1)= err( nzmax(Z) , nzm );
Error(end+1)= err( nonzeros(Z) , nonzeros(Zf) );

      nzm=10;
      Z=ndSparse.build([1 1 1; 2 2 2; 3 3 3; 4 4 4], 5,[4 4 6],nzm);
      Zf=zeros(4,4,6); for ii=1:4, Zf(ii,ii,ii)= 5; end

Error(end+1)= err( Z , Zf  );
Error(end+1)= err( nzmax(Z) , nzm );
Error(end+1)= err( nonzeros(Z) , nonzeros(Zf) );

       Z=ndSparse.build([4 4 6]);
       Zf=zeros(4,4,6);

Error(end+1)= err( Z , Zf  );
Error(end+1)= err( ndSparse.build([],[],[4 4 6]) , Zf  );
Error(end+1)= err( nzmax(Z) , 1 );
Error(end+1)= err( nonzeros(Z) , nonzeros(Zf) );

%Test of ndSparse.spalloc

      nzm=10;
      Z=ndSparse.spalloc([3,5,3],nzm);
      Zf=full(Z);

Error(end+1)= err( nzmax(Z) , nzm );
Error(end+1)= err( Z , Zf );

%Test of ndSparse.accumarray

         args={[1 1 1; 2 2 2; 3 3 3;2 2 2], [5,4,3,2]};
         Z=ndSparse.accumarray(args{:});
         Zf=accumarray(args{:});

Error(end+1)= err( Z , Zf );

         args={[1 1 1; 2 2 2; 3 3 3;2 2 2], [5,4,3,2],[4 4 4]};
         Z=ndSparse.accumarray(args{:});
         Zf=accumarray(args{:});

Error(end+1)= err( Z , Zf );

         args={[1;2;3;2], [5,4,3,2]};
         Z=ndSparse.accumarray(args{:});
         Zf=accumarray(args{:});

Error(end+1)= err( Z , Zf );

         args={[1;2;3;2], [5,4,3,2],[4,1]};
         Z=ndSparse.accumarray(args{:});
         Zf=accumarray(args{:});

Error(end+1)= err( Z , Zf );

         args={[1;2;3;2], [5,4,3,2],[4,1],@prod};
         Z=ndSparse.accumarray(args{:});
         Zf=accumarray(args{:});

Error(end+1)= err( Z , Zf );

%Test of spones

          Z=ndSparse.build([1,1,1], 5,[3,5,3]);
          Zf=full(Z); Zf(~~Zf)=1;

Error(end+1)= err( spones(Z) , Zf );

%Test of length

Error(end+1)= err( length(P) , length(Pf) );

%Test of triu,triul

Error(end+1)= err( triu(A) , triu(Af) );
Error(end+1)= err( triu(A,1) , triu(Af,1) );
Error(end+1)= err( triu(A,-1) , triu(Af,-1) );

Error(end+1)= err( tril(A) , tril(Af) );
Error(end+1)= err( tril(A,1) , tril(Af,1) );
Error(end+1)= err( tril(A,-1) , tril(Af,-1) );

Error(end+1)= err( triu(S) , triu(Sf) );
Error(end+1)= err( triu(S,1) , triu(Sf,1) );
Error(end+1)= err( triu(S,-1) , triu(Sf,-1) );

Error(end+1)= err( tril(S) , tril(Sf) );
Error(end+1)= err( tril(S,1) , tril(Sf,1) );
Error(end+1)= err( tril(S,-1) , tril(Sf,-1) );

%Test of flipdim

Error(end+1)= err( flipdim(P,1) , flipdim(Pf,1) );
Error(end+1)= err( flipdim(P,2) , flipdim(Pf,2) );
Error(end+1)= err( flipdim(P,3) , flipdim(Pf,3) );

%Test of  fliplr

   Z=P(:,:,:,1); Zf=full(Z);   for ii=1:size(Zf,3), Zf(:,:,ii)=fliplr( Zf(:,:,ii) ); end

Error(end+1)= err( fliplr(Z) ,  Zf );

%Test of flipud

   Z=P(:,:,:,1);  Zf=full(Z);    for ii=1:size(Zf,3), Zf(:,:,ii)=flipud( Zf(:,:,ii) ); end

Error(end+1)= err( flipud(Z) ,  Zf );

%Test of rot90

  Z=P(:,:,:,1);  Zf=full(Z);    for ii=1:size(Zf,3), Zf(:,:,ii)=rot90( Zf(:,:,ii) ); end

Error(end+1)= err( rot90(Z) ,  Zf );

             for kk=-5:5

   Z=P(:,:,:,1);  Zf=full(Z);    for ii=1:size(Zf,3), Zf(:,:,ii)=rot90( Zf(:,:,ii) ,kk); end

Error(end+1)= err( rot90(Z,kk) , Zf);

             end

%Test of convn

            args={{},{'full'},{'same'},{'valid'}};
            Zs=sparse([0;0;1;2]); Zf=full(Zs);

            for ii=1:length(args)

Error(end+1)= err( convn(P,P,args{ii}{:}) , convn(Pf,Pf,args{ii}{:}) );
Error(end+1)= err( convn(P,A,args{ii}{:}) , convn(Pf,Af,args{ii}{:}) );

Error(end+1)= err( convn(Pf,P,args{ii}{:}) , convn(Pf,Pf,args{ii}{:}) );
Error(end+1)= err( convn(Pf,A,args{ii}{:}) , convn(Pf,Af,args{ii}{:}) );

Error(end+1)= err( convn(P,Pf,args{ii}{:}) , convn(Pf,Pf,args{ii}{:}) );
Error(end+1)= err( convn(P,Af,args{ii}{:}) , convn(Pf,Af,args{ii}{:}) );

Error(end+1)= err( convn(P,Zs,args{ii}{:}) , convn(Pf,Zf,args{ii}{:}) );
Error(end+1)= err( convn(Zs,P,args{ii}{:}) , convn(Zf,Pf,args{ii}{:}) );

Error(end+1)= err( convn(P,Zf,args{ii}{:}) , convn(Pf,Zf,args{ii}{:}) );
Error(end+1)= err( convn(Zf,P,args{ii}{:}) , convn(Zf,Pf,args{ii}{:}) );

            end

            Hf={rand(2,1),rand(1,3)};
            H=Hf;
            H{1}=ndSparse(H{1});

            Zf=diag([0 0 0 0 0 1 1]);
            Zs=sparse(Zf);

           for ii=1:length(args)

Error(end+1)= err( convn(H{:},A,args{ii}{:}) , conv2(Hf{:},Af,args{ii}{:}) );

Error(end+1)= err( convn(H{:},Zs,args{ii}{:}) , conv2(Hf{:},Zf,args{ii}{:}) );

Error(end+1)= err( convn(H{:},Zf,args{ii}{:}) , conv2(Hf{:},Zf,args{ii}{:}) );

           end

%%Test of allml(), anyml(), meanml(), maxml/minml, summl, catml

      Z=P>.5; Zf=Pf>.5;

      Z(:,1,1,1)=0; Zf(:,1,1,1)=0;

      Args={ {},{1},{2},{3},{4},{5} };
      for jj=1:length(Args)

          args=Args{jj};

Error(end+1)= err( allml(Z,args{:})  , all(Zf,args{:}) );

Error(end+1)= err( anyml(Z,args{:})  , any(Zf,args{:}) );

Error(end+1)= err( meanml(Z,args{:})  , mean(Zf,args{:}) );

Error(end+1)= err( allml(P,args{:})  , all(Pf,args{:}) );

Error(end+1)= err( anyml(P,args{:})  , any(Pf,args{:}) );

Error(end+1)= err( meanml(P,args{:})  , mean(Pf,args{:}) );
      end

        Args={ {1},{2},{3},{4},{5} };

      for jj=1:length(Args)

          args=Args{jj};

          [Z,idx]=maxml(P,[],args{:});
          [Zf,idxf]=max(Pf,[],args{:});

Error(end+1)= err( Z ,Zf );
Error(end+1)= err( idx ,idxf );

      end

Error(end+1)= err( maxml(P,Q) , max(Pf,Qf) );
Error(end+1)= err( maxml(P,Qf) , max(Pf,Qf) );
Error(end+1)= err( maxml(Pf,Q) , max(Pf,Qf) );

      for jj=1:length(Args)

          args=Args{jj};

          [Z,idx]=minml(P,[],args{:});
          [Zf,idxf]=min(Pf,[],args{:});

Error(end+1)= err( Z ,Zf );
Error(end+1)= err( idx ,idxf );

      end

Error(end+1)= err( minml(P,Q) , min(Pf,Qf) );
Error(end+1)= err( minml(P,Qf) , min(Pf,Qf) );
Error(end+1)= err( minml(Pf,Q) , min(Pf,Qf) );

       %%%%%%2D cases%%%%%

      Z=B>.5; Zf=Bf>.5;

      Z(:,1,1,1)=0; Zf(:,1,1,1)=0;

      Args={ {},{1},{2},{3},{4},{5} };
      for jj=1:length(Args)

          args=Args{jj};

Error(end+1)= err( allml(Z,args{:})  , all(Zf,args{:}) );

Error(end+1)= err( anyml(Z,args{:})  , any(Zf,args{:}) );

Error(end+1)= err( meanml(Z,args{:})  , mean(Zf,args{:}) );

      end

        Args={ {1},{2},{3},{4},{5} };

      for jj=1:length(Args)

          args=Args{jj};

          [Z,idx]=maxml(B,[],args{:});
          [Zf,idxf]=max(Bf,[],args{:});

Error(end+1)= err( Z ,Zf );
Error(end+1)= err( idx ,idxf );

      end

Error(end+1)= err( maxml(B,C) , max(Bf,Cf) );
Error(end+1)= err( maxml(B,Cf) , max(Bf,Cf) );
Error(end+1)= err( maxml(Bf,C) , max(Bf,Cf) );

      for jj=1:length(Args)

          args=Args{jj};

          [Z,idx]=minml(B,[],args{:});
          [Zf,idxf]=min(Bf,[],args{:});

Error(end+1)= err( Z ,Zf );
Error(end+1)= err( idx ,idxf );

      end

Error(end+1)= err( minml(B,C) , min(Bf,Cf) );
Error(end+1)= err( minml(B,Cf) , min(Bf,Cf) );
Error(end+1)= err( minml(Bf,C) , min(Bf,Cf) );

Error(end+1)= err( summl(P,1)  , sum(Pf,1) );
Error(end+1)= err( summl(Q,2)  , sum(Qf,2) );
Error(end+1)= err( summl(P)    , sum(Pf) );
Error(end+1)= err( summl(P,'native')    , sum(Pf,'native') );
Error(end+1)= err( summl(P,3,'double')    , sum(Pf,3,'double') );
Error(end+1)= err( summl(P,4)    , sum(Pf,4) );
Error(end+1)= err( summl(P,5)    , sum(Pf,5) );

Error(end+1)= err(catml(3,P,P,P) ,cat(3,Pf,Pf,Pf));
Error(end+1)= err(catml(3,Pf,P) ,cat(3,Pf,Pf));
Error(end+1)= err(catml(3,P,Pf) ,cat(3,Pf,Pf));

Error(end+1)= err(catml(4,P,Pf) ,cat(4,Pf,Pf));
Error(end+1)= err(catml(5,P,Pf) ,cat(5,Pf,Pf));

       N=ndims(Pf)+1;
       z=ones(1,N);

       for kk=0:N

           idx=nchoosek(1:N,kk);

           for jj=1:size(idx,1)

             arg2=z;
             arg2(idx(jj,:))=2;

Error(end+1)= err( circshiftml(P,arg2) , circshift(Pf,arg2) );
Error(end+1)= err( circshiftml(P,arg2-1) , circshift(Pf,arg2-1) );
Error(end+1)= err( circshiftml(A,arg2) , circshift(Af,arg2) );
Error(end+1)= err( circshiftml(A,arg2-1) , circshift(Af,arg2-1) );

           end
       end

              Z=P*0; Zf=full(Z);

Error(end+1)= err( circshiftml(Z,arg2) , circshift(Zf,arg2) );
Error(end+1)= err( circshiftml(Z,arg2-1) , circshift(Zf,arg2-1) );

%%%%%%%%%%%%%%%%%%%%%%%END OF TESTS%%%%%%%%%%%%%%%%%%%%%%%%%%

MAX_ERROR=max(Error);

if any(~isfinite(Error)), warning 'There were improper Error values'; keyboard; end

disp(['Maximum observed error was   ' num2str(MAX_ERROR) ' percent.'])

if nargout, varargout{1}=Error; end

function errval=DiscrepancyMeasure(X,Y,TOL,CHECKTYPES)

  if Discrepancy(0,Y)
    errval=Discrepancy(X,Y)/Discrepancy(0,Y)*100; %normalize
  else
    errval=Discrepancy(X,Y);
  end

  isndSparse=@(c) ~isempty(strfind(class(c),'ndSparse'));

  if CHECKTYPES
    if ~isndSparse(X),
       warning(['X is not ndSparse class, but rather class ' class(X)])
    end
  end

  if errval>TOL || ~isfinite(errval),
      disp ' '; disp 'Discrepancy detected'
      errval,
      x=full(X); y=full(Y);
      keyboard;
  end

function errval=Discrepancy(X,Y)
%Primary error measurement function

  fin=@(a) reshape( a(isfinite(a)),[],1);
  nonfin=@(a) reshape(  a(~isfinite(a))  ,[],1);

  x=full(X); y=full(Y);

  if ( isequal(x,y));
     errval=0; return
  elseif xor(isempty(x),isempty(y))
      errval=1; return
  end

  errval= norm( fin(x-y) , inf)+...
       ~isequalwithequalnans(nonfin(x),nonfin(y))*...
       ~isempty([nonfin(x);nonfin(y)])+ ~isequal(size(X),size(Y));

function out=srand(varargin)

   out=rand(varargin{:})-.5;


function [indpeak twfPer indtrough] = peakfinder(twf,fmin,fmax)
% [indpeak twfPer indtrough] = peakfinder(twf,<fmin>,<fmax>)
%
% Finds local peaks in a near-periodic waveform. This fails if the
% peaks are closer than 1/2 period. twfPer is the period of twf in
% samples. If the 1st or last peak are less than 90% of the mean of
% the rest of the peaks, they are exluded.
%
% fmin,fmax are constraints on the fundamental frequency and are
% given in units of items per time point (NOT IN Hz!).
%
% $Id: peakfinder.m,v 1.9 2010/05/18 19:31:44 greve Exp $

indpeak = [];

if(nargin < 1 | nargin > 3)
  fprintf('[indpeak twfPer indtrough] = peakfinder(twf,<fmin>,<fmax>)\n');
  return;
end

Ntp = length(twf);
nn = 1:Ntp;

% detrend - necessary?
X = fast_polytrendmtx(1,Ntp,1,3);
%twf = twf - X*(inv(X'*X)*(X'*twf));

% Get major period of waveform
[fftaxis, deltafreq] = fast_fftaxis(Ntp,1);
nfft = length(fftaxis);
nnfft = 1:nfft;
twffft = abs(fft(twf-mean(twf)));
if(exist('fmin','var'))
  indok = find(fftaxis >= fmin & fftaxis <= fmax);
else
  indok = [1:length(fftaxis)];
end
[tmp k] = max(twffft(indok));
twfFreq = fftaxis(indok(k));
twfPer = 1/twfFreq;
twfPerSamp      = round(twfPer);
twfHalfPerSamp  = round(twfPerSamp/2);
twfQuartPerSamp = round(twfPerSamp/4);

%plot(fftaxis,twffft(nnfft))
%keyboard

% Assume global peak is a local peak
[tmp k0] = max(twf);
%fprintf('global peak at %d %f\n',k0,k0/25);

% Look ahead, starting at global peak
indpeak = k0;
kprev = k0;
while(1)
  % Find next max by searhing over time starting at 1/2
  % period beyond the previous max and ending one period
  % later. This fails if the peaks are closer than 1/2
  % period.
  kstart = kprev + twfHalfPerSamp;
  k = kstart + [0:twfPerSamp-1];
  indok = find(k < Ntp);
  if(length(indok) < twfQuartPerSamp) break; end
  k = k(indok);
  [tmp mmax] = max(twf(k));
  kmax = kstart + mmax - 1;
  indpeak = [indpeak kmax];
  kprev = kmax;
end

% Look behind (reverse and look ahead)
twfrev = flipud(twf(:));
k0rev = Ntp - k0 + 1; % DONT = max(twfrev);
indpeakrev = []; % dont include k0rev here
kprev = k0rev;
while(1)
  kstart = kprev + twfHalfPerSamp;
  k = kstart + [0:twfPerSamp-1];
  indok = find(k < Ntp);
  if(length(indok) < twfQuartPerSamp) break; end
  k = k(indok);
  [tmp mmax] = max(twfrev(k));
  kmax = kstart + mmax - 1;
  indpeakrev = [indpeakrev kmax];
  kprev = kmax;
end

% Convert reversed indices to forard indices
indpeakrevfor = Ntp - indpeakrev + 1;
indpeak = sort([indpeak indpeakrevfor]);
npeaks = length(indpeak);

% Decide whether to eliminate the first peak
% Compute mean of closest 3 peaks
peakfirst = twf(indpeak(1));
indpm = [2:min(4,npeaks)];
peakmean = mean(twf(indpeak(indpm)));
% Must be greater than 0.7 times this mean
if(peakfirst < .7*peakmean)  indpeak = indpeak(2:end); end

% Decide whether to eliminate the last peak
% Compute mean of closest 3 peaks
peaklast  = twf(indpeak(end));
indpm = [max(npeaks-3,1),max(npeaks-1,1)];
peakmean = mean(twf(indpeak(indpm)));
% Must be greater than 0.7 times this mean
if(peaklast  < .7*peakmean)  indpeak = indpeak(1:end-1); end

% Make sure they are unique (why not always?)
indpeak = unique(indpeak);

npeaks = length(indpeak);
indtrough = zeros(size(indpeak));
for nthpeak = 1:npeaks
  i1 = indpeak(nthpeak);
  if(nthpeak < npeaks)
    i2 = indpeak(nthpeak+1);
  else
    i2 = Ntp;
  end
  if(i2 > i1 + 1) i1 = i1 + 1; end
  [mmin imin] = min(twf(i1:i2));
  indtrough(nthpeak) = imin+i1-1;
end

if(0)
nn = 1:Ntp;
plot(nn,twf,nn(indpeak),twf(indpeak),'*',nn(indtrough),twf(indtrough),'o');
fprintf('Period %f\n',twfPerSamp);
keyboard
end

return;


% VISUALIZEMCMCMARGINALS
%
% This function accepts a list of sample lists, each from a different MCMC run.  It then visualizes
% the estimated marginals for each variable in V over the lifetime of the MCMC run.
%
% samples_list - a list of sample lists; each sample list is a m-by-n matrix where m is the
% number of samples and n is the number of variables in the state of the Markov chain
%
% V - an array of variables
% D - the dimensions of the variables in V
% F - a list of factors (used in computing likelihoods of each sample)
% window_size - size of the window over which to aggregate samples to compute the estimated
%               marginal at a given time
% ExactMarginals - the exact marginals of V (optional)
%
% Copyright (C) Daphne Koller, Stanford University, 2012

function VisualizeMCMCMarginals(samples_list, V, D, F, window_size, ExactMarginals, tname)

for i = 1:length(V)
    figure;
    v = V(i);
    d = D(i);
    title(['Marginal for Variable ', num2str(v)]);
    if exist('ExactMarginals') == 1, M = ExactMarginals(i); end;
    for j = 1:length(samples_list)
        samples_v = samples_list{j}(:, v);
        indicators_over_time = zeros(length(samples_v), d);
        for k = 1:length(samples_v)
            indicators_over_time(k, samples_v(k)) = 1;
        end

        % estimated_marginal = cumsum(indicators_over_time, 1);
        estimated_marginal = [];
        for k = 1:size(indicators_over_time, 2)
            estimated_marginal = [estimated_marginal, smooth(indicators_over_time(:, k), window_size)];
        end
        % Prune ends
        estimated_marginal = estimated_marginal(window_size/2:end - window_size/2, :);

        estimated_marginal = estimated_marginal ./ ...
            repmat(sum(estimated_marginal, 2), 1, size(estimated_marginal, 2));
        hold on;
        plot(estimated_marginal, '-', 'LineWidth', 2);
        title(['Est marginals for entry ' num2str(i) ' of samples for ' tname])
        if exist('M') == 1
            plot([1; size(estimated_marginal, 1)], [M.val; M.val], '--', 'LineWidth', 3);
        end
        set(gcf,'DefaultAxesColorOrder', rand(d, 3));
    end
end

% Visualize likelihood of sample at each time step
all_likelihoods = [];
for i = 1:length(samples_list)
    samples = samples_list{i};
    likelihoods = [];
    for j = 1:size(samples, 1)
        likelihoods = [likelihoods; LogProbOfJointAssignment(F, samples(j, :))];
    end
    all_likelihoods = [all_likelihoods, likelihoods];
end
figure;
title('Likelihoods')
plot(all_likelihoods, '-', 'LineWidth', 2);


function sr=comp_gabreassign(s,tgrad,fgrad,a);
%COMP_GABREASSIGN  Reassign time-frequency distribution.
%   Usage:  sr = comp_gabreassign(s,tgrad,fgrad,a);
%
%   `comp_gabreassign(s,tgrad,fgrad,a)` will reassign the values of the positive
%   time-frequency distribution *s* using the instantaneous time and frequency
%   *fgrad* and *ifdummy*. The lattice is determined by the time shift *a* and
%   the number of channels deduced from the size of *s*.
%
%   See also: gabreassign
%
%   References: aufl95

%   AUTHOR : Peter L. Søndergaard.
%   TESTING: OK
%   REFERENCE: OK

[M,N,W]=size(s);
L=N*a;
b=L/M;

freqpos=fftindex(M);
tgrad=bsxfun(@plus,tgrad/b,freqpos);

timepos=fftindex(N);
fgrad=bsxfun(@plus,fgrad/a,timepos.');

tgrad=round(tgrad);
fgrad=round(fgrad);

tgrad=mod(tgrad,M);
fgrad=mod(fgrad,N);

sr=zeros(M,N,W,assert_classname(s,tgrad,fgrad));

fgrad=fgrad+1;
tgrad=tgrad+1;

for w=1:W
    for ii=1:M
        for jj=1:N
            sr(tgrad(ii,jj),fgrad(ii,jj),w) = sr(tgrad(ii,jj),fgrad(ii,jj),w)+s(ii,jj,w);
        end;
    end;
end;


function y = perform_curvelet_transform(x,options)

% perform_curvelet_transform - a wrapper to curvlab
%
%     M = perform_curvelet_transform(MW,options);
%
%   Forward and backward curvelet transform
%   You must provide options.n (width of the image).
%
%   Visit www.curvelab.org for the full code.

options.null = 0;
finest = getoptions(options, 'finest',1)  ; % =1(curv)  =2(wav)
nbscales = getoptions(options, 'nbscales', 5); % log2(size(M,1))-2;
nbangles_coarse = getoptions(options, 'nbangles_coarse', 16);
is_real = getoptions(options, 'is_real', 0);
n = getoptions(options, 'n', 1,1);

if not(iscell(x))
    % fwd transform
    y = fdct_wrapping(x, is_real, finest, nbscales, nbangles_coarse);
else
    y = real( ifdct_wrapping(x, is_real, n,n ) );
end

%%

function C = fdct_wrapping(x, is_real, finest, nbscales, nbangles_coarse)

% fdct_wrapping.m - Fast Discrete Curvelet Transform via wedge wrapping - Version 1.0
%
% Inputs
%   x           M-by-N matrix
%
% Optional Inputs
%   is_real     Type of the transform
%                   0: complex-valued curvelets
%                   1: real-valued curvelets
%               [default set to 0]
%   finest      Chooses one of two possibilities for the coefficients at the
%               finest level:
%                   1: curvelets
%                   2: wavelets
%               [default set to 2]
%   nbscales    number of scales including the coarsest wavelet level
%               [default set to ceil(log2(min(M,N)) - 3)]
%   nbangles_coarse
%               number of angles at the 2nd coarsest level, minimum 8,
%               must be a multiple of 4. [default set to 16]
%
% Outputs
%   C           Cell array of curvelet coefficients.
%               C{j}{l}(k1,k2) is the coefficient at
%                   - scale j: integer, from finest to coarsest scale,
%                   - angle l: integer, starts at the top-left corner and
%                   increases clockwise,
%                   - position k1,k2: both integers, size varies with j
%                   and l.
%               If is_real is 1, there are two types of curvelets,
%               'cosine' and 'sine'. For a given scale j, the 'cosine'
%               coefficients are stored in the first two quadrants (low
%               values of l), the 'sine' coefficients in the last two
%               quadrants (high values of l).
%
% See also ifdct_wrapping.m, fdct_wrapping_param.m
%
% By Laurent Demanet, 2004

X = fftshift(fft2(ifftshift(x)))/sqrt(prod(size(x)));
[N1,N2] = size(X);
if nargin < 2, is_real = 0; end;
if nargin < 3, finest = 2; end;
if nargin < 4, nbscales = ceil(log2(min(N1,N2)) - 3); end;
if nargin < 5, nbangles_coarse = 16; end;

% Initialization: data structure
nbangles = [1, nbangles_coarse .* 2.^(ceil((nbscales-(nbscales:-1:2))/2))];
if finest == 2, nbangles(nbscales) = 1; end;
C = cell(1,nbscales);
for j = 1:nbscales
    C{j} = cell(1,nbangles(j));
end;

% Loop: pyramidal scale decomposition
M1 = N1/3;
M2 = N2/3;
if finest == 1,

    % Initialization: smooth periodic extension of high frequencies
    bigN1 = 2*floor(2*M1)+1;
    bigN2 = 2*floor(2*M2)+1;
    equiv_index_1 = 1+mod(floor(N1/2)-floor(2*M1)+(1:bigN1)-1,N1);
    equiv_index_2 = 1+mod(floor(N2/2)-floor(2*M2)+(1:bigN2)-1,N2);
    X = X(equiv_index_1,equiv_index_2);
        % Invariant: equiv_index_1(floor(2*M1)+1) == (N1 + 2 - mod(N1,2))/2
        % is the center in frequency. Same for M2, N2.
    window_length_1 = floor(2*M1) - floor(M1) - 1 - (mod(N1,3)==0);
    window_length_2 = floor(2*M2) - floor(M2) - 1 - (mod(N2,3)==0);
        % Invariant: floor(M1) + floor(2*M1) == N1 - (mod(M1,3)~=0)
        % Same for M2, N2.
    coord_1 = 0:(1/window_length_1):1;
    coord_2 = 0:(1/window_length_2):1;
    [wl_1,wr_1] = fdct_wrapping_window(coord_1);
    [wl_2,wr_2] = fdct_wrapping_window(coord_2);
    lowpass_1 = [wl_1, ones(1,2*floor(M1)+1), wr_1];
    if mod(N1,3)==0, lowpass_1 = [0, lowpass_1, 0]; end;
    lowpass_2 = [wl_2, ones(1,2*floor(M2)+1), wr_2];
    if mod(N2,3)==0, lowpass_2 = [0, lowpass_2, 0]; end;
    lowpass = lowpass_1'*lowpass_2;
    Xlow = X .* lowpass;

    scales = nbscales:-1:2;

else

    M1 = M1/2;
    M2 = M2/2;
    window_length_1 = floor(2*M1) - floor(M1) - 1;
    window_length_2 = floor(2*M2) - floor(M2) - 1;
    coord_1 = 0:(1/window_length_1):1;
    coord_2 = 0:(1/window_length_2):1;
    [wl_1,wr_1] = fdct_wrapping_window(coord_1);
    [wl_2,wr_2] = fdct_wrapping_window(coord_2);
    lowpass_1 = [wl_1, ones(1,2*floor(M1)+1), wr_1];
    lowpass_2 = [wl_2, ones(1,2*floor(M2)+1), wr_2];
    lowpass = lowpass_1'*lowpass_2;
    hipass = sqrt(1 - lowpass.^2);
    Xlow_index_1 = ((-floor(2*M1)):floor(2*M1)) + ceil((N1+1)/2);
    Xlow_index_2 = ((-floor(2*M2)):floor(2*M2)) + ceil((N2+1)/2);
    Xlow = X(Xlow_index_1, Xlow_index_2) .* lowpass;
    Xhi = X;
    Xhi(Xlow_index_1, Xlow_index_2) = Xhi(Xlow_index_1, Xlow_index_2) .* hipass;
    C{nbscales}{1} = fftshift(ifft2(ifftshift(Xhi)))*sqrt(prod(size(Xhi)));
    if is_real, C{nbscales}{1} = real(C{nbscales}{1}); end;

    scales = (nbscales-1):-1:2;

end;
for j = scales,

    M1 = M1/2;
    M2 = M2/2;
    window_length_1 = floor(2*M1) - floor(M1) - 1;
    window_length_2 = floor(2*M2) - floor(M2) - 1;
    coord_1 = 0:(1/window_length_1):1;
    coord_2 = 0:(1/window_length_2):1;
    [wl_1,wr_1] = fdct_wrapping_window(coord_1);
    [wl_2,wr_2] = fdct_wrapping_window(coord_2);
    lowpass_1 = [wl_1, ones(1,2*floor(M1)+1), wr_1];
    lowpass_2 = [wl_2, ones(1,2*floor(M2)+1), wr_2];
    lowpass = lowpass_1'*lowpass_2;
    hipass = sqrt(1 - lowpass.^2);
    Xhi = Xlow;                 % size is 2*floor(4*M1)+1 - by - 2*floor(4*M2)+1
    Xlow_index_1 = ((-floor(2*M1)):floor(2*M1)) + floor(4*M1) + 1;
    Xlow_index_2 = ((-floor(2*M2)):floor(2*M2)) + floor(4*M2) + 1;
    Xlow = Xlow(Xlow_index_1, Xlow_index_2);
    Xhi(Xlow_index_1, Xlow_index_2) = Xlow .* hipass;
    Xlow = Xlow .* lowpass;     % size is 2*floor(2*M1)+1 - by - 2*floor(2*M2)+1

    % Loop: angular decomposition
    l = 0;
    nbquadrants = 2 + 2*(~is_real);
    nbangles_perquad = nbangles(j)/4;
    for quadrant = 1:nbquadrants
        M_horiz = M2 * (mod(quadrant,2)==1) + M1 * (mod(quadrant,2)==0);
        M_vert = M1 * (mod(quadrant,2)==1) + M2 * (mod(quadrant,2)==0);
        if mod(nbangles_perquad,2),
            wedge_ticks_left = round((0:(1/(2*nbangles_perquad)):.5)*2*floor(4*M_horiz) + 1);
            wedge_ticks_right = 2*floor(4*M_horiz) + 2 - wedge_ticks_left;
            wedge_ticks = [wedge_ticks_left, wedge_ticks_right(end:-1:1)];
        else
            wedge_ticks_left = round((0:(1/(2*nbangles_perquad)):.5)*2*floor(4*M_horiz) + 1);
            wedge_ticks_right = 2*floor(4*M_horiz) + 2 - wedge_ticks_left;
            wedge_ticks = [wedge_ticks_left, wedge_ticks_right((end-1):-1:1)];
        end;
        wedge_endpoints = wedge_ticks(2:2:(end-1));         % integers
        wedge_midpoints = (wedge_endpoints(1:(end-1)) + wedge_endpoints(2:end))/2;
                % integers or half-integers

        % Left corner wedge
        l = l+1;
        first_wedge_endpoint_vert = round(2*floor(4*M_vert)/(2*nbangles_perquad) + 1);
        length_corner_wedge = floor(4*M_vert) - floor(M_vert) + ceil(first_wedge_endpoint_vert/4);
        Y_corner = 1:length_corner_wedge;
        [XX,YY] = meshgrid(1:(2*floor(4*M_horiz)+1),Y_corner);
        width_wedge = wedge_endpoints(2) + wedge_endpoints(1) - 1;
        slope_wedge = (floor(4*M_horiz) + 1 - wedge_endpoints(1))/floor(4*M_vert);
        left_line = round(2 - wedge_endpoints(1) + slope_wedge*(Y_corner - 1));
                                                            % integers
        [wrapped_data, wrapped_XX, wrapped_YY] = deal(zeros(length_corner_wedge,width_wedge));
        first_row = floor(4*M_vert)+2-ceil((length_corner_wedge+1)/2)+...
            mod(length_corner_wedge+1,2)*(quadrant-2 == mod(quadrant-2,2));
        first_col = floor(4*M_horiz)+2-ceil((width_wedge+1)/2)+...
            mod(width_wedge+1,2)*(quadrant-3 == mod(quadrant-3,2));
                % Coordinates of the top-left corner of the wedge wrapped
                % around the origin. Some subtleties when the wedge is
                % even-sized because of the forthcoming 90 degrees rotation
        for row = Y_corner
            cols = left_line(row) + mod((0:(width_wedge-1))-(left_line(row)-first_col),width_wedge);
            admissible_cols = round(1/2*(cols+1+abs(cols-1)));
            new_row = 1 + mod(row - first_row, length_corner_wedge);
            wrapped_data(new_row,:) = Xhi(row,admissible_cols) .* (cols > 0);
            wrapped_XX(new_row,:) = XX(row,admissible_cols);
            wrapped_YY(new_row,:) = YY(row,admissible_cols);
        end;
        slope_wedge_right = (floor(4*M_horiz)+1 - wedge_midpoints(1))/floor(4*M_vert);
        mid_line_right = wedge_midpoints(1) + slope_wedge_right*(wrapped_YY - 1);
                % not integers in general
        coord_right = 1/2 + floor(4*M_vert)/(wedge_endpoints(2) - wedge_endpoints(1)) * ...
            (wrapped_XX - mid_line_right)./(floor(4*M_vert)+1 - wrapped_YY);
        C2 = 1/(1/(2*(floor(4*M_horiz))/(wedge_endpoints(1) - 1) - 1) + 1/(2*(floor(4*M_vert))/(first_wedge_endpoint_vert - 1) - 1));
        C1 = C2 / (2*(floor(4*M_vert))/(first_wedge_endpoint_vert - 1) - 1);
        wrapped_XX((wrapped_XX - 1)/floor(4*M_horiz) + (wrapped_YY-1)/floor(4*M_vert) == 2) = ...
            wrapped_XX((wrapped_XX - 1)/floor(4*M_horiz) + (wrapped_YY-1)/floor(4*M_vert) == 2) + 1;
        coord_corner = C1 + C2 * ((wrapped_XX - 1)/(floor(4*M_horiz)) - (wrapped_YY - 1)/(floor(4*M_vert))) ./ ...
            (2-((wrapped_XX - 1)/(floor(4*M_horiz)) + (wrapped_YY - 1)/(floor(4*M_vert))));
        wl_left = fdct_wrapping_window(coord_corner);
        [wl_right,wr_right] = fdct_wrapping_window(coord_right);
        wrapped_data = wrapped_data .* (wl_left .* wr_right);

        switch is_real
            case 0
                wrapped_data = rot90(wrapped_data,-(quadrant-1));
                C{j}{l} = fftshift(ifft2(ifftshift(wrapped_data)))*sqrt(prod(size(wrapped_data)));
            case 1
                wrapped_data = rot90(wrapped_data,-(quadrant-1));
                x = fftshift(ifft2(ifftshift(wrapped_data)))*sqrt(prod(size(wrapped_data)));
                C{j}{l} = sqrt(2)*real(x);
                C{j}{l+nbangles(j)/2} = sqrt(2)*imag(x);
        end;

        % Regular wedges
        length_wedge = floor(4*M_vert) - floor(M_vert);
        Y = 1:length_wedge;
        first_row = floor(4*M_vert)+2-ceil((length_wedge+1)/2)+...
            mod(length_wedge+1,2)*(quadrant-2 == mod(quadrant-2,2));
        for subl = 2:(nbangles_perquad-1);
            l = l+1;
            width_wedge = wedge_endpoints(subl+1) - wedge_endpoints(subl-1) + 1;
            slope_wedge = ((floor(4*M_horiz)+1) - wedge_endpoints(subl))/floor(4*M_vert);
            left_line = round(wedge_endpoints(subl-1) + slope_wedge*(Y - 1));
            [wrapped_data, wrapped_XX, wrapped_YY] = deal(zeros(length_wedge,width_wedge));
            first_col = floor(4*M_horiz)+2-ceil((width_wedge+1)/2)+...
                mod(width_wedge+1,2)*(quadrant-3 == mod(quadrant-3,2));
            for row = Y
                cols = left_line(row) + mod((0:(width_wedge-1))-(left_line(row)-first_col),width_wedge);
                new_row = 1 + mod(row - first_row, length_wedge);
                wrapped_data(new_row,:) = Xhi(row,cols);
                wrapped_XX(new_row,:) = XX(row,cols);
                wrapped_YY(new_row,:) = YY(row,cols);
            end;
            slope_wedge_left = ((floor(4*M_horiz)+1) - wedge_midpoints(subl-1))/floor(4*M_vert);
            mid_line_left = wedge_midpoints(subl-1) + slope_wedge_left*(wrapped_YY - 1);
            coord_left = 1/2 + floor(4*M_vert)/(wedge_endpoints(subl) - wedge_endpoints(subl-1)) * ...
                (wrapped_XX - mid_line_left)./(floor(4*M_vert)+1 - wrapped_YY);
            slope_wedge_right = ((floor(4*M_horiz)+1) - wedge_midpoints(subl))/floor(4*M_vert);
            mid_line_right = wedge_midpoints(subl) + slope_wedge_right*(wrapped_YY - 1);
            coord_right = 1/2 + floor(4*M_vert)/(wedge_endpoints(subl+1) - wedge_endpoints(subl)) * ...
                (wrapped_XX - mid_line_right)./(floor(4*M_vert)+1 - wrapped_YY);
            wl_left = fdct_wrapping_window(coord_left);
            [wl_right,wr_right] = fdct_wrapping_window(coord_right);
            wrapped_data = wrapped_data .* (wl_left .* wr_right);
            switch is_real
                case 0
                    wrapped_data = rot90(wrapped_data,-(quadrant-1));
                    C{j}{l} = fftshift(ifft2(ifftshift(wrapped_data)))*sqrt(prod(size(wrapped_data)));
                case 1
                    wrapped_data = rot90(wrapped_data,-(quadrant-1));
                    x = fftshift(ifft2(ifftshift(wrapped_data)))*sqrt(prod(size(wrapped_data)));
                    C{j}{l} = sqrt(2)*real(x);
                    C{j}{l+nbangles(j)/2} = sqrt(2)*imag(x);
            end;
        end;

        % Right corner wedge
        l = l+1;
        width_wedge = 4*floor(4*M_horiz) + 3 - wedge_endpoints(end) - wedge_endpoints(end-1);
        slope_wedge = ((floor(4*M_horiz)+1) - wedge_endpoints(end))/floor(4*M_vert);
        left_line = round(wedge_endpoints(end-1) + slope_wedge*(Y_corner - 1));
        [wrapped_data, wrapped_XX, wrapped_YY] = deal(zeros(length_corner_wedge,width_wedge));
        first_row = floor(4*M_vert)+2-ceil((length_corner_wedge+1)/2)+...
            mod(length_corner_wedge+1,2)*(quadrant-2 == mod(quadrant-2,2));
        first_col = floor(4*M_horiz)+2-ceil((width_wedge+1)/2)+...
            mod(width_wedge+1,2)*(quadrant-3 == mod(quadrant-3,2));
        for row = Y_corner
            cols = left_line(row) + mod((0:(width_wedge-1))-(left_line(row)-first_col),width_wedge);
            admissible_cols = round(1/2*(cols+2*floor(4*M_horiz)+1-abs(cols-(2*floor(4*M_horiz)+1))));
            new_row = 1 + mod(row - first_row, length_corner_wedge);
            wrapped_data(new_row,:) = Xhi(row,admissible_cols) .* (cols <= (2*floor(4*M_horiz)+1));
            wrapped_XX(new_row,:) = XX(row,admissible_cols);
            wrapped_YY(new_row,:) = YY(row,admissible_cols);
        end;
        slope_wedge_left = ((floor(4*M_horiz)+1) - wedge_midpoints(end))/floor(4*M_vert);
        mid_line_left = wedge_midpoints(end) + slope_wedge_left*(wrapped_YY - 1);
        coord_left = 1/2 + floor(4*M_vert)/(wedge_endpoints(end) - wedge_endpoints(end-1)) * ...
            (wrapped_XX - mid_line_left)./(floor(4*M_vert) + 1 - wrapped_YY);
        C2 = -1/(2*(floor(4*M_horiz))/(wedge_endpoints(end) - 1) - 1 + 1/(2*(floor(4*M_vert))/(first_wedge_endpoint_vert - 1) - 1));
        C1 = -C2 * (2*(floor(4*M_horiz))/(wedge_endpoints(end) - 1) - 1);
        wrapped_XX((wrapped_XX - 1)/floor(4*M_horiz) == (wrapped_YY - 1)/floor(4*M_vert)) = ...
            wrapped_XX((wrapped_XX - 1)/floor(4*M_horiz) == (wrapped_YY - 1)/floor(4*M_vert)) - 1;
        coord_corner = C1 + C2 * (2-((wrapped_XX - 1)/(floor(4*M_horiz)) + (wrapped_YY - 1)/(floor(4*M_vert)))) ./ ...
            ((wrapped_XX - 1)/(floor(4*M_horiz)) - (wrapped_YY - 1)/(floor(4*M_vert)));
        wl_left = fdct_wrapping_window(coord_left);
        [wl_right,wr_right] = fdct_wrapping_window(coord_corner);

        wrapped_data = wrapped_data .* (wl_left .* wr_right);
        switch is_real
            case 0
                wrapped_data = rot90(wrapped_data,-(quadrant-1));
                C{j}{l} = fftshift(ifft2(ifftshift(wrapped_data)))*sqrt(prod(size(wrapped_data)));
            case 1
                wrapped_data = rot90(wrapped_data,-(quadrant-1));
                x = fftshift(ifft2(ifftshift(wrapped_data)))*sqrt(prod(size(wrapped_data)));
                C{j}{l} = sqrt(2)*real(x);
                C{j}{l+nbangles(j)/2} = sqrt(2)*imag(x);
        end;

        if quadrant < nbquadrants, Xhi = rot90(Xhi); end;
    end;
end;

% Coarsest wavelet level
C{1}{1} = fftshift(ifft2(ifftshift(Xlow)))*sqrt(prod(size(Xlow)));
if is_real == 1,
    C{1}{1} = real(C{1}{1});
end;

function x = ifdct_wrapping(C, is_real, M, N)

% ifdct_wrapping.m - Inverse Fast Discrete Curvelet Transform via wedge wrapping - Version 1.0
% This is in fact the adjoint, also the pseudo-inverse
%
% Inputs
%   C           Cell array containing curvelet coefficients (see
%               description in fdct_wrapping.m)
%   is_real     As used in fdct_wrapping.m
%   M, N        Size of the image to be recovered (not necessary if finest
%               = 2)
%
% Outputs
%   x           M-by-N matrix
%
% See also fdct_wrapping.m
%
% By Laurent Demanet, 2004

% Initialization
nbscales = length(C);
nbangles_coarse = length(C{2});
nbangles = [1, nbangles_coarse .* 2.^(ceil((nbscales-(nbscales:-1:2))/2))];
if length(C{end}) == 1, finest = 2; else finest = 1; end;
if finest == 2, nbangles(nbscales) = 1; end;
if nargin < 2, is_real = 0; end;
if nargin < 4,
    if finest == 1, error('Syntax: IFCT_wrapping(C,M,N) where the matrix to be recovered is M-by-N'); end;
    [N1,N2] = size(C{end}{1});
else
    N1 = M;
    N2 = N;
end;

M1 = N1/3;
M2 = N2/3;

if finest == 1;

    bigN1 = 2*floor(2*M1)+1;
    bigN2 = 2*floor(2*M2)+1;
    X = zeros(bigN1,bigN2);

    % Initialization: preparing the lowpass filter at finest scale
    window_length_1 = floor(2*M1) - floor(M1) - 1 - (mod(N1,3)==0);
    window_length_2 = floor(2*M2) - floor(M2) - 1 - (mod(N2,3)==0);
    coord_1 = 0:(1/window_length_1):1;
    coord_2 = 0:(1/window_length_2):1;
    [wl_1,wr_1] = fdct_wrapping_window(coord_1);
    [wl_2,wr_2] = fdct_wrapping_window(coord_2);
    lowpass_1 = [wl_1, ones(1,2*floor(M1)+1), wr_1];
    if mod(N1,3)==0, lowpass_1 = [0, lowpass_1, 0]; end;
    lowpass_2 = [wl_2, ones(1,2*floor(M2)+1), wr_2];
    if mod(N2,3)==0, lowpass_2 = [0, lowpass_2, 0]; end;
    lowpass = lowpass_1'*lowpass_2;

    scales = nbscales:-1:2;

else

    M1 = M1/2;
    M2 = M2/2;

    bigN1 = 2*floor(2*M1)+1;
    bigN2 = 2*floor(2*M2)+1;
    X = zeros(bigN1,bigN2);

    window_length_1 = floor(2*M1) - floor(M1) - 1;
    window_length_2 = floor(2*M2) - floor(M2) - 1;
    coord_1 = 0:(1/window_length_1):1;
    coord_2 = 0:(1/window_length_2):1;
    [wl_1,wr_1] = fdct_wrapping_window(coord_1);
    [wl_2,wr_2] = fdct_wrapping_window(coord_2);
    lowpass_1 = [wl_1, ones(1,2*floor(M1)+1), wr_1];
    lowpass_2 = [wl_2, ones(1,2*floor(M2)+1), wr_2];
    lowpass = lowpass_1'*lowpass_2;
    hipass_finest = sqrt(1 - lowpass.^2);

    scales = (nbscales-1):-1:2;

end;

% Loop: pyramidal reconstruction

Xj_topleft_1 = 1;
Xj_topleft_2 = 1;
for j = scales,

    M1 = M1/2;
    M2 = M2/2;
    window_length_1 = floor(2*M1) - floor(M1) - 1;
    window_length_2 = floor(2*M2) - floor(M2) - 1;
    coord_1 = 0:(1/window_length_1):1;
    coord_2 = 0:(1/window_length_2):1;
    [wl_1,wr_1] = fdct_wrapping_window(coord_1);
    [wl_2,wr_2] = fdct_wrapping_window(coord_2);
    lowpass_1 = [wl_1, ones(1,2*floor(M1)+1), wr_1];
    lowpass_2 = [wl_2, ones(1,2*floor(M2)+1), wr_2];
    lowpass_next = lowpass_1'*lowpass_2;
    hipass = sqrt(1 - lowpass_next.^2);
    Xj = zeros(2*floor(4*M1)+1,2*floor(4*M2)+1);

    % Loop: angles
    l = 0;
    nbquadrants = 2 + 2*(~is_real);
    nbangles_perquad = nbangles(j)/4;
    for quadrant = 1:nbquadrants

        M_horiz = M2 * (mod(quadrant,2)==1) + M1 * (mod(quadrant,2)==0);
        M_vert = M1 * (mod(quadrant,2)==1) + M2 * (mod(quadrant,2)==0);
        if mod(nbangles_perquad,2),
            wedge_ticks_left = round((0:(1/(2*nbangles_perquad)):.5)*2*floor(4*M_horiz) + 1);
            wedge_ticks_right = 2*floor(4*M_horiz) + 2 - wedge_ticks_left;
            wedge_ticks = [wedge_ticks_left, wedge_ticks_right(end:-1:1)];
        else
            wedge_ticks_left = round((0:(1/(2*nbangles_perquad)):.5)*2*floor(4*M_horiz) + 1);
            wedge_ticks_right = 2*floor(4*M_horiz) + 2 - wedge_ticks_left;
            wedge_ticks = [wedge_ticks_left, wedge_ticks_right((end-1):-1:1)];
        end;
        wedge_endpoints = wedge_ticks(2:2:(end-1));         % integers
        wedge_midpoints = (wedge_endpoints(1:(end-1)) + wedge_endpoints(2:end))/2;

        % Left corner wedge

        l = l+1;
        first_wedge_endpoint_vert = round(2*floor(4*M_vert)/(2*nbangles_perquad) + 1);
        length_corner_wedge = floor(4*M_vert) - floor(M_vert) + ceil(first_wedge_endpoint_vert/4);
        Y_corner = 1:length_corner_wedge;
        [XX,YY] = meshgrid(1:(2*floor(4*M_horiz)+1),Y_corner);
        width_wedge = wedge_endpoints(2) + wedge_endpoints(1) - 1;
        slope_wedge = (floor(4*M_horiz) + 1 - wedge_endpoints(1))/floor(4*M_vert);
        left_line = round(2 - wedge_endpoints(1) + slope_wedge*(Y_corner - 1));
        [wrapped_XX, wrapped_YY] = deal(zeros(length_corner_wedge,width_wedge));
        first_row = floor(4*M_vert)+2-ceil((length_corner_wedge+1)/2)+...
            mod(length_corner_wedge+1,2)*(quadrant-2 == mod(quadrant-2,2));
        first_col = floor(4*M_horiz)+2-ceil((width_wedge+1)/2)+...
            mod(width_wedge+1,2)*(quadrant-3 == mod(quadrant-3,2));

        for row = Y_corner
            cols = left_line(row) + mod((0:(width_wedge-1))-(left_line(row)-first_col),width_wedge);
            new_row = 1 + mod(row - first_row, length_corner_wedge);
            admissible_cols = round(1/2*(cols+1+abs(cols-1)));
            wrapped_XX(new_row,:) = XX(row,admissible_cols);
            wrapped_YY(new_row,:) = YY(row,admissible_cols);
        end;

        slope_wedge_right = (floor(4*M_horiz)+1 - wedge_midpoints(1))/floor(4*M_vert);
        mid_line_right = wedge_midpoints(1) + slope_wedge_right*(wrapped_YY - 1);
                                                            % not integers
                                                            % in general
        coord_right = 1/2 + floor(4*M_vert)/(wedge_endpoints(2) - wedge_endpoints(1)) * ...
            (wrapped_XX - mid_line_right)./(floor(4*M_vert)+1 - wrapped_YY);
        C2 = 1/(1/(2*(floor(4*M_horiz))/(wedge_endpoints(1) - 1) - 1) + 1/(2*(floor(4*M_vert))/(first_wedge_endpoint_vert - 1) - 1));
        C1 = C2 / (2*(floor(4*M_vert))/(first_wedge_endpoint_vert - 1) - 1);
        wrapped_XX((wrapped_XX - 1)/floor(4*M_horiz) + (wrapped_YY-1)/floor(4*M_vert) == 2) = ...
            wrapped_XX((wrapped_XX - 1)/floor(4*M_horiz) + (wrapped_YY-1)/floor(4*M_vert) == 2) + 1;
        coord_corner = C1 + C2 * ((wrapped_XX - 1)/(floor(4*M_horiz)) - (wrapped_YY - 1)/(floor(4*M_vert))) ./ ...
            (2-((wrapped_XX - 1)/(floor(4*M_horiz)) + (wrapped_YY - 1)/(floor(4*M_vert))));
        wl_left = fdct_wrapping_window(coord_corner);
        [wl_right,wr_right] = fdct_wrapping_window(coord_right);
        switch is_real
         case 0
          wrapped_data = fftshift(fft2(ifftshift(C{j}{l})))/sqrt(prod(size(C{j}{l})));
          wrapped_data = rot90(wrapped_data,(quadrant-1));
         case 1
          x = C{j}{l} + sqrt(-1)*C{j}{l+nbangles(j)/2};
          wrapped_data = fftshift(fft2(ifftshift(x)))/sqrt(prod(size(x)))/sqrt(2);
          wrapped_data = rot90(wrapped_data,(quadrant-1));
        end;
        wrapped_data = wrapped_data .* (wl_left .* wr_right);

        % Unwrapping data
        for row = Y_corner
            cols = left_line(row) + mod((0:(width_wedge-1))-(left_line(row)-first_col),width_wedge);
            admissible_cols = round(1/2*(cols+1+abs(cols-1)));
            new_row = 1 + mod(row - first_row, length_corner_wedge);
            Xj(row,admissible_cols) = Xj(row,admissible_cols) + wrapped_data(new_row,:);
                                % We use the following property: in an assignment
                                % A(B) = C where B and C are vectors, if
                                % some value x repeats in B, then the
                                % last occurrence of x is the one
                                % corresponding to the eventual assignment.
        end;

        % Regular wedges
        length_wedge = floor(4*M_vert) - floor(M_vert);
        Y = 1:length_wedge;
        first_row = floor(4*M_vert)+2-ceil((length_wedge+1)/2)+...
            mod(length_wedge+1,2)*(quadrant-2 == mod(quadrant-2,2));
        for subl = 2:(nbangles_perquad-1);
            l = l+1;
            width_wedge = wedge_endpoints(subl+1) - wedge_endpoints(subl-1) + 1;
            slope_wedge = ((floor(4*M_horiz)+1) - wedge_endpoints(subl))/floor(4*M_vert);
            left_line = round(wedge_endpoints(subl-1) + slope_wedge*(Y - 1));
            [wrapped_XX, wrapped_YY] = deal(zeros(length_wedge,width_wedge));
            first_col = floor(4*M_horiz)+2-ceil((width_wedge+1)/2)+...
                mod(width_wedge+1,2)*(quadrant-3 == mod(quadrant-3,2));
            for row = Y
                cols = left_line(row) + mod((0:(width_wedge-1))-(left_line(row)-first_col),width_wedge);
                new_row = 1 + mod(row - first_row, length_wedge);
                wrapped_XX(new_row,:) = XX(row,cols);
                wrapped_YY(new_row,:) = YY(row,cols);
            end;
            slope_wedge_left = ((floor(4*M_horiz)+1) - wedge_midpoints(subl-1))/floor(4*M_vert);
            mid_line_left = wedge_midpoints(subl-1) + slope_wedge_left*(wrapped_YY - 1);
            coord_left = 1/2 + floor(4*M_vert)/(wedge_endpoints(subl) - wedge_endpoints(subl-1)) * ...
                (wrapped_XX - mid_line_left)./(floor(4*M_vert)+1 - wrapped_YY);
            slope_wedge_right = ((floor(4*M_horiz)+1) - wedge_midpoints(subl))/floor(4*M_vert);
            mid_line_right = wedge_midpoints(subl) + slope_wedge_right*(wrapped_YY - 1);
            coord_right = 1/2 + floor(4*M_vert)/(wedge_endpoints(subl+1) - wedge_endpoints(subl)) * ...
                (wrapped_XX - mid_line_right)./(floor(4*M_vert)+1 - wrapped_YY);
            wl_left = fdct_wrapping_window(coord_left);
            [wl_right,wr_right] = fdct_wrapping_window(coord_right);
            switch is_real
             case 0
              wrapped_data = fftshift(fft2(ifftshift(C{j}{l})))/sqrt(prod(size(C{j}{l})));
              wrapped_data = rot90(wrapped_data,(quadrant-1));
             case 1
              x = C{j}{l} + sqrt(-1)*C{j}{l+nbangles(j)/2};
              wrapped_data = fftshift(fft2(ifftshift(x)))/sqrt(prod(size(x)))/sqrt(2);
              wrapped_data = rot90(wrapped_data,(quadrant-1));
            end;
            wrapped_data = wrapped_data .* (wl_left .* wr_right);

            % Unwrapping data
            for row = Y
                cols = left_line(row) + mod((0:(width_wedge-1))-(left_line(row)-first_col),width_wedge);
                new_row = 1 + mod(row - first_row, length_wedge);
                Xj(row,cols) = Xj(row,cols) + wrapped_data(new_row,:);
            end;

        end;    % for subl

        % Right corner wedge
        l = l+1;
        width_wedge = 4*floor(4*M_horiz) + 3 - wedge_endpoints(end) - wedge_endpoints(end-1);
        slope_wedge = ((floor(4*M_horiz)+1) - wedge_endpoints(end))/floor(4*M_vert);
        left_line = round(wedge_endpoints(end-1) + slope_wedge*(Y_corner - 1));
        [wrapped_XX, wrapped_YY] = deal(zeros(length_corner_wedge,width_wedge));
        first_row = floor(4*M_vert)+2-ceil((length_corner_wedge+1)/2)+...
            mod(length_corner_wedge+1,2)*(quadrant-2 == mod(quadrant-2,2));
        first_col = floor(4*M_horiz)+2-ceil((width_wedge+1)/2)+...
            mod(width_wedge+1,2)*(quadrant-3 == mod(quadrant-3,2));

        for row = Y_corner
            cols = left_line(row) + mod((0:(width_wedge-1))-(left_line(row)-first_col),width_wedge);
            admissible_cols = round(1/2*(cols+2*floor(4*M_horiz)+1-abs(cols-(2*floor(4*M_horiz)+1))));
            new_row = 1 + mod(row - first_row, length_corner_wedge);
            wrapped_XX(new_row,:) = XX(row,admissible_cols);
            wrapped_YY(new_row,:) = YY(row,admissible_cols);
        end;
        YY = Y_corner'*ones(1,width_wedge);
        slope_wedge_left = ((floor(4*M_horiz)+1) - wedge_midpoints(end))/floor(4*M_vert);
        mid_line_left = wedge_midpoints(end) + slope_wedge_left*(wrapped_YY - 1);
        coord_left = 1/2 + floor(4*M_vert)/(wedge_endpoints(end) - wedge_endpoints(end-1)) * ...
            (wrapped_XX - mid_line_left)./(floor(4*M_vert)+1 - wrapped_YY);
        C2 = -1/(2*(floor(4*M_horiz))/(wedge_endpoints(end) - 1) - 1 + 1/(2*(floor(4*M_vert))/(first_wedge_endpoint_vert - 1) - 1));
        C1 = -C2 * (2*(floor(4*M_horiz))/(wedge_endpoints(end) - 1) - 1);
        wrapped_XX((wrapped_XX - 1)/floor(4*M_horiz) == (wrapped_YY-1)/floor(4*M_vert)) = ...
            wrapped_XX((wrapped_XX - 1)/floor(4*M_horiz) == (wrapped_YY-1)/floor(4*M_vert)) - 1;
        coord_corner = C1 + C2 * (2-((wrapped_XX - 1)/(floor(4*M_horiz)) + (wrapped_YY - 1)/(floor(4*M_vert)))) ./ ...
            ((wrapped_XX - 1)/(floor(4*M_horiz)) - (wrapped_YY - 1)/(floor(4*M_vert)));
        wl_left = fdct_wrapping_window(coord_left);
        [wl_right,wr_right] = fdct_wrapping_window(coord_corner);
        switch is_real
         case 0
          wrapped_data = fftshift(fft2(ifftshift(C{j}{l})))/sqrt(prod(size(C{j}{l})));
          wrapped_data = rot90(wrapped_data,(quadrant-1));
         case 1
          x = C{j}{l} + sqrt(-1)*C{j}{l+nbangles(j)/2};
          wrapped_data = fftshift(fft2(ifftshift(x)))/sqrt(prod(size(x)))/sqrt(2);
          wrapped_data = rot90(wrapped_data,(quadrant-1));
        end;
        wrapped_data = wrapped_data .* (wl_left .* wr_right);

         % Unwrapping data
        for row = Y_corner
            cols = left_line(row) + mod((0:(width_wedge-1))-(left_line(row)-first_col),width_wedge);
            admissible_cols = round(1/2*(cols+2*floor(4*M_horiz)+1-abs(cols-(2*floor(4*M_horiz)+1))));
            new_row = 1 + mod(row - first_row, length_corner_wedge);
            Xj(row,fliplr(admissible_cols)) = Xj(row,fliplr(admissible_cols)) + wrapped_data(new_row,end:-1:1);
                                % We use the following property: in an assignment
                                % A(B) = C where B and C are vectors, if
                                % some value x repeats in B, then the
                                % last occurrence of x is the one
                                % corresponding to the eventual assignment.
        end;

        Xj = rot90(Xj);

    end;    % for quadrant

    Xj = Xj .* lowpass;
    Xj_index1 = ((-floor(2*M1)):floor(2*M1)) + floor(4*M1) + 1;
    Xj_index2 = ((-floor(2*M2)):floor(2*M2)) + floor(4*M2) + 1;
    Xj(Xj_index1, Xj_index2) = Xj(Xj_index1, Xj_index2) .* hipass;

    loc_1 = Xj_topleft_1 + (0:(2*floor(4*M1)));
    loc_2 = Xj_topleft_2 + (0:(2*floor(4*M2)));
    X(loc_1,loc_2) = X(loc_1,loc_2) + Xj;

    % Preparing for loop reentry or exit

    Xj_topleft_1 = Xj_topleft_1 + floor(4*M1) - floor(2*M1);
    Xj_topleft_2 = Xj_topleft_2 + floor(4*M2) - floor(2*M2);

    lowpass = lowpass_next;

end;    % for j

if is_real
    Y = X;
    X = rot90(X,2);
    X = X + conj(Y);
end

% Coarsest wavelet level
M1 = M1/2;
M2 = M2/2;
Xj = fftshift(fft2(ifftshift(C{1}{1})))/sqrt(prod(size(C{1}{1})));
loc_1 = Xj_topleft_1 + (0:(2*floor(4*M1)));
loc_2 = Xj_topleft_2 + (0:(2*floor(4*M2)));
X(loc_1,loc_2) = X(loc_1,loc_2) + Xj .* lowpass;

% Finest level
M1 = N1/3;
M2 = N2/3;
if finest == 1,

    % Folding back onto N1-by-N2 matrix
    shift_1 = floor(2*M1)-floor(N1/2);
    shift_2 = floor(2*M2)-floor(N2/2);
    Y = X(:,(1:N2)+shift_2);
    Y(:,N2-shift_2+(1:shift_2)) = Y(:,N2-shift_2+(1:shift_2)) + X(:,1:shift_2);
    Y(:,1:shift_2) = Y(:,1:shift_2) + X(:,N2+shift_2+(1:shift_2));
    X = Y((1:N1)+shift_1,:);
    X(N1-shift_1+(1:shift_1),:) = X(N1-shift_1+(1:shift_1),:) + Y(1:shift_1,:);
    X(1:shift_1,:) = X(1:shift_1,:) + Y(N1+shift_1+(1:shift_1),:);

else

    % Extension to a N1-by-N2 matrix
    Y = fftshift(fft2(ifftshift(C{nbscales}{1})))/sqrt(prod(size(C{nbscales}{1})));
    X_topleft_1 = ceil((N1+1)/2) - floor(M1);
    X_topleft_2 = ceil((N2+1)/2) - floor(M2);
    loc_1 = X_topleft_1 + (0:(2*floor(M1)));
    loc_2 = X_topleft_2 + (0:(2*floor(M2)));
    Y(loc_1,loc_2) = Y(loc_1,loc_2) .* hipass_finest + X;
    X = Y;

end;

x = fftshift(ifft2(ifftshift(X)))*sqrt(prod(size(X)));
if is_real, x = real(x); end;

function [wl,wr] = fdct_wrapping_window(x)

% fdct_wrapping_window.m - Creates the two halves of a C^inf compactly supported window
%
% Inputs
%   x       vector or matrix of abscissae, the relevant ones from 0 to 1
%
% Outputs
%   wl,wr   vector or matrix containing samples of the left, resp. right
%           half of the window
%
% Used at least in fdct_wrapping.m and ifdct_wrapping.m
%
% By Laurent Demanet, 2004

wr = zeros(size(x));
wl = zeros(size(x));
x(abs(x) < 2^-52) = 0;
wr((x > 0) & (x < 1)) = exp(1-1./(1-exp(1-1./x((x > 0) & (x < 1)))));
wr(x <= 0) = 1;
wl((x > 0) & (x < 1)) = exp(1-1./(1-exp(1-1./(1-x((x > 0) & (x < 1))))));
wl(x >= 1) = 1;
normalization = sqrt(wl.^2 + wr.^2);
wr = wr ./ normalization;
wl = wl ./ normalization;


 function x = nufft2_adj(X, st)
%function x = nufft2_adj(X, st)
%	SUPERCEDED BY nufft_adj.m
%	Apply adjoint of 2D NUFFT to vector(s) X
%	in:	X	[M,L]
%		st		structure precomputed by nufft2_init()
%	out:	x	[N1,N2,L]
%
%	Copyright 2001-9-17	Jeff Fessler	The University of Michigan

%
%	if no arguments, then run a simple test
%
if nargin < 1
	help(mfilename)

	N1 = 4;
	N2 = 8;
	n_shift = [2.7 3.1];	% random shifts to stress it
	o1 = 2 * pi * [0.0 0.1 0.3 0.4 0.7 0.9]';
	o2 = flipud(o1);
	st = nufft2_init([o1 o2], N1, N2, 4, 6, 2*N1, 2*N2, n_shift, 0, 'best');

	M = length(o1);
	A = zeros(M, N1*N2);
	for n1=1:N1
		for n2=1:N2
			x = zeros(N1,N2); x(n1,n2) = 1;
			jj = n1 + (n2-1) * N1;
			A(:,jj) = nufft2(x, st);
		end
	end

	Aa = zeros(N1*N2, M);
	for ii=1:M
		y = zeros(M,1); y(ii,1) = 1;
		Aa(:,ii) = col(nufft2_adj(y, st));
	end

	printf('max %% = %g', max_percent_diff(A,Aa'))
	clear x
return
end

%	extract attributes from structure
K1 = st.K1;
K2 = st.K2;
if size(X,1) ~= st.M, error size, end

%
%	adjoint of interpolator using precomputed sparse matrix
%
Xk = full(st.p' * X);			% [K1*K2,L]
Xk = reshape(Xk, [K1 K2 size(X,2)]);	% [K1,K2,L]

x = K1 * K2 * ifft2(Xk);		% [K1,K2,L]

% eliminate zero padding from ends
x = x(1:st.N1,1:st.N2,:);		% [N1,N2,L]

if ndims(x) == 2
	x = x .* st.sn;
else
	error '3d not done'
end


function [ r, z, c, s ] = zchex ( r, ldr, p, k, l, z, ldz, nz, job )

%*****************************************************************************80
%
%% ZCHEX updates a Cholesky factorization.
%
%  Discussion:
%
%    ZCHEX updates a Cholesky factorization
%
%      A = hermitian(R) * R
%
%    of a positive definite matrix A of order P under diagonal
%    permutations of the form
%
%      E' * A * E
%
%    where E is a permutation matrix.  Specifically, given
%    an upper triangular matrix R and a permutation matrix
%    E (which is specified by K, L, and JOB), ZCHEX determines
%    a unitary matrix U such that
%
%      U * R * E = RR,
%
%    where RR is upper triangular.  At the user's option, the
%    transformation U will be multiplied into the array Z.
%
%    If A = hermitian(X)*X, so that R is the triangular part of the
%    QR factorization of X, then RR is the triangular part of the
%    QR factorization of X * E, that is, X with its columns permuted.
%
%    For a less terse description of what ZCHEX does and how
%    it may be applied, see the LINPACK guide.
%
%    The matrix Q is determined as the product U(L-K)*...*U(1)
%    of plane rotations of the form
%
%      (    C(I)       S(I) )
%      (                    ) ,
%      ( -conj(S(i))  C(I) )
%
%    where C(I) is real, the rows these rotations operate on
%    are described below.
%
%    There are two types of permutations, which are determined
%    by the value of job.
%
%    JOB = 1, right circular shift:
%    The columns are rearranged in the following order.
%
%      1, ..., K-1, L, K, K+1, ..., L-1, L+1, ..., P.
%
%    U is the product of L-K rotations U(I), where U(I)
%    acts in the (L-I,L-I+1)-plane.
%
%    JOB = 2, left circular shift:
%    The columns are rearranged in the following order
%
%      1, ..., K-1, K+1, K+2, ..., L, L, L+1, ..., P.
%
%    U is the product of L-K rotations U(I), where U(I)
%    acts in the (K+I-1,K+I)-plane.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    02 May 2007
%
%  Author:
%
%    MATLAB version by John Burkardt
%
%  Reference:
%
%    Jack Dongarra, Cleve Moler, Jim Bunch and Pete Stewart,
%    LINPACK User's Guide,
%    SIAM, (Society for Industrial and Applied Mathematics),
%    3600 University City Science Center,
%    Philadelphia, PA, 19104-2688.
%
%  Parameters:
%
%    Input, complex R(LDR,P); the upper triangular factor that is to be updated.
%    Elements below the diagonal are not referenced.
%
%    Input, integer LDR, the leading dimension of R, which is at least P.
%
%    Input, integer P, the order of the matrix.
%
%    Input, integer K, the first column to be permuted.
%
%    Input, integer L, the last column to be permuted.
%    L must be strictly greater than K.
%
%    Input, complex Z(LDZ,NZ), an array of NZ P-vectors into
%    which the transformation U is multiplied.
%
%    Input, integer LDZ, the leading dimension of Z, which must
%    be at least P.
%
%    Input, integer NZ, the number of columns of the matrix Z.
%
%    Input, integer JOB, determines the type of permutation.
%    1, right circular shift.
%    2, left circular shift.
%
%    Output, complex R(LDR,P), the updated factor.
%
%    Output, complex Z(LDZ,NZ), the updated matrix.  Z is not referenced
%    if NZ = 0.
%
%    Output, real C(P), the cosines of the transforming rotations.
%
%    Output, complex S(P), the sines of the transforming rotations.
%
  if ( job == 1 )
%
%  Right circular shift.
%
%  Reorder the columns.
%
    for i = 1 : l
      ii = l - i + 1;
      s(i) = r(ii,l);
    end

    for jj = k : l - 1
      j = l - 1 - jj + k;
      r(1:j,j+1) = r(1:j,j);
      r(j+1,j+1) = 0.0;
    end

    for i = 1 : k - 1
      ii = l - i + 1;
      r(i,k) = s(ii);
    end
%
%  Calculate the rotations.
%
    t = s(1);
    for i = 1 : l - k
      [ c(i), s(i), s(i+1) ] = zrotg ( s(i+1), t );
      t = s(i+1);
    end

    r(k,k) = t;
    for j = k+1 : p
      il = max ( 1, l - j + 1 );
      for ii = il : l - k
        i = l - ii;
        t = c(ii) * r(i,j) + s(ii) * r(i+1,j);
        r(i+1,j) = c(ii) * r(i+1,j) - conj ( s(ii) ) * r(i,j);
        r(i,j) = t;
      end
    end
%
%  If required, apply the transformations to Z.
%
    for j = 1 : nz
      for ii = 1 : l - k
        i = l - ii;
        t = c(ii) * z(i,j) + s(ii) * z(i+1,j);
        z(i+1,j) = c(ii) * z(i+1,j) - conj ( s(ii) ) * z(i,j);
        z(i,j) = t;
      end
    end

  else
%
%  Left circular shift.
%
%  Reorder the columns.
%
    for i = 1 : k
      ii = l - k + i;
      s(ii) = r(i,k);
    end

    for j = k : l - 1
      r(1:j,j) = r(1:j,j+1);
      jj = j - k + 1;
      s(jj) = r(j+1,j+1);
    end

    for i = 1 : k
      ii = l - k + i;
      r(i,l) = s(ii);
    end

    r(k+1:l,l) = 0.0;
%
%  Reduction loop.
%
    for j = k : p
%
%  Apply the rotations.
%
      if ( j ~= k )
        iu = min ( j - 1, l - 1 );
        for i = k : iu
          ii = i - k + 1;
          t = c(ii) * r(i,j) + s(ii) * r(i+1,j);
          r(i+1,j) = c(ii) * r(i+1,j) - conj ( s(ii) ) * r(i,j);
          r(i,j) = t;
        end
      end

      if ( j < l )
        jj = j - k + 1;
        t = s(jj);
        [ c(jj), s(jj), r(j,j) ] = zrotg ( r(j,j), t );
      end

    end
%
%  Apply the rotations to Z.
%
    for j = 1 : nz
      for i = k : l - 1
        ii = i - k + 1;
        t = c(ii) * z(i,j) + s(ii) * z(i+1,j);
        z(i+1,j) = c(ii) * z(i+1,j) - conj ( s(ii) ) * z(i,j);
        z(i,j) = t;
      end
    end

  end

  return
end


function pass = test_linearize_init_fails(~)
%TEST_LINEARIZE_INIT_FAILS   Test that we get sensible error messages when we
%are dealing with an initial guess that makes the chebop fail to evaluate.

%% First order problem which is OK, as it's solved as an IVP
N = chebop(0, 1);
N.op = @(u) diff(u) - sqrt(u);
N.lbc = 1;
u = N\1;
pass(1) = norm(N(u)-1) < 1e-10;

%% First order problem which is OK, not OK when try to solve as a BVP
N = chebop(0, 1);
N.op = @(u) diff(u) - sqrt(u);
N.bc = @(u) u(0) - 1;
try
    u = N\1;
catch ME
    pass(2) = strcmp(ME.identifier, ...
        'CHEBFUN:CHEBOP:linearize:invalidInitialGuess');
end

%% Nor when solvebvp is called directly
N = chebop(0, 1);
N.op = @(u) diff(u) - sqrt(u);
N.lbc = 1;
try
    u = solvebvp(N, 1);
catch ME
    pass(3) = strcmp(ME.identifier, ...
        'CHEBFUN:CHEBOP:linearize:invalidInitialGuess');
end

%% Second order problem
N = chebop(0, 1);
N.op = @(u) diff(u,2) - sqrt(u);
N.bc = 1;
try
    u = N\1;
catch ME
    pass(4) = strcmp(ME.identifier, ...
        'CHEBFUN:CHEBOP:linearize:invalidInitialGuess');
end

%% Second order problem, different function causing issues
N = chebop(0, 1);
N.op = @(u) diff(u,2) - 1./u;
N.bc = 1;
try
    u = N\1;
catch ME
    pass(5) = strcmp(ME.identifier, ...
        'CHEBFUN:CHEBOP:linearize:invalidInitialGuess');
end

%% Coupled system, OK when solved as an IVP
N = chebop(0, 1);
N.op = @(x, u, v) [diff(u,2) - sqrt(v); diff(v,2) + 1./u];
N.lbc = @(u,v) [u-1; diff(u)-.1; v-2; diff(v) + .2];
uv = N\[1; 2];
pass(6) = norm(N(uv) - [1;2]) < 1e-8;

%% Coupled system, OK when solved as an IVP
N = chebop(0, 1);
N.op = @(x, u, v) [diff(u,2) - sqrt(v); diff(v,2) + 1./u];
N.bc = @(x,u,v) [u(0) - 1; u(1) + 1; v(0) - 2; v(0) - 3];
try
    uv = N\1;
catch ME
    pass(7) = strcmp(ME.identifier, ...
        'CHEBFUN:CHEBOP:linearize:invalidInitialGuess');
end


function [vMc, mStd_McBoot, fStd_Mc, blo, bhi] = calc_BstMcPercInt(mCatalog,fBinning, alpha)
% [vProbMin, vMcBest, mMag_bstsamp, fStd_Mc, fConfLow, fConfUp] = calc_BstMcPerInt(mCatalog, fBinning)
%---------------------------------------------------------------------------
% Bootstrap EQ catalog and determine Mc confidence due to modelling with
% MLS fitting entire FMD distribution
%
% Incoming variables:
% mCatalog   : EQ catalog
% fBinning   : Magnitude binning interval
%
% Outgoing variables:
% vProbMin     : Vector of maximum likelihood scores
% vMcBest      : Best Mc estimate according to MLS
% mMag_bstsamp : Matrix of bootstrap samples of magnitudes
% fStd_Mc      : Standard deviation (assuming normal distribution
%
% J. Woessner: woessner@seismo.ifg.ethz.ch
% last update: 31.01.03

% Initialize
vMls = [];
vMc = [];
vStd_Mcboot = [];
vMls_boot = [];
vMc_boot = [];
mStd_McBoot = [];

nB = 100; % Bootstrap replicates to calculate confidence intervals

% Get magnitudes
vMags = mCatalog(:,6);

% Create bootstrap samples using bootstrap matlab toolbox
nSample = 50;
mMag_bstsamp = bootrsp(vMags,nSample);
!date
% First step: Estimate standard error of Mc original distribution
% Determine Mc uncertainty
for nSamp=1:nSample
    mCatalog(:,6) = mMag_bstsamp(:,nSamp);
    [mResult, fMls, fMc, fMu, fSigma, mDatPredBest, vPredBest] = calc_McCdfnormal(mCatalog, fBinning);
    vMls = [vMls; fMls];
    vMc =  [vMc; fMc];
end
fStd_Mc = std(vMc);
!date
% Second step: Estimate standard error for each Mc of a bootstrap sample
for i = 1:nB
    i
    mCatalog(:,6) = mMag_bstsamp(:,i);
    mMag_bst = bootrsp(mCatalog(:,6),nSample);
    % Bootstrap using the sample for estimating Mc
    for n= 1:nSample
        mCatalog(:,6) = mMag_bstsamp(:,nSample);
        [mResult, fMls, fMc, fMu, fSigma, mDatPredBest, vPredBest] = calc_McCdfnormal(mCatalog, fBinning);
        vMls_boot = [vMls_boot; fMls];
        vMc_boot =  [vMc_boot; fMc];
    end
    fStd_Mcboot = std(vMc_boot);
    vStd_Mcboot = [vStd_Mcboot; fStd_Mcboot];
    mStd_McBoot = [mStd_McBoot; vStd_Mcboot];
end

% Percentile interval
fExp = nB*alpha/2;
sbval = sort(mStd_Mcboot);
blo = sbval(k);
bhi = sbval(nB-k);


function [out] = percolation_1(p1,S,dt)
%percolation_1

% Copyright (C) 2019, 2021 Wouter J.M. Knoben, Luca Trotter
% This file is part of the Modular Assessment of Rainfall-Runoff Models
% Toolbox (MARRMoT).
% MARRMoT is a free software (GNU GPL v3) and distributed WITHOUT ANY
% WARRANTY. See <https://www.gnu.org/licenses/> for details.

% Flux function
% ------------------
% Description:  Percolation at a constant rate
% Constraints:  f <= S/dt
% @(Inputs):    p1   - base percolation rate [mm/d]
%               S    - current storage [mm]
%               dt   - time step size [d]

out = min(p1,S/dt);

end


function y = log_sum_exp( varargin )

%LOG_SUM_EXP    log(sum(exp(x))).
%   LOG_SUM_EXP(X) = LOG(SUM(EXP(X)).
%
%   When used in a CVX model, LOG_SUM_EXP(X) causes CVX's successive
%   approximation method to be invoked, producing results exact to within
%   the tolerance of the solver. This is in contrast to LOGSUMEXP_SDP,
%   which uses a single SDP-representable global approximation.
%
%   If X is a matrix, LOGSUMEXP_SDP(X) will perform its computations
%   along each column of X. If X is an N-D array, LOGSUMEXP_SDP(X)
%   will perform its computations along the first dimension of size
%   other than 1. LOGSUMEXP_SDP(X,DIM) will perform its computations
%   along dimension DIM.
%
%   Disciplined convex programming information:
%       LOG_SUM_EXP(X) is convex and nondecreasing in X; therefore, X
%       must be convex (or affine).

persistent P
if isempty( P ),
    P.map = cvx_remap( { 'real' ; 'convex' } );
    P.funcs = { @lse_1, @lse_2 };
    P.zero = -Inf;
    P.reduce = true;
    P.constant = 1;
    P.reverse = false;
    P.name = 'log_sum_exp';
    P.dimarg = 2;
end
cvx_expert_check( 'log_sum_exp', varargin{1} );
y = cvx_reduce_op( P, varargin{:} );

function x = lse_1( x )
xmid = 0.5 * ( max( x, [], 1 ) + min( x, [], 1 ) );
x = log( sum( exp( bsxfun( @minus, x, xmid ) ), 1 ) ) + xmid;

function y = lse_2( x ) %#ok
[nx,nv] = size(x); %#ok
cvx_begin
    variable w( nx, nv )
    epigraph variable y( 1, nv )
    exp( x - repmat( y, [ nx, 1 ] ) ) <= w; %#ok
    sum( w, 1 ) == 1; %#ok
cvx_end

% Copyright 2005-2014 CVX Research, Inc.
% See the file LICENSE.txt for full copyright information.
% The command 'cvx_where' will show where this file is located.


%LMNC Levenberg-Marquardt trained feed-forward neural net classifier
%
%  [W,HIST] = LMNC (A,UNITS,ITER,W_INI,T)
%
% INPUT
%  A        Dataset
%  UNITS    Vector with numbers of units in each hidden layer (default: [5])
%  ITER     Number of iterations to train (default: inf)
%  W_INI    Weight initialization network mapping (default: [], meaning
%           initialization by Matlab's neural network toolbox)
%  T        Tuning set (default: [], meaning use A)
%
% OUTPUT
%  W        Trained feed-forward neural network mapping
%  HIST     Progress report (see below)
%
% DESCRIPTION
% A feed-forward neural network classifier with length(N) hidden layers with
% N(I) units in layer I is computed for the dataset A. Training is stopped
% after ITER epochs (at least 50) or if the iteration number exceeds twice
% that of the best classification result. This is measured by the labeled
% tuning set T. If no tuning set is supplied A is used. W_INI is used, if
% given, as network initialization. Use [] if the standard Matlab
% initialization is desired. Progress is reported in file FID (default 0).
%
% The entire training sequence is returned in HIST (number of epochs,
% classification error on A, classification error on T, MSE on A, MSE on T,
% mean of squared weights).
%
% Uses the Mathworks' Neural Network toolbox.
%
% SEE ALSO (PRTools Guide)
% MAPPINGS, DATASETS, BPXNC, NEURC, RNNC, RBNC, PRPROGRESS

% Copyright: R.P.W. Duin, duin@ph.tn.tudelft.nl
% Faculty of Applied Physics, Delft University of Technology
% P.O. Box 5046, 2600 GA Delft, The Netherlands

% $Id: lmnc.m,v 1.3 2007/06/15 09:58:30 duin Exp $

function [w,hist] = lmnc(varargin)

		[w,hist] = ffnc(mfilename,varargin{:});

return


classdef TTeMPS_op_laplace
% TTeMPS_op_laplace
%
%   A MATLAB class for representing and manipulating
%   Laplace-like operators in the TT/MPS operator format,
%
%   Laplace-like operators are of the form
%         L \otimes I \otimes I \otimes I
%       + I \otimes L \otimes I \otimes I
%       + ...
%       + I \otimes I \otimes I \otimes L
%
%   with e.g. L being the discrete 1D-Laplacian matrix.

%   TTeMPS Toolbox.
%   Michael Steinlechner, 2013-2016
%   Questions and contact: michael.steinlechner@epfl.ch
%   BSD 2-clause license, see LICENSE.txt

properties( SetAccess = public, GetAccess = public )

    L0
    U           % core tensors as 4D doubles
    rank
    order
    size_row
    size_col
    V_L
    E_L

end

% Set methods for Cores
methods

    function A = set.U( A, U_);

        A.U = U_;
        A = update_properties( A );

    end

    function A = update_properties( A );

        A.rank = [1,  2*ones(1, length(A.U)-1), 1];  % the TT rank is always two for such Laplace-like tensors
        size_col_ = cellfun( @(y) size(y,1), A.U);
        A.size_col = size_col_ ./ (A.rank(1:end-1).*A.rank(2:end));
        A.size_row = cellfun( @(y) size(y,2), A.U);
        A.order = length( A.size_row );

    end

end

methods( Access = public )

    function A = TTeMPS_op_laplace(varargin)
    %LAPLACE Construct a tensor in TT/MPS format and return TTeMPS_op_laplace object.
    %
    %   A = TTEMPS_OP_LAPLACE( L, D ) creates the D-dimensional Laplace-like
    %       TT/MPS operator using the supplied matrix L.
    %
    %
        if nargin == 1
            % debug constructor
            A.U = varargin{1};
            A = update_properties( A );
            A.L0 = [];
            A.V_L = [];
            A.E_L = [];
        % Default constructor
        elseif (nargin == 2)

            % only one matrix passed
            L = varargin{1};
            A.L0 = L;
            d = varargin{2};

            A.V_L = [];
            A.E_L = [];

            [m,n] = size( L );
            E = speye( m, n );
            a_1 = sparse( 1, 1, 1, 2, 1 );
            a_mid = sparse( 2, 1, 1, 4, 1 );
            a_end = sparse( 2, 1, 1, 2, 1 );
            b_1 = sparse( 2, 1, 1, 2, 1 );
            b_mid = sparse( [1;4], [1;1], [1;1], 4, 1 );
            b_end = sparse( 1, 1, 1, 2, 1 );

            A.U = cell( 1, d );
            A.U{1} = kron( L, a_1 ) + kron( E, b_1 );
            A_mid = kron( L, a_mid ) + kron( E, b_mid );
            for i=2:d-1
                A.U{i} = A_mid;
            end
            A.U{d} = kron( L, a_end ) + kron( E, b_end );

            A = update_properties( A );

        else
            error('Invalid number of arguments.')
        end
    end

    % Other public functions
    y = apply( A, x, idx );
    A = mtimes( B, A );
    res = contract( A, x, y, idx );

    disp( A, name );
    display( A );

    B = TTeMPS_op_laplace_to_TTeMPS_op( A );
    B = TTeMPS_op_laplace_to_TT_matrix( A );
    expB = constr_precond_inner( A, X, mu );

    function A = initialize_precond( A )
        [A.V_L, A.E_L] = eig(full(A.L0));
        A.E_L = diag( A.E_L );
    end
end

end


function [ scaled_regions ] = map_regions_to_mult_scales(region_params, regions, image_size, scales )
% map_regions_to_mult_scales: given a set of regions that comes from an
% image of size image_size, it maps each of them to the appropriate image
% scale from set of scales given from the parameter scales.
%
% INPUTS:
% 1) region_params: (type struct) the region pooling parameters. Some of
% its fields are:
%   a) sz_conv_standard: (scalar value) the last convolution size
%   b) step_standard: (scalar value) is the stride in pixels of the output
%   of the last convolutional layer of the network where the regions are
%   going to be projected (for VGG16 is equal to 16).
% 2) regions: is a N x 8 array with the N input regions. Each region is
% represented by 8 values [xo0, yo0, xo1, yo1, xi0, yi0, xi1, yi1] that
% correspond to its outer rectangle [xo0, yo0, xo1, yo1] and its inner
% rectangle [xi0, yi0, xi1, yi1].
% 3) image_size: 2 x 1 or 1 x 2 array with the size of the original image
% 4) scales: NS x 1 or 1 x NS array with the image scales that are used. NS
% is the number of images. The i-th value is the size in pixels of the
% smallest dimension of the image in the i-th scale.
%
% OUTPUT:
% 1) scaled_regions: is a N x 9 array with the N output regions. Each region is
% represented by 9 values [scale_id, xo0, yo0, xo1, yo1, xi0, yi0, xi1, yi1]
% that correspond to its outer rectangle [xo0, yo0, xo1, yo1] and its inner
% rectangle [xi0, yi0, xi1, yi1]. scale_id corresponds to the scale id to
% which each region is mapped.
%
% This file is part of the code that implements the following paper:
% Title      : "LocNet: Improving Localization Accuracy for Object Detection"
% Authors    : Spyros Gidaris, Nikos Komodakis
% Institution: Universite Paris Est, Ecole des Ponts ParisTech
% ArXiv link : http://arxiv.org/abs/1511.07763
% code       : https://github.com/gidariss/LocNet
%
% AUTORIGHTS
% --------------------------------------------------------
% Copyright (c) 2016 Spyros Gidaris
%
% Title     : "LocNet: Improving Localization Accuracy for Object Detection"
% ArXiv link: http://arxiv.org/abs/1511.07763
% Licensed under The MIT License [see LICENSE for details]
% ---------------------------------------------------------

boxes_out = regions(:,1:4);
boxes_in  = regions(:,5:8);

min_img_sz = min(image_size(1:2));

if length(scales) > 1
    box_areas      = (boxes_out(:,3) - boxes_out(:, 1) + 1) .* (boxes_out(:,4) - boxes_out(:,2) + 1);
    expected_scale = region_params.sz_conv_standard * region_params.step_standard * min_img_sz ./ sqrt(box_areas);
    expected_scale = round(expected_scale(:));
    [~, best_scale_ids] = min(abs(bsxfun(@minus, scales, expected_scale(:))), [], 2);
else
    best_scale_ids = ones(size(boxes_out, 1), 1);
end

boxes_scales     = scales(best_scale_ids(:));
scaled_boxes_out = bsxfun(@times, (boxes_out - 1), (boxes_scales(:) - 1)) / (min_img_sz - 1) + 1;
scaled_boxes_in  = bsxfun(@times, (boxes_in  - 1), (boxes_scales(:) - 1)) / (min_img_sz - 1) + 1;
scaled_regions   = [best_scale_ids(:), scaled_boxes_out, scaled_boxes_in];
end


% SATGLOBE4 - Draw an idealized satellite view of earth
%
% This file renders a fully manipulatable satellite view
% of earth at a resolution of four pixels per degree, with added
% international political boundaries and gridlines.
% The imagery was obtained from NASA, then postprocessed.
% The globe was rendered using the Matlab Mapping Toolbox.
%
% The Mapping Toolbox is not needed to use this file; however,
% if you have the toolbox, you will be able to use the plot3m
% command to add your own graphics. If not, you can simply use plot3.
%
% In order to save storage space, this m-file loads image
% data from the file satglobe.mat, and then creates the
% graticule mesh itself. This process allows users who
% do not have the Matlab Mapping Toolbox to render the
% figure, but it does take a few moments to compute the
% mesh. Using this trick, the data storage is reduced
% considerably; however, once the figure is rendered, you
% may wish to save it as a regular Matlab figure file
% to increase speed.
%
% Michael Kleder, 2004

function satglobe4
load satglobe4
th=repmat((0:.25:180)'*pi/180,[1 1441]);
ph=repmat((-180:.25:180)*pi/180,[721 1]);
s.children(1).properties.XData = sin(th).*cos(ph);
s.children(1).properties.YData = sin(th).*sin(ph);
s.children(1).properties.ZData = cos(th);
s.children(1).properties.CData = double(c)/255;
figure;
struct2handle(s,gcf);
set(gcf,'color','k','renderer','zbuffer','inverthardcopy','off','name',...
   'Earth at 4 Pixels per Degree, by Michael Kleder');
return


function [V, policy, iter, cpu_time] = mdp_policy_iteration(P, R, discount, policy0, max_iter, eval_type)

% max_iter=2000;
% eval_type=1;

% mdp_policy_iteration  Resolution of discounted MDP
%                       with policy iteration algorithm
% Arguments ---------------------------------------------------------------
% Let S = number of states, A = number of actions
%   P(SxSxA) = transition matrix
%              P could be an array with 3 dimensions or
%              a cell array (1xA), each cell containing a matrix (SxS) possibly sparse
%   R(SxSxA) or (SxA) = reward matrix
%              R could be an array with 3 dimensions (SxSxA) or
%              a cell array (1xA), each cell containing a sparse matrix (SxS) or
%              a 2D array(SxA) possibly sparse
%   discount = discount rate, in ]0, 1[
%   policy0(S) = starting policy, optional
%   max_iter = maximum number of iteration to be done, upper than 0,
%              optional (default 1000)
%   eval_type = type of function used to evaluate policy:
%              0 for mdp_eval_policy_matrix, else mdp_eval_policy_iterative
%              optional (default 0)
% Evaluation --------------------------------------------------------------
%   V(S)   = value function
%   policy(S) = optimal policy
%   iter     = number of done iterations
%   cpu_time = used CPU time
%--------------------------------------------------------------------------
% In verbose mode, at each iteration, displays the number
% of differents actions between policy n-1 and n

% MDPtoolbox: Markov Decision Processes Toolbox
% Copyright (C) 2009  INRA
% Redistribution and use in source and binary forms, with or without modification,
% are permitted provided that the following conditions are met:
%    * Redistributions of source code must retain the above copyright notice,
%      this list of conditions and the following disclaimer.
%    * Redistributions in binary form must reproduce the above copyright notice,
%      this list of conditions and the following disclaimer in the documentation
%      and/or other materials provided with the distribution.
%    * Neither the name of the <ORGANIZATION> nor the names of its contributors
%      may be used to endorse or promote products derived from this software
%      without specific prior written permission.
% THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND
% ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED
% WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
% IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT,
% INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING,
% BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
% DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF
% LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE
% OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED
% OF THE POSSIBILITY OF SUCH DAMAGE.

cpu_time = cputime;

global mdp_VERBOSE;

% check of arguments
if iscell(P); S = size(P{1},1); else S = size(P,1); end;
if iscell(P); A = length(P); else A = size(P,3); end

if discount <= 0 || discount >= 1
    disp('--------------------------------------------------------')
    disp('MDP Toolbox ERROR: Discount rate must be in ]0; 1[')
    disp('--------------------------------------------------------')
elseif nargin > 3 && (size(policy0,1)~=S || any(mod(policy0,1)) || any(policy0<1)|| any(policy0>A) )
    disp('--------------------------------------------------------')
    disp('MDP Toolbox ERROR: policy0 must a (Sx1) vector with integer from 1 to A')
    disp('--------------------------------------------------------')
elseif nargin > 4 && max_iter <= 0
    disp('--------------------------------------------------------')
    disp('MDP Toolbox ERROR: The maximum number of iteration must be upper than 0')
    disp('--------------------------------------------------------')
else

    PR = mdp_computePR(P,R);

    % initialization of optional arguments
    if nargin < 6; eval_type = 0; end;
    if nargin < 5; max_iter = 1000; end;
    if nargin < 4;
        % initialization of policy:
        % the one wich maximizes the expected immediate reward
        [nil, policy0] = mdp_bellman_operator(P,PR,discount,zeros(S,1));
    end;

%     if mdp_VERBOSE; disp('  Iteration  Number_of_different_actions'); end;
        disp('  Iteration  Number_of_different_actions');

    iter = 0;
    policy = policy0;
    is_done = false;
    while ~is_done
        iter = iter + 1;
        if  (eval_type==0)
            V = mdp_eval_policy_matrix(P,PR,discount,policy);
        else
            V = mdp_eval_policy_iterative(P,PR,discount,policy);
        end;
        [nil, policy_next] = mdp_bellman_operator(P,PR,discount,V);

	n_different = sum(policy_next ~= policy);
%         if mdp_VERBOSE; disp(['       ' num2str(iter) '                 '  num2str(n_different)]); end;
        disp(['       ' num2str(iter) '                 '  num2str(n_different)]);

        if all(policy_next==policy) || iter == max_iter || (iter > 20 && n_different <=5)
            is_done = true;
        else
            policy = policy_next;
        end;
    end;

end;

cpu_time = cputime - cpu_time;


function c = rdivide(a,b)
% function C=rdivide(A,B)
%
% DESCRIPTION
%   Element-by-element right division
%
% INPUTS
%   A: polynomial
%   B: matrix of constants
%
% OUTPUTS
%   C: polynomial, the result of division.
%
% SYNTAX
%   C= A./B
%     A and B must have the same dimensions unless one
%     is a scalar.  Scalars can be divided with anything.
%   C = rdivide(A,B)
%     Function-call form

% 10/22/2002: PJS  Initial Coding

% Promote a to polynomial
a = polynomial(a);
sza = size(a);

% Promote b to polynomial
b = polynomial(b);
szb = size(b);

if isempty(a) || isempty(b)

    if isempty(a) && all(szb==[1 1])
        % empty./scalar = empty(sza)
        c=polynomial(zeros(sza));
        return;
    elseif isempty(b) && all(sza==[1 1])
        % scalar./empty = empty(szb)
        c=polynomial(zeros(szb));
        return;
    elseif all(sza==szb)
        c=polynomial(zeros(sza));
        return;
    else
        error('Matrix dimensions must agree.');
    end

elseif all(sza==szb) || all(sza==[1 1]) || ...
        all(szb==[1 1])

    % Matrix./Matrix
    degidx = find(b.degmat);
    if ~isempty(degidx)
        error('B must be a constant.');
    end
    b = combine(b);
    bcoef = reshape(b.coefficient,b.matdim);
    c = times(a,1./bcoef);
else

    error('Matrix dimensions must agree');
end


function [yd] = cm2yd(cm)
% Convert length from centimeters to yards.
% Chad A. Greene 2012
yd = cm*0.01093613298338;


function [A uTrue uEst] = buildAlignmentMatrix( zTrue, zEst )
% Given true and estimated label sequence, construct align matrix A
%   where A( ke, kt ) = fraction of labels ke aligned
%                          from ESTIMATED label ke to TRUE label kt
% Note that each ROW of A will sum to 1

uTrue = unique( zTrue );
uEst  = unique( zEst  );

for ue = 1:length( uEst )
    ts = zEst == uEst(ue);
    A(ue,:) = histc( zTrue(ts),  uTrue );
end
A = bsxfun( @rdivide, A, sum(A,2)  );


function erf_test ( )

%*****************************************************************************80
%
%% ERF_TEST tests R4_ERF and R8_ERF.
%
%  Licensing:
%
%    This code is distributed under the GNU LGPL license.
%
%  Modified:
%
%    25 September 2011
%
%  Author:
%
%    John Burkardt
%
  addpath ( '../test_values' );

  fprintf ( 1, '\n' );
  fprintf ( 1, 'ERF_TEST:\n' );
  fprintf ( 1, '  Test ERF_VALUES, R4_ERF R8_ERF\n' );
  fprintf ( 1, '\n' );
  fprintf ( 1, '             X          ERF(X)\n' );
  fprintf ( 1, '                     R4_ERF(X)        Diff\n' );
  fprintf ( 1, '                     R8_ERF(X)        Diff\n' );

  n_data = 0;

  while ( 1 )

    [ n_data, x, fx1 ] = erf_values ( n_data );

    if ( n_data == 0 )
      break
    end

    fx2 = r4_erf ( single ( x ) );
    fx3 = r8_erf ( x );

    fprintf ( 1, '\n' );
    fprintf ( 1, '  %14.4f  %14.6g\n', x, fx1 );
    fprintf ( 1, '                  %14.6g  %14.6g\n', fx2, abs ( fx1 - fx2 ) );
    fprintf ( 1, '                  %14.6g  %14.6g\n', fx3, abs ( fx1 - fx3 ) );

  end

  rmpath ( '../test_values' );

  return
end


function [x]=gdist(a,x)
%[Y] = GDIST(A, X) Guitar Distortion
%
%   GDIST creates a distortion effect like that of
%   an overdriven guitar amplifier. This is a Matlab
%   implementation of an algorithm that was found on
%   www.musicdsp.org.
%
%   A = The amount of distortion.  A
%       should be chosen so that -1<A<1.
%   X = Input.  Should be a column vector
%       between -1 and 1.
%
%coded by: Steve McGovern, date: 09.29.04
%URL: http://www.steve-m.us

k = 2*a/(1-a);
x = (1+k)*(x)./(1+k*abs(x));