sequence utilities #33

Parent #79Owner #36Flags readSource RPG Core/rpgcore-patched.db

Aliases: sequence utilities, seq_utils, squ

21 verbs · 6 properties · 0 children

Verbs

VerbSpecFlagsDefinerLines
add removethis none thisrxd#3313
containsthis none thisrxd#332
complementthis none thisrxd#3316
unionthis none thisrxd#338
tostrthis none thisrxd#3311
forthis none thisrxd#3326
extractthis none thisrxd#3315
tolistthis none thisrxd#3315
from_listthis none thisrxd#332
from_sorted_listthis none thisrxd#3314
firstthis none thisrxd#331
lastthis none thisrxd#331
sizethis none thisrxd#337
from_stringthis none thisrxd#3336
firstnthis none thisrxd#3315
lastnthis none thisrxd#3316
rangethis none thisrxd#332
expandthis none thisrxd#3360
contractthis none thisrxd#3344
_unionthis none thisrxd#3397
intersectionthis none thisrxd#338

Properties

PropertyDefinerFlagsOwnerValue
help_msg#79rc#36
list of 37{"A sequence is a set of integers (*)", "This package supplies the following verbs:", "", " :add (seq,f,t) => seq with [f..t] interval added", " :remove (seq,f,t) => seq with [f..t] interval removed", " :range (f,t) => sequence corresponding to [f..t]", " {} => empty sequence", " :contains (seq,n) => n in seq", " :size (seq) => number of elements in seq", " :first (seq) => first integer in seq or E_NONE", " :firstn (seq,n) => first n integers in seq (as a sequence)", " :last (seq) => last integer in seq or E_NONE", " :lastn (seq,n) => last n integers in seq (as a sequence)", "", " :complement(seq) => sequence consisting of integers not in seq", " :union (seq,seq,...) => union of all sequences", " :intersect(seq,seq,...) => intersection of all sequences", " :contract (seq,cseq) (see `help $seq_utils:contract')", " :expand (seq,eseq[,include]) (see `help $seq_utils:expand')", " ", " :extract(seq,array) => array[@seq]", " :for([n,]seq,obj,verb,@args) => for s in (seq) obj:verb(s,@args); endfor", "", " :tolist(seq) => list corresponding to seq", " :tostr(seq) => contents of seq as a string", " :from_list(list) => sequence corresponding to list", " :from_sorted_list(list) => sequence corresponding to list (assumed sorted)", " :from_string(string) => sequence corresponding to string", "", "For boolean expressions, note that", " the representation of the empty sequence is {} (boolean FALSE) and", " all non-empty sequences are represented as nonempty lists (boolean TRUE).", "", "The representation used works better than the usual list implementation for sets consisting of long uninterrupted ranges of integers. ", "For sparse sets of integers the representation is decidedly non-optimal (though it never takes more than double the space of the usual list representation).", "", "(*) i.e., integers in the range [$minint+1..$maxint]. The implementation depends on $minint never being included in a sequence."}
key#1c#36<clear>
aliases#1rc#36{"sequence utilities", "seq_utils", "squ"}
description#1rc#36{"This is the sequence utilities utility package. See `help $seq_utils' for more details."}
object_size#1r#36{18436, -1090650497}
html#1rc#36<clear>

Ancestry

Ancestors (nearest first): #79 Generic Utilities Package → #1 Root Class

Children: none

Call graph

calls n33_0 #33:add n55_6 #55:find_insert n33_0->n55_6 n33_1 #33:contains n33_1->n55_6 n33_3 #33:union n55_9 #55:setremove_all n33_3->n55_9 n33_19 #33:_union n33_3->n33_19 n33_19->n55_6 n33_6 #33:extract n33_6->n55_6 n33_8 #33:from_list n33_9 #33:from_sorted_list n33_8->n33_9 n55_14 #55:sort n33_8->n55_14 n33_13 #33:from_string n33_13->n33_3 n20_38 #20:explode n33_13->n20_38 n20_12 #20:strip_chars n33_13->n20_12 n20_24 #20:is_integer n33_13->n20_24 n33_17 #33:expand n33_17->n55_6 n33_18 #33:contract n33_18->n55_6 n33_20 #33:intersection n33_20->n55_9 n33_20->n33_19 n33_2 #33:complement n33_20->n33_2 n55_4 #55:map_arg n33_20->n55_4

