Gecko [ fernandoquevedodop.com ]

Name	Size	Permission
cmaps	[ DIR ]	drwxr-xr-x
help	[ DIR ]	drwxr-xr-x
rline	[ DIR ]	drwxr-xr-x
scripts	[ DIR ]	drwxr-xr-x
arrayfuns.sl	1.85 KB	-rw-r--r--
autoload.sl	460 B	-rw-r--r--
base64.sl	19 B	-rw-r--r--
chksum.sl	1.58 KB	-rw-r--r--
cmdopt.sl	7.58 KB	-rw-r--r--
csv.sl	16.35 KB	-rw-r--r--
fcntl.sl	35 B	-rw-r--r--
fork.sl	17 B	-rw-r--r--
fswalk.sl	2.36 KB	-rw-r--r--
glob.sl	2.42 KB	-rw-r--r--
histogram.sl	2.98 KB	-rw-r--r--
iconv.sl	35 B	-rw-r--r--
json.sl	5.97 KB	-rw-r--r--
listfuns.sl	3.04 KB	-rw-r--r--
onig.sl	17 B	-rw-r--r--
pcre.sl	1.21 KB	-rw-r--r--
png.sl	4.02 KB	-rw-r--r--
print.sl	7.61 KB	-rw-r--r--
process.sl	9.83 KB	-rw-r--r--
profile.sl	19.88 KB	-rw-r--r--
rand.sl	4.28 KB	-rw-r--r--
readascii.sl	5.24 KB	-rw-r--r--
require.sl	1.27 KB	-rw-r--r--
select.sl	37 B	-rw-r--r--
setfuns.sl	4.8 KB	-rw-r--r--
sldb.sl	2.11 KB	-rw-r--r--
sldbcore.sl	18.1 KB	-rw-r--r--
sldbsock.sl	7.43 KB	-rw-r--r--
slshhelp.sl	536 B	-rw-r--r--
slshrl.sl	9.23 KB	-rw-r--r--
slsmg.sl	35 B	-rw-r--r--
socket.sl	151 B	-rw-r--r--
stats.sl	15.07 KB	-rw-r--r--
stkcheck.sl	2.62 KB	-rw-r--r--
structfuns.sl	2.05 KB	-rw-r--r--
sysconf.sl	20 B	-rw-r--r--
termios.sl	39 B	-rw-r--r--
varray.sl	37 B	-rw-r--r--
zlib.sl	2.93 KB	-rw-r--r--

Code Editor : setfuns.sl

% Functions that operate on sets in the form of arrays and lists:
% Copyright (C) 2010-2017,2018 John E. Davis
%
% This file is part of the S-Lang Library and may be distributed under the
% terms of the GNU General Public License.  See the file COPYING for
% more information.
%
%  Functions: unique, union, complement, intersection, ismember
private define pop_set_object ()
{
   variable a = ();
   if ((typeof(a) != Array_Type) && (typeof(a) != List_Type))
     a = [a];
   return a;
}

private define list_unique (a)
{
   variable len = length(a);
   variable indices = Int_Type[len];
   variable i, j, k;

k = 0;
   _for i (0, len-1, 1)
     {
	variable a_i = a[i];
	_for j (0, i-1, 1)
	  {
	     if (_eqs(a_i, a[j]))
	       break;
	  }
	then
	  {
	     indices[k] = i;
	     k++;
	  }
     }
   return indices[[0:k-1]];
}

define unique ()
{
   variable i, j, len;
   variable a;

if (_NARGS != 1)
     {
	_pop_n (_NARGS);
	usage ("i = unique (a); %% i = indices of unique elements of a");
     }

a = pop_set_object ();
   if (typeof(a) == List_Type)
     {
	try
	  {
	     a = list_to_array (a);
	  }
	catch AnyError: return list_unique (a);
     }

len = length(a);
   if (len <= 1)
     return [0:len-1];

if (length(array_shape(a)) != 1)
     a = _reshape (__tmp(a),[len]);

try
     {
	i = array_sort(a);
     }
   catch AnyError: return list_unique (a);

a = a[i];
   if (a[0] == a[-1])		       %  all equal
     return [0];
   j = where (shift(a,-1)!=a);
   % Now, i contains the sorted indices, and j contains the indices into the
   % sorted array.  So, the unique elements are given by a[i][j] where a is
   % the original input array.  It seems amusing that the indices given by
   % [i][j] are also given by i[j].
   return i[__tmp(j)];
}

