45c3f7082c26fed83d1e54c94e6cf72ca1f8e74e
[scilab.git] / scilab / modules / elementary_functions / macros / unique.sci
1 // Scilab ( http://www.scilab.org/ ) - This file is part of Scilab
2 // Copyright (C) INRIA
3 // Copyright (C) 2012 - 2016 - Scilab Enterprises
4 // Copyright (C) 2018, 2019 - Samuel GOUGEON
5 //
6 // This file is hereby licensed under the terms of the GNU GPL v2.0,
7 // pursuant to article 5.3.4 of the CeCILL v.2.1.
8 // This file was originally licensed under the terms of the CeCILL v2.1,
9 // and continues to be available under such terms.
10 // For more information, see the COPYING file which you should have received
11 // along with this program.
12
13 function [x, k, nb] = unique(x, varargin)
14     // extract unique components of a vector
15     // varargin : orient=1|2|"r"|"c", "uniqueNan", "keepOrder"
16     //
17     // History:
18     // * 2019 - S. Gougeon :
19     //   - add uniqueNan option: http://bugzilla.scilab.org/15522
20     //   - add keepOrder option: http://bugzilla.scilab.org/15795
21     //   - add nb output option: http://bugzilla.scilab.org/8418
22
23     keepOrder = %f
24     uniqueNan = %f
25     orient = "*"
26     newInf = [] // init Inf substitute in case of "uniqueNan" and or(x==%inf)
27     k = []
28     nb = []
29
30     // CHECKING INPUT ARGUMENTS
31     // ------------------------
32     in = varargin
33     i = 2;  // index of the current input argument
34     if size(in)>0 then
35         a = in(1)
36         if typeof(a)=="string"
37             a = convstr(a)
38         end
39         select a
40         case 1
41             orient = "r"
42         case 2
43             orient = "c"
44         case "uniquenan"
45             uniqueNan = %t
46         case "keeporder"
47             keepOrder = %t
48         case "r"
49             orient = "r"
50         case "c"
51             orient = "c"
52         else
53             msg = _("%s: Argument #%d: Must be in the set {%s}.\n")
54             error(msprintf(msg, "unique", i, "1,2,""r"",""c"",""keepOrder"",""uniqueNan"""))
55         end
56         in(1) = null()
57         i = 3
58     end
59     while size(in)>0 & i<5 then
60         a = in(1)
61         if typeof(a)=="string"
62             a = convstr(a)
63         end
64         select a
65         case "uniquenan"
66             uniqueNan = %t
67         case "keeporder"
68             keepOrder = %t
69         else
70             msg = _("%s: Argument #%d: Must be in the set {%s}.\n")
71             error(msprintf(msg, "unique", i, """keepOrder"",""uniqueNan"""))
72         end
73         in(1) = null()
74         i = i+1
75     end
76     uniqueNan = uniqueNan & or(type(x)==[1 5])
77
78     sz = size(x);
79     if size(x, orient)==1 then
80         k = 1
81         return
82     end
83     if uniqueNan
84         [x, newInf] = uniqueProcessNan(x, [], "removeNan")
85     end
86     getK = argn(1)>1 | keepOrder
87
88
89     // [] trivial case
90     // ---------------
91     if isempty(x) then
92         return  // k, nb are already []. x is [] or sparse([])
93     end
94
95     // PROCESSING complex numbers
96     // --------------------------
97     if or(type(x)==[1 5]) then
98         if ~isreal(x)
99             if isreal(x,0)
100                 x = real(x);
101             else
102                 if orient=="*"
103                     x = [real(x(:)) imag(x(:))]
104                     if ~getK
105                         x = unique(x,"r")
106                     else
107                         [x, k, nb] = unique(x,"r")
108                     end
109                     x = complex(x(:,1),x(:,2));
110                     if sz(1)==1 // => put results in row
111                         x = x.'
112                         if getK
113                             k = k'
114                             nb = nb'
115                         end
116                     end
117                 elseif orient=="r" | orient==1
118                     x = [real(x) imag(x)]
119                     if ~getK
120                         x = unique(x,"r")
121                     else
122                         [x, k, nb] = unique(x,"r")
123                     end
124                     x = complex(x(:,1:sz(2)), x(:,sz(2)+1:$));
125                 elseif orient=="c" | orient==2
126                     x = [real(x) ; imag(x)]
127                     if ~getK
128                         x = unique(x,"c")
129                     else
130                         [x, k, nb] = unique(x,"c")
131                     end
132                     x = complex(x(1:sz(1),:), x(sz(1)+1:$,:));
133                 end
134                 if uniqueNan
135                     x = uniqueProcessNan(x, newInf, "restoreNan")
136                 end
137                 if keepOrder
138                     [k, kk] = gsort(k,"g","i")
139                     select orient
140                     case "*"
141                         x = x(kk)
142                     case "r"
143                         x = x(kk,:)
144                     case "c"
145                         x = x(:,kk)
146                     end
147                     nb = nb(kk)
148                 end
149                 return
150             end
151         end
152     end
153
154     // PROCESSING text and other numerical types
155     // -----------------------------------------
156     if orient=="*" then
157         if getK then
158             [x,k] = gsort(x,"g","i");
159             keq = x(2:$) == x(1:$-1);
160             if argn(1)>2
161                 nb = [0 find(~keq) size(x,"*")]
162                 nb = nb(2:$) - nb(1:$-1)
163             end
164             keq = find(keq);
165             if keq<>[] then keq = keq+1;end
166             x(keq) = [];
167             k(keq) = [];
168             if size(x,1)>1 | ndims(x)>2
169                 x = x(:)
170                 k = k(:)
171                 nb = nb(:)
172             end
173         else
174             x = gsort(x,"g","d");
175             x = x($:-1:1);
176             x( find(x(2:$) == x(1:$-1)) ) = [];
177         end
178     elseif  orient==1|orient=="r" then
179         if getK then
180             [x,k] = gsort(x,"lr","i");
181             keq = and(x(2:$,:) == x(1:$-1,:),"c")
182             if argn(1)>2
183                 nb = [0 find(~keq) size(x,1)]
184                 nb = nb(2:$) - nb(1:$-1)
185                 nb = nb(:)
186             end
187             keq = find(keq)
188             if keq<>[] then keq = keq+1;end
189             x(keq,:) = [];
190             k(keq,:) = [];
191         else
192             x = gsort(x,"lr","i");
193             x( find(and(x(2:$,:) == x(1:$-1,:),"c")),:) = [];
194         end
195     elseif  orient==2|orient=="c" then
196         if getK then
197             [x,k] = gsort(x,"lc","i");
198             keq = and(x(:,2:$) == x(:,1:$-1),"r")
199             if argn(1)>2
200                 nb = [0 find(~keq) size(x,2)]
201                 nb = nb(2:$) - nb(1:$-1)
202             end
203             keq = find(keq)
204             if keq<>[] then keq = keq+1;end
205             x(:,keq) = [];
206             k(:,keq) = [];
207         else
208             x = gsort(x,"lc","i");
209             x(:, find(and(x(:,2:$) == x(:,1:$-1),"r")) ) = [];
210         end
211     end
212     if uniqueNan
213         x = uniqueProcessNan(x, newInf, "restoreNan")
214     end
215     if keepOrder
216         [k, kk] = gsort(k,"g","i")
217         select orient
218         case "*"
219             x = x(kk)
220         case "r"
221             x = x(kk,:)
222         case "c"
223             x = x(:,kk)
224         end
225         if argn(1)>2
226             nb = nb(kk)
227         end
228     end
229 endfunction
230 // -------------------------------------------------------------------
231
232 // To consider Nan mutually equal, we replace all of them with a "regular" substitute.
233 // Since Nan are sorted as > Inf, we must use anyway Inf as the Nan substitute.
234 // If the original array have already some Inf, we must priorly replace them with
235 // a decimal greater than the finite maximum of the array values.
236 // After processing, we restore Inf => Nan (, and maxNum => Inf).
237
238 function [x, newInf] = uniqueProcessNan(x, newInf, way)
239
240     if way=="removeNan" & or(isnan(x)) then 
241         // Replacing Nan
242         // -------------
243         if isreal(x)
244             if or(x==%inf)
245                 b = x==%inf
246                 m = max([1 max(x(~b))])
247                 newInf = m*1.5
248                 x(b) = newInf
249             end
250             x(x<>x) = %inf
251         else
252             r = real(x)
253             i = imag(x)
254             if or([r i]==%inf)
255                 br = r==%inf
256                 m = max(r(~br),1)
257                 bi = i==%inf
258                 m = max(i(~bi),m,1)
259                 newInf = m*1.5
260                 r(br) = newInf
261                 i(bi) = newInf
262             end
263             r(r<>r) = %inf
264             i(i<>i) = %inf
265             x = complex(r,i);
266         end
267
268     // Restoring  NaN
269     // --------------
270     elseif way=="restoreNan"
271         if isreal(x)
272             x(x==%inf) = %nan
273             if newInf~=[]
274                 x(x==newInf) = %inf
275             end
276         else
277             r = real(x)
278             r(r==%inf) = %nan
279             i = imag(x)
280             i(i==%inf) = %nan
281             if newInf~=[]
282                 r(r==newInf) = %inf
283                 i(i==newInf) = %inf
284             end
285             x = complex(r, i)
286         end
287     end
288 endfunction