Source

add remove

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1"   add(seq,start[,end]) => seq with range added.";
2"remove(seq,start[,end]) => seq with range removed.";
3"  both assume start<=end.";
4remove = verb == "remove";
5seq = args[1];
6start = args[2];
7s = (start == $minint) ? 1 | $list_utils:find_insert(seq, start - 1);
8if (length(args) < 3)
9return {@seq[1..s - 1], @((s + remove) % 2) ? {start} | {}};
10else
11e = $list_utils:find_insert(seq, after = args[3] + 1);
12return {@seq[1..s - 1], @((s + remove) % 2) ? {start} | {}, @((e + remove) % 2) ? {after} | {}, @seq[e..$]};
13endif

contains

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

none

Source

1":contains(seq,elt) => true iff elt is in seq.";
2return ($list_utils:find_insert(@args) + 1) % 2;

complement

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1":complement(seq[,lower[,upper]]) => the sequence containing all integers *not* in seq.";
2"If lower/upper are given, the resulting sequence is restricted to the specified range.";
3"Bad things happen if seq is not a subset of [lower..upper]";
4{seq, ?lower = $minint, ?upper = $nothing} = args;
5if (upper != $nothing)
6if (seq[$] >= (upper = upper + 1))
7seq[$..$] = {};
8else
9seq[$ + 1..$] = {upper};
10endif
11endif
12if (seq && (seq[1] <= lower))
13return listdelete(seq, 1);
14else
15return {lower, @seq};
16endif

union

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1":union(seq1,seq2,...)        => union of all sequences...";
2if ({} in args)
3args = $list_utils:setremove_all(args, {});
4endif
5if (length(args) <= 1)
6return args ? args[1] | {};
7endif
8return this:_union(@args);

tostr

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1"tostr(seq [,delimiter]) -- turns a sequence into a string, delimiting ranges with delimiter, defaulting to .. (e.g. 5..7)";
2{seq, ?separator = ".."} = args;
3if (!seq)
4return "empty";
5endif
6e = tostr((seq[1] == $minint) ? "" | seq[1]);
7len = length(seq);
8for i in [2..len]
9e = e + ((i % 2) ? tostr(", ", seq[i]) | ((seq[i] == (seq[i - 1] + 1)) ? "" | tostr(separator, seq[i] - 1)));
10endfor
11return e + ((len % 2) ? separator | "");

for

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

none

Source

1":for([n,]seq,obj,verb,@args) => for s in (seq) obj:verb(s,@args); endfor";
2if (typeof(n = args[1]) == INT)
3args = listdelete(args, 1);
4else
5n = 1;
6endif
7{seq, object, vname, @args} = args;
8if (seq[1] == $minint)
9return E_RANGE;
10endif
11for r in [1..length(seq) / 2]
12for i in [seq[(2 * r) - 1]..seq[2 * r] - 1]
13if (typeof(object:(vname)(@listinsert(args, i, n))) == ERR)
14return;
15endif
16endfor
17endfor
18if (length(seq) % 2)
19i = seq[$];
20while (1)
21if (typeof(object:(vname)(@listinsert(args, i, n))) == ERR)
22return;
23endif
24i = i + 1;
25endwhile
26endif

extract

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1"extract(seq,array) => list of elements of array with indices in seq.";
2{seq, array} = args;
3if (alen = length(array))
4e = $list_utils:find_insert(seq, 1);
5s = $list_utils:find_insert(seq, alen);
6seq = {@(e % 2) ? {} | {1}, @seq[e..s - 1], @(s % 2) ? {} | {alen + 1}};
7ret = {};
8for i in [1..length(seq) / 2]
9(ticks_left() < 4000) && suspend(0);
10ret = {@ret, @array[seq[(2 * i) - 1]..seq[2 * i] - 1]};
11endfor
12return ret;
13else
14return {};
15endif