define union ()
{
   !if (_NARGS)
     usage ("U = union (A, B, ..., C);");

variable args = {}, obj;
   variable has_list = 0;
   loop (_NARGS)
     {
	has_list += (typeof (obj) == List_Type);
	obj = pop_set_object ();
	list_insert (args, obj);
     }

variable a = NULL;
   if (has_list == 0)
     {
	try
	  {
	     a = [__push_list (args)];
	  }
	catch AnyError:;
     }

if (a == NULL)
     {
	a = {};
	foreach obj (args)
	  {
	     if (typeof(obj) == List_Type)
	       {
		  list_join (a, obj);
		  continue;
	       }
	     foreach (obj)
	       {
		  variable x = ();
		  list_append (a, x);
	       }
	  }
     }
   return a[unique (a)];
}

% return indices of a that are not in b
private define list_complement (a, b)
{
   variable lena = length(a), lenb = length(b);
   variable indices = Int_Type[lena];
   variable i, j, k;

k = 0;
   _for i (0, lena-1, 1)
     {
	variable a_i = a[i];
	_for j (0, lenb-1, 1)
	  {
	     if (_eqs(a_i, b[j]))
	       break;
	  }
	then
	  {
	     indices[k] = i;
	     k++;
	  }
     }
   return indices[[0:k-1]];
}

define complement ()
{
   variable a, b;
   if (_NARGS != 2)
     usage ("\
i = complement (a, b);\n\
%% Returns the indices of the elements of `a' that are not in `b'");

b = pop_set_object ();
   a = pop_set_object ();

variable
     lena = length(a),
     lenb = length(b);

if ((lena == 0) || (lenb == 0))
     return [0:lena-1];

variable sia, sib;
   try
     {
	if (typeof (a) == List_Type)
	  a = list_to_array (a);
	if (typeof (b) == List_Type)
	  b = list_to_array (b);
	sia = array_sort (a);
	sib = array_sort (b);
     }
   catch AnyError:
     return list_complement (a, b);

variable
     c = Int_Type [lena], j = 0,
     ia, ib, xa, xb, k;

ia = 0; ib = 0;
   xb = b[sib[ib]];
   while (ia < lena)
     {
	k = sia[ia];
	xa = a[k];
	if (xa < xb)
	  {
	     c[j] = k;
	     j++;
	     ia++;
	     continue;
	  }
	if (xb == xa)
	  {
	     ia++;
	     continue;
	  }

while (ib++, (ib < lenb) && (xa > b[sib[ib]]))
	  ;
	if (ib == lenb)
	  {
	     variable n = lena-ia;
	     c[[j:j+n-1]] = sia[[ia:lena-1]];
	     j += n;
	     break;
	  }
	xb = b[sib[ib]];
	if (xa == xb)
	  ia++;
     }
   return c[[0:j-1]];
}

% Return the indices into a of the common elements of both a and b
define intersection ()
{
   if (_NARGS < 2)
     usage ("\
i = intersection (a, b, .., c);\n\
%% Returns the indices of 'a' of the common elements of b,.., c");

variable b = pop_set_object ();
   loop (_NARGS-1)
     {
	variable a = pop_set_object ();
	variable i = complement (a, __tmp(b));
	i = complement (a, a[i]);
	b = a[i];
     }
   return i;
}

% Returns whether or not a is a member of b.
define ismember ()
{
   if (_NARGS != 2)
     usage ("I = ismember (a, b);\n\
Returns a boolean array indicated whether the corresponding elements of 'a'\n\
are members of 'b'");

variable a, b;
   (a, b) = ();
   if ((typeof(a) == Array_Type) || (typeof(a) == List_Type))
     {
	variable lena = length (a);
	variable result = Char_Type[lena];
	result[intersection(a,b)] = 1;
	return result;
     }
   return 0 != length (intersection (a, b));
}

${this.title}

Code Editor : setfuns.sl