* Bugs 15838 15839 15842 16452 16454 fixed: gsort() for all sparse in all modes
[scilab.git] / 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