tolist

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

none

Source

1seq = args[1];
2if (!seq)
3return {};
4else
5if (length(seq) % 2)
6seq = {@seq, $minint};
7endif
8l = {};
9for i in [1..length(seq) / 2]
10for j in [seq[(2 * i) - 1]..seq[2 * i] - 1]
11l = {@l, j};
12endfor
13endfor
14return l;
15endif

from_list

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1":fromlist(list) => corresponding sequence.";
2return this:from_sorted_list($list_utils:sort(args[1]));

from_sorted_list

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1":from_sorted_list(sorted_list) => corresponding sequence.";
2if (!(lst = args[1]))
3return {};
4else
5seq = {i = lst[1]};
6next = i + 1;
7for i in (listdelete(lst, 1))
8if (i != next)
9seq = {@seq, next, i};
10endif
11next = i + 1;
12endfor
13return (next == $minint) ? seq | {@seq, next};
14endif

first

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1return (seq = args[1]) ? seq[1] | E_NONE;

last

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1return (seq = args[1]) ? (length(seq) % 2) ? $minint - 1 | (seq[$] - 1) | E_NONE;

size

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1":size(seq) => number of elements in seq";
2"  for sequences consisting of more than half of the 4294967298 available integers, this returns a negative number, which can either be interpreted as (cardinality - 4294967298) or -(size of complement sequence)";
3n = 0;
4for i in (seq = args[1])
5n = i - n;
6endfor
7return (length(seq) % 2) ? $minint - n | n;

from_string

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1":from_string(string) => corresponding sequence or E_INVARG";
2"  string should be a comma separated list of numbers and";
3"  number..number ranges";
4su = $string_utils;
5if (!(words = su:explode(su:strip_chars(args[1], " "), ",")))
6return {};
7endif
8parts = {};
9for word in (words)
10to = index(word, "..");
11if ((!to) && su:is_numeric(word))
12part = {toint(word), toint(word) + 1};
13elseif (to)
14if (to == 1)
15start = $minint;
16elseif (su:is_numeric(start = word[1..to - 1]))
17start = toint(start);
18else
19return E_INVARG;
20endif
21end = word[to + 2..length(word)];
22if (!end)
23part = {start};
24elseif (!su:is_numeric(end))
25return E_INVARG;
26elseif ((end = toint(end)) >= start)
27part = {start, end + 1};
28else
29part = {};
30endif
31else
32return E_INVARG;
33endif
34parts = {@parts, part};
35endfor
36return this:union(@parts);

firstn

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

none

Source

1":firstn(seq,n) => first n elements of seq as a sequence.";
2if ((n = args[2]) <= 0)
3return {};
4endif
5l = length(seq = args[1]);
6s = 1;
7while (s <= l)
8n = n + seq[s];
9if ((s >= l) || (n <= seq[s + 1]))
10return {@seq[1..s], n};
11endif
12n = n - seq[s + 1];
13s = s + 2;
14endwhile
15return seq;

lastn

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

none

Source

1":lastn(seq,n) => last n elements of seq as a sequence.";
2n = args[2];
3if ((l = length(seq = args[1])) % 2)
4return {$minint - n};
5else
6s = l;
7while (s)
8n = seq[s] - n;
9if (n >= seq[s - 1])
10return {n, @seq[s..l]};
11endif
12n = seq[s - 1] - n;
13s = s - 2;
14endwhile
15return seq;
16endif

range

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1":range(start,end) => sequence corresponding to [start..end] range";
2return ((start = args[1]) <= (end = args[2])) ? {start, end + 1} | {};

