home *** CD-ROM | disk | FTP | other *** search
/ Liren Large Software Subsidy 10 / 10.iso / l / l455 / 2.ddi / MUTOOLS1.DI$ / SWAPIV.M < prev    next >
Encoding:
Text File  |  1993-03-11  |  2.5 KB  |  88 lines
  1. % function matout = swapiv(matin,alpha)
  2. %
  3. %  Exchanges the order of nested levels of INDEPENDENT
  4. %  VARIABLEs for generalized VARYING matrices.
  5. %
  6. %  See also: VEVAL.
  7.  
  8.  function matout = swapiv(matin,alpha)
  9.   if nargin<2
  10.     disp('usage: matout = swapiv(matin,alpha)');
  11.     return;
  12.   end
  13.   [nra,nca] = size(alpha);
  14.   niv = nca;
  15.   if nra ~= 1
  16.     if nca ~= 1
  17.       error('ALPHA should be a row vector')
  18.       return
  19.     else
  20.       alpha = alpha.';
  21.       niv = nra;
  22.     end
  23.   end
  24.   if sort(alpha) ~= 1:niv
  25.     error('ALPHA should contain all integers from 1 to LENGTH(ALPHA)');
  26.     return
  27.   end
  28.   tmat = matin;
  29.   betaorig = [];
  30.   for i=1:niv
  31.     [type,rows,cols,num] = minfo(tmat);
  32.     if strcmp(type,'vary')
  33.       betaorig = [betaorig num];     %  [slowest ... fastest]
  34.       tmat = tmat(1:rows,1:cols);    %  XTRACTI(TMAT,1)
  35.     else
  36.       error('insufficient levels of VARYING data were found')
  37.       return
  38.     end
  39.   end
  40.   liv = betaorig(alpha);    % reqrranged IV lengths
  41.   cliv = betaorig;        % original iv lengths [slow ... fast]
  42.   basicrow = rows;
  43.   basiccol = cols;
  44.  
  45.   nummat = liv(niv);
  46.   nblanks = 1;
  47.   prd = 1;                     % no blank lines for the fastest
  48.   facbac = zeros(niv,1);        % factorial bacwards
  49.   gammai = zeros(niv,1);        % index for matin
  50.   gammam = zeros(niv,1);        % index for matin
  51.   facbac(1) = 1;
  52.   gammai(niv) = basicrow;
  53.   gammam(niv) = basicrow;
  54.   for i=1:niv-1
  55.     facbac(i+1) = facbac(i)*liv(i);    %facbac(k)=liv(k-1)*...*liv(1)
  56.     nummat = nummat*liv(i);
  57.     prd = prd*liv(i);
  58.     nblanks = nblanks + prd;
  59.     gammai(niv-i) = gammai(niv-i+1)*cliv(niv-i+1) + 1;
  60.     gammam(niv-i) = gammam(niv-i+1)*liv(niv-i+1) + 1;
  61.   end
  62.  
  63.   cdim = basiccol + niv;
  64.   rdim = basicrow*nummat + nblanks;
  65.   matout = zeros(rdim,cdim);
  66.  
  67.   index = [1:basicrow]';
  68.   mask = [1:basicrow]';
  69.   for i=1:niv
  70.     index = ksum([0:cliv(alpha(niv-i+1))-1]'*gammai(alpha(niv-i+1)),index);
  71.     mask = ksum([0:liv(niv-i+1)-1]'*gammam(niv-i+1),mask);
  72.   end
  73.   matout(mask,1:cols) = matin(index,1:cols);
  74.  
  75.   loc = 0;
  76.   insert = ksum(loc,[1:liv(1)]');
  77.   matout(insert,cdim) = matin(1:liv(1),basiccol+niv-alpha(1)+1);
  78.   matout(rdim,cdim-1:cdim) = [liv(1) inf];
  79.   for i=2:niv
  80.     loc = ksum([0:liv(i-1)-1]'*gammam(i-1),loc);
  81.     insert = ksum(loc,[1:liv(i)]');
  82.     matout(insert,cdim-i+1)=kron(ones(facbac(i),1),matin(1:liv(i),basiccol+niv-alpha(i)+1));
  83.     locc = loc + gammam(i-1);
  84.     matout(locc,cdim-i:cdim-i+1) = ones(facbac(i),1)*[liv(i) inf];
  85.   end
  86. %
  87. % Copyright MUSYN INC 1991,  All Rights Reserved
  88.