sequence utilities #27

Parent #72Owner #29Flags readSource hellcore/hellcore.db

Aliases: sequence utilities, seq_utils, squ

23 verbs · 11 properties · 0 children

Verbs

VerbSpecFlagsDefinerLines
add removethis none thisrxd#2713
containsthis none thisrxd#272
complementthis none thisrxd#2716
unionthis none thisrxd#278
tostrthis none thisrxd#2711
forthis none thisrxd#2727
extractthis none thisrxd#2715
tolistthis none thisrxd#2715
from_listthis none thisrxd#272
from_sorted_listthis none thisrxd#2714
firstthis none thisrxd#271
lastthis none thisrxd#271
sizethis none thisrxd#278
from_stringthis none thisrxd#2736
firstnthis none thisrxd#2715
lastnthis none thisrxd#2716
rangethis none thisrxd#272
expandthis none thisrxd#2760
contractthis none thisrxd#2744
_unionthis none thisrxd#2797
intersectionthis none thisrxd#278
levenshteinthis none thisrxd#2723
randomthis none thisrxd#2719

Properties

PropertyDefinerFlagsOwnerValue
help_msg#72rc#29
list of 38{"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)", " :random (seq) => random element of seq", "", " :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."}
aliases#1rc#29{"sequence utilities", "seq_utils", "squ"}
description#1rc#29{"This is the sequence utilities utility package. See `help $seq_utils' for more details."}
object_size#1r#29{18857, 1298433815}
hidden_verbs#1rc#29<clear>
phelp_msg#1rc#29<clear>
weight#1rc#29<clear>
owner_verbs#1rc#29<clear>
plural_name#1rc#29<clear>
client_image#1rc#29<clear>
listening#1rc#29<clear>

Ancestry

Ancestors (nearest first): #72 Generic Utilities Package → #1 root

Children: none

Call graph

calls n27_0 #27:add n47_6 #47:find_insert n27_0->n47_6 n27_1 #27:contains n27_1->n47_6 n27_3 #27:union n47_9 #47:setremove_all n27_3->n47_9 n27_19 #27:_union n27_3->n27_19 n27_19->n47_6 n27_6 #27:extract n27_6->n47_6 n48_8 #48:suspend_if_needed n27_6->n48_8 n27_8 #27:from_list n27_9 #27:from_sorted_list n27_8->n27_9 n47_14 #47:sort n27_8->n47_14 n27_13 #27:from_string n27_13->n27_3 n20_38 #20:explode n27_13->n20_38 n20_12 #20:strip_chars n27_13->n20_12 n20_24 #20:is_integer n27_13->n20_24 n27_17 #27:expand n27_17->n47_6 n27_18 #27:contract n27_18->n47_6 n27_20 #27:intersection n27_20->n47_9 n27_20->n27_19 n27_2 #27:complement n27_20->n27_2 n27_21 #27:levenshtein n27_21->n48_8 n47_0 #47:make n27_21->n47_0 n27_22 #27:random n300_0 #300:weighted_random n27_22->n300_0

Source

add remove

Spec this none thisFlags rxdOwner #29Definer #27

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 #29Definer #27

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 #29Definer #27

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 #29Definer #27

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 #29Definer #27

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 #361Definer #27

Referenced by

none

Source

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

extract

Spec this none thisFlags rxdOwner #29Definer #27

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$command_utils:suspend_if_needed(0);
10ret = {@ret, @array[seq[(2 * i) - 1]..seq[2 * i] - 1]};
11endfor
12return ret;
13else
14return {};
15endif

tolist

Spec this none thisFlags rxdOwner #29Definer #27

Referenced by

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 #29Definer #27

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 #29Definer #27

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 #29Definer #27

Referenced by

Source

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

last

Spec this none thisFlags rxdOwner #29Definer #27

Referenced by

Source

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

size

Spec this none thisFlags rxdOwner #29Definer #27

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])
5yield;
6n = i - n;
7endfor
8return (length(seq) % 2) ? $minint - n | n;

from_string

Spec this none thisFlags rxdOwner #29Definer #27

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 #29Definer #27

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 #29Definer #27

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 #29Definer #27

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 #29Definer #27

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 #29Definer #27

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 #29Definer #27

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 #29Definer #27

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)));

levenshtein

Spec this none thisFlags rxdOwner #361Definer #27

Referenced by

none

Source

1":levenshtein(from, to) => Calculate the Levelshtein distance between 'from' and 'to', each of which must either be a list or a string.  Note:  may call suspend().";
2{from, to} = args;
3m = length(from);
4n = length(to);
5d = $lu:make(m + 1, $lu:make(n + 1));
6for i in [1..m + 1]
7d[i][1] = i - 1;
8endfor
9for j in [1..n + 1]
10d[1][j] = j - 1;
11endfor
12for i in [1..m]
13for j in [1..n]
14if (from[i] == to[j])
15cost = 0;
16else
17cost = 1;
18endif
19d[i + 1][j + 1] = min(d[i][j + 1] + 1, d[i + 1][j] + 1, d[i][j] + cost);
20endfor
21$cu:sin();
22endfor
23return d[m + 1][n + 1];

random

Spec this none thisFlags rxdOwner #361Definer #27

Referenced by

Source

1":random(seq) => INT randomly selected from seq.";
2seq = args[1];
3if (!seq)
4raise(E_INVARG);
5endif
6if (length(seq) % 2)
7seq = {@seq, $minint};
8endif
9intervals = {};
10for i in [1..length(seq) / 2]
11yield;
12ivl = {seq[(2 * i) - 1], seq[2 * i]};
13len = ivl[2] - ivl[1];
14intervals = {@intervals, {len, ivl}};
15endfor
16chosen_ivl = $ru:weighted_random(@intervals);
17chosen_len = chosen_ivl[2] - chosen_ivl[1];
18result = chosen_ivl[1] + (random(chosen_len) - 1);
19return result;