expand

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1":expand(seq,eseq[,include=0])";
2"eseq is assumed to be a finite sequence consisting of intervals ";
3"[f1..a1-1],[f2..a2-1],...  We map each element i of seq to";
4"  i               if               i < f1";
5"  i+(a1-f1)       if         f1 <= i < f2-(a1-f1)";
6"  i+(a1-f1+a2-f2) if f2-(a1-f1) <= i < f3-(a2-f2)-(a1-f1)";
7"  ...";
8"returning the resulting sequence if include=0,";
9"returning the resulting sequence unioned with eseq if include=1;";
10{old, insert, ?include = 0} = args;
11exclude = !include;
12if (!insert)
13return old;
14elseif ((length(insert) % 2) || (insert[1] == $minint))
15return E_TYPE;
16endif
17olast = length(old);
18ilast = length(insert);
19"... find first o for which old[o] >= insert[1]...";
20ifirst = insert[i = 1];
21o = $list_utils:find_insert(old, ifirst - 1);
22if (o > olast)
23return ((olast % 2) == exclude) ? {@old, @insert} | old;
24endif
25new = old[1..o - 1];
26oe = old[o];
27diff = 0;
28while (1)
29"INVARIANT: oe == old[o]+diff";
30"INVARIANT: oe >= ifirst == insert[i]";
31"... at this point we need to dispose of the interval ifirst..insert[i+1]";
32if (oe == ifirst)
33new = {@new, insert[i + ((o % 2) == exclude)]};
34if (o >= olast)
35return ((olast % 2) == exclude) ? {@new, @insert[i + 2..ilast]} | new;
36endif
37o = o + 1;
38else
39if ((o % 2) != exclude)
40new = {@new, @insert[i..i + 1]};
41endif
42endif
43"... advance i...";
44diff = (diff + insert[i + 1]) - ifirst;
45if ((i = i + 2) > ilast)
46for oe in (old[o..olast])
47new = {@new, oe + diff};
48endfor
49return new;
50endif
51ifirst = insert[i];
52"... find next o for which old[o]+diff >= ifirst )...";
53while ((oe = old[o] + diff) < ifirst)
54new = {@new, oe};
55if (o >= olast)
56return ((olast % 2) == exclude) ? {@new, @insert[i..ilast]} | new;
57endif
58o = o + 1;
59endwhile
60endwhile

contract

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1":contract(seq,cseq)";
2"cseq is assumed to be a finite sequence consisting of intervals ";
3"[f1..a1-1],[f2..a2-1],...  From seq, we remove any elements that ";
4"are in those ranges and map each remaining element i to";
5"  i               if       i < f1";
6"  i-(a1-f1)       if a1 <= i < f2";
7"  i-(a1-f1+a2-f2) if a2 <= i < f3 ...";
8"returning the resulting sequence.";
9"";
10"For any finite sequence cseq, the following always holds:";
11"  :contract(:expand(seq,cseq,include),cseq)==seq";
12{old, removed} = args;
13if (!removed)
14return old;
15elseif (((rlen = length(removed)) % 2) || (removed[1] == $minint))
16return E_TYPE;
17endif
18rfirst = removed[1];
19ofirst = $list_utils:find_insert(old, rfirst - 1);
20new = old[1..ofirst - 1];
21diff = 0;
22rafter = removed[r = 2];
23for o in [ofirst..olast = length(old)]
24while (old[o] > rafter)
25if ((o - ofirst) % 2)
26new = {@new, rfirst - diff};
27ofirst = o;
28endif
29diff = (diff + rafter) - rfirst;
30if (r >= rlen)
31for oe in (old[o..olast])
32new = {@new, oe - diff};
33endfor
34return new;
35endif
36rfirst = removed[r + 1];
37rafter = removed[r = r + 2];
38endwhile
39if (old[o] < rfirst)
40new = {@new, old[o] - diff};
41ofirst = o + 1;
42endif
43endfor
44return ((olast - ofirst) % 2) ? new | {@new, rfirst - diff};

_union

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1":_union(seq,seq,...)";
2"assumes all seqs are nonempty and that there are at least 2";
3nargs = length(args);
4"args  -- list of sequences.";
5"nexts -- nexts[i] is the index in args[i] of the start of the first";
6"         interval not yet incorporated in the return sequence.";
7"heap  -- a binary tree of indices into args/nexts represented as a list where";
8"         heap[1] is the root and the left and right children of heap[i]";
9"         are heap[2*i] and heap[2*i+1] respectively.  ";
10"         Parent index h is <= both children in the sense of args[h][nexts[h]].";
11"         heap[i]==0 indicates a nonexistant child; we fill out the array with";
12"         zeros so that length(heap)>2*length(args).";
13"...initialize heap...";
14heap = {0, 0, 0, 0, 0};
15nexts = {1, 1};
16hlen2 = 2;
17while (hlen2 < nargs)
18nexts = {@nexts, @nexts};
19heap = {@heap, @heap};
20hlen2 = hlen2 * 2;
21endwhile
22for n in [-nargs..-1]
23s1 = args[i = -n][1];
24while ((hleft = heap[2 * i]) && (s1 > (m = min(la = args[hleft][1], (hright = heap[(2 * i) + 1]) ? args[hright][1] | $maxint))))
25if (m == la)
26heap[i] = hleft;
27i = 2 * i;
28else
29heap[i] = hright;
30i = (2 * i) + 1;
31endif
32endwhile
33heap[i] = -n;
34endfor
35"...";
36"...find first interval...";
37h = heap[1];
38rseq = {args[h][1]};
39if (length(args[h]) < 2)
40return rseq;
41endif
42current_end = args[h][2];
43nexts[h] = 3;
44"...";
45while (1)
46if (length(args[h]) >= nexts[h])
47"...this sequence has some more intervals in it...";
48else
49"...no more intevals left in this sequence, grab another...";
50h = heap[1] = heap[nargs];
51heap[nargs] = 0;
52if ((nargs = nargs - 1) > 1)
53elseif (args[h][nexts[h]] > current_end)
54return {@rseq, current_end, @args[h][nexts[h]..$]};
55elseif ((i = $list_utils:find_insert(args[h], current_end)) % 2)
56return {@rseq, current_end, @args[h][i..$]};
57else
58return {@rseq, @args[h][i..$]};
59endif
60endif
61"...";
62"...sink the top sequence...";
63i = 1;
64first = args[h][nexts[h]];
65while ((hleft = heap[2 * i]) && (first > (m = min(la = args[hleft][nexts[hleft]], (hright = heap[(2 * i) + 1]) ? args[hright][nexts[hright]] | $maxint))))
66if (m == la)
67heap[i] = hleft;
68i = 2 * i;
69else
70heap[i] = hright;
71i = (2 * i) + 1;
72endif
73endwhile
74heap[i] = h;
75"...";
76"...check new top sequence ...";
77if (args[h = heap[1]][nexts[h]] > current_end)
78"...hey, a new interval! ...";
79rseq = {@rseq, current_end, args[h][nexts[h]]};
80if (length(args[h]) <= nexts[h])
81return rseq;
82endif
83current_end = args[h][nexts[h] + 1];
84nexts[h] = nexts[h] + 2;
85else
86"...first interval overlaps with current one ...";
87i = $list_utils:find_insert(args[h], current_end);
88if (i % 2)
89nexts[h] = i;
90elseif (i > length(args[h]))
91return rseq;
92else
93current_end = args[h][i];
94nexts[h] = i + 1;
95endif
96endif
97endwhile

intersection

Spec this none thisFlags rxdOwner #36Definer #33

Referenced by

Source

1":intersection(seq1,seq2,...) => intersection of all sequences...";
2if ((U = {$minint}) in args)
3args = $list_utils:setremove_all(args, U);
4endif
5if (length(args) <= 1)
6return args ? args[1] | U;
7endif
8return this:complement(this:_union(@$list_utils:map_arg(this, "complement", args)));