scilab/modules/elementary_functions/macros/%sp_gsort.sci

   1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
   2 // Copyright (C) DIGITEO - 2009 - Allan CORNET
   3 // Copyrifht (C) 2012 - Scilab Enterprises - Adeline CARNIS
   4 // Copyright (C) 2012 - 2016 - Scilab Enterprises
   5 // Copyright (C) 2018 - 2020 - Samuel GOUGEON : complete rewritting
   6 //
   7 // This file is hereby licensed under the terms of the GNU GPL v2.0,
   8 // pursuant to article 5.3.4 of the CeCILL v.2.1.
   9 // This file was originally licensed under the terms of the CeCILL v2.1,
  10 // and continues to be available under such terms.
  11 // For more information, see the COPYING file which you should have received
  12 // along with this program.
  13
  14 function [A, k] = %sp_gsort(A, sortype, sortdir, criteria)
  15     lhs = argn(1)
  16     k = 0
  17
  18     // ===================
  19     // CHECKING PARAMETERS
  20     // ===================
  21     if ~isdef("sortype", "l") then
  22         sortype = "g"
  23     else
  24         sortype = convstr(sortype(1))
  25         if ~or(sortype == ["g", "r", "c", "lr", "lc"]) then
  26             msg = _("%s: Argument #%d: Must be in the set {%s}.\n")
  27             error(msprintf(msg, "gsort", 2, """g"",""r"",""c"",""lr"",""lc"""))
  28         end
  29     end
  30     if ~isdef("sortdir", "l")
  31         sortdir = "d"
  32     else
  33         sortdir = convstr(sortdir)
  34         if and(sortdir <> "d" & sortdir <> "i") then
  35             msg = _("%s: Argument #%d: Must be in the set {%s}.\n")
  36             error(msprintf(msg, "gsort", 3, """i"",""d"""))
  37         end
  38         if ~isdef("criteria","l")
  39             sortdir = sortdir(1)
  40         end
  41     end
  42
  43     // ==========
  44     // PROCESSING
  45     // ==========
  46     if sortype=="c"
  47         A = A.'
  48     end
  49     // Gets non zero values by increasing linearized indices:
  50     [ij, v, mn] = spget(A.');
  51     ij = ij(:,[2 1]);
  52     mn = mn([2 1]);
  53
  54     s = prod(mn)
  55
  56     // ------------------------
  57     // "g" general sorting mode
  58     // ------------------------
  59     if sortype=="g" then
  60         v($+1) = 0        // To get the position of all sorted implicit zeros
  61         ij($+1,:) = [mn(1)+1 1]  // (the value does not matter)
  62
  63         // Sorting non zero values:
  64         if lhs == 1 then
  65             if ~isdef("criteria", "l")
  66                 v = gsort(v, "g", sortdir)
  67             else
  68                 v = gsort(v, "g", sortdir, criteria)
  69             end
  70         else
  71             if ~isdef("criteria", "l")
  72                 [v, ks] = gsort(v, "g", sortdir)
  73             else
  74                 [v, ks] = gsort(v, "g", sortdir, criteria)
  75             end
  76         end
  77
  78         kz = find(v==0)  // Here is the position of zeros
  79         v(kz) = []       // Cleaning
  80         K = [ 1:kz-1  s-length(v)+kz:s]  // We build K
  81         Ain = A
  82         A = sparse(ind2sub(mn,K), v, mn) // We build the sorted sparse
  83         // Building the dense matrix of initial indices of sorted elements
  84         // A new "sparse_k" option could be implemented later to return a sparse k
  85         if lhs==2
  86             ks(kz) = []
  87             k = zeros(A);
  88             k(K) = sub2ind(mn, ij(ks,:));
  89             k(k==0) = find(Ain(:)==0)
  90             k = matrix(k, size(A))
  91         end
  92         return
  93     end
  94
  95     // -------------------------------------
  96     // Sorting inside rows or inside columns
  97     // -------------------------------------
  98     if or(sortype==["r" "c"]) then   // "r" sorts rows of each column
  99         a = 2;                       // "c" sorts columns of each row
 100         uc = unique(ij(:,a))
 101         V = []
 102         K = []
 103         Kin = (1:mn(1))'*ones(1,mn(2))
 104         for n = uc'
 105             vec = A(:, n)
 106             if lhs==1
 107                 if ~isdef("criteria", "l")
 108                     v = gsort(vec, "g", sortdir)
 109                 else
 110                     v = gsort(vec, "g", sortdir, criteria)
 111                 end
 112             else
 113                 if ~isdef("criteria", "l")
 114                     [v, k] = gsort(vec, "g", sortdir)
 115                 else
 116                     [v, k] = gsort(vec, "g", sortdir, criteria)
 117                 end
 118             end
 119             [tmp, v] = spget(v);
 120             tmp(:, a) = n
 121             K = [K ; tmp]
 122             V = [V ; v]
 123             if lhs>1
 124                 Kin(:,n) = k(:)
 125             end
 126         end
 127         A = sparse(K, V, mn);
 128         if lhs>1
 129             k = matrix(Kin, mn);
 130         end
 131         if sortype=="c"
 132             A = A.'
 133             k = k.'
 134         end
 135         return
 136     end
 137
 138     // ---------------------
 139     // Lexicographic sorting
 140     // ---------------------
 141     msg = _("%s: Argument #%d: Complex sparse not yet supported in ""%s"" mode.\n")
 142
 143     // Vector = special simple case
 144     // ----------------------------
 145     if isvector(A) then
 146         isRow = isrow(A)
 147         if (isRow & sortype=="lr") | (iscolumn(A) & sortype=="lc")
 148             k = 1
 149         else
 150             if lhs==1
 151                 if ~isdef("criteria", "l")
 152                     A = gsort(A(:), "g", sortdir)
 153                 else
 154                     A = gsort(A(:), "g", sortdir, criteria)
 155                 end
 156             else
 157                 if ~isdef("criteria", "l")
 158                     [A, k] = gsort(A(:), "g", sortdir)
 159                 else
 160                     [A, k] = gsort(A(:), "g", sortdir, criteria)
 161                 end
 162             end
 163             if isRow
 164                 A = matrix(A, 1, -1)
 165                 k = matrix(k, 1, -1)
 166             end
 167         end
 168         return
 169     end
 170
 171     // "lr" case
 172     // ---------
 173     if sortype=="lc" then
 174         A = A.'
 175     end
 176     if ~isdef("criteria", "l")
 177         [A, k] = %sp_gsort_lr(A, sortdir);
 178     else
 179         [A, k] = %sp_gsort_lr(A, sortdir, criteria);
 180     end
 181     if sortype == "lc" then
 182         A = A.'
 183         k = matrix(k, 1, -1)
 184     end
 185 endfunction
 186
 187 // ===================================================================
 188
 189 function [S, K] = %sp_gsort_lr(S, order, criteria)
 190     [nr,nc] = size(S)
 191     K = (1:nr)'
 192     crit = isdef("criteria","l")
 193
 194     // List of column according to which sorting must be done
 195     J = 1:nc
 196         // We ignore columns that are uniform. Sorting them is useless
 197     Std = sum(S.^2,"r")/nr - (sum(S,"r")/nr).^2
 198     J(Std==0) = []
 199
 200     // Processing (bulky. A more clever algo required (but hard))
 201     for j = J($:-1:1)
 202         if crit
 203             [?, k] = gsort(S(K, j), "g", order, criteria)
 204         else
 205             [?, k] = gsort(S(K, j), "g", order)
 206         end
 207         K = K(k,1)
 208     end
 209     S = S(K,:)
 210 endfunction