Noncontinuous subsequences
You are encouraged to solve this task according to the task description, using any language you may know.
Consider some sequence of elements. (It differs from a mere set of elements by having an ordering among members.)
A subsequence contains some subset of the elements of this sequence, in the same order.
A continuous subsequence is one in which no elements are missing between the first and last elements of the subsequence.
Note: Subsequences are defined structurally, not by their contents. So a sequence a,b,c,d will always have the same subsequences and continuous subsequences, no matter which values are substituted; it may even be the same value.
Task: Find all noncontinuous subsequences for a given sequence. Example: For the sequence 1,2,3,4, there are five noncontinuous subsequences, namely 1,3; 1,4; 2,4; 1,3,4 and 1,2,4.
Goal: There are different ways to calculate those subsequences. Demonstrate algorithm(s) that are natural for the language.
[edit] Ada
[edit] Recursive
with Ada.Text_IO; use Ada.Text_IO;
procedure Test_Non_Continuous is
type Sequence is array (Positive range <>) of Integer;
procedure Put_NCS
( Tail : Sequence;  To generate subsequences of
Head : Sequence := (1..0 => 1);  Already generated
Contiguous : Boolean := True  It is still continuous
) is
begin
if not Contiguous and then Head'Length > 1 then
for I in Head'Range loop
Put (Integer'Image (Head (I)));
end loop;
New_Line;
end if;
if Tail'Length /= 0 then
declare
New_Head : Sequence (Head'First..Head'Last + 1);
begin
New_Head (Head'Range) := Head;
for I in Tail'Range loop
New_Head (New_Head'Last) := Tail (I);
Put_NCS
( Tail => Tail (I + 1..Tail'Last),
Head => New_Head,
Contiguous => Contiguous and then (I = Tail'First or else Head'Length = 0)
);
end loop;
end;
end if;
end Put_NCS;
begin
Put_NCS ((1,2,3)); New_Line;
Put_NCS ((1,2,3,4)); New_Line;
Put_NCS ((1,2,3,4,5)); New_Line;
end Test_Non_Continuous;
Sample output:
1 3 1 2 4 1 3 1 3 4 1 4 2 4 1 2 3 5 1 2 4 1 2 4 5 1 2 5 1 3 1 3 4 1 3 4 5 1 3 5 1 4 1 4 5 1 5 2 3 5 2 4 2 4 5 2 5 3 5
[edit] ALGOL 68
[edit] Recursive
 note: This specimen retains the original Ada coding style.PROC test non continuous = VOID: BEGIN
MODE SEQMODE = CHAR;
MODE SEQ = [1:0]SEQMODE;
MODE YIELDSEQ = PROC(SEQ)VOID;
PROC gen ncs =
( SEQ tail, # To generate subsequences of #
SEQ head, # Already generated #
BOOL contiguous,# It is still continuous #
YIELDSEQ yield
) VOID:
BEGIN
IF NOT contiguous ANDTH UPB head > 1 THEN
yield (head)
FI;
IF UPB tail /= 0 THEN
[UPB head+1]SEQMODE new head;
new head [:UPB head] := head;
FOR i TO UPB tail DO
new head [UPB new head] := tail [i];
gen ncs
( tail[i + 1:UPB tail],
new head,
contiguous ANDTH (i = LWB tail OREL UPB head = 0),
yield
)
OD
FI
END # put ncs #;
# FOR SEQ seq IN # gen ncs(("a","e","i","o","u"), (), TRUE, # ) DO ( #
## (SEQ seq)VOID:
print((seq, new line))
# OD # )
END; test non continuous
Output:
aeiu aeo aeou aeu ai aio aiou aiu ao aou au eiu eo eou eu iu
[edit] Iterative
 note: This specimen retains the original C coding style.Note: This specimen can only handle sequences of length less than bits width of bits.
MODE SEQMODE = STRING;
MODE SEQ = [1:0]SEQMODE;
MODE YIELDSEQ = PROC(SEQ)VOID;
PROC gen ncs = (SEQ seq, YIELDSEQ yield)VOID:
BEGIN
IF UPB seq  1 > bits width THEN stop FI;
[UPB seq]SEQMODE out; INT upb out;
BITS lim := 16r1 SHL UPB seq;
BITS upb k := lim SHR 1;
# assert(lim); #
BITS empty = 16r000000000; # const #
FOR j TO ABS lim1 DO
INT state := 1;
BITS k1 := upb k;
WHILE k1 NE empty DO
BITS b := BIN j AND k1;
CASE state IN
# state 1 # IF b NE empty THEN state +:= 1 FI,
# state 2 # IF b EQ empty THEN state +:= 1 FI,
# state 3 #
BEGIN
IF b EQ empty THEN GO TO continue k1 FI;
upb out := 0;
BITS k2 := upb k; FOR i WHILE k2 NE empty DO
IF (BIN j AND k2) NE empty THEN out[upb out +:= 1] := seq[i] FI;
k2 := k2 SHR 1
OD;
yield(out[:upb out]);
k1 := empty # empty: ending containing loop #
END
ESAC;
continue k1: k1 := k1 SHR 1
OD
OD
END;
main:(
[]STRING seqs = ("a","e","i","o","u");
# FOR SEQ seq IN # gen ncs(seqs, # ) DO ( #
## (SEQ seq)VOID:
print((seq, new line))
# OD # )
)
Output:
iu eu eo eou eiu au ao aou ai aiu aio aiou aeu aeo aeou aeiu
[edit] AutoHotkey
using filtered templates ahk forum: discussion
MsgBox % noncontinuous("a,b,c,d,e", ",")
MsgBox % noncontinuous("1,2,3,4", ",")
noncontinuous(list, delimiter)
{
stringsplit, seq, list, %delimiter%
n := seq0 ; sequence length
Loop % x := (1<<n)  1 { ; try all 01 candidate sequences
If !RegExMatch(b:=ToBin(A_Index,n),"^0*1*0*$") { ; drop continuous subsequences
Loop Parse, b
t .= A_LoopField ? seq%A_Index% " " : "" ; position > number
t .= "`n" ; new sequences in new lines
}
}
return t
}
ToBin(n,W=16) { ; LS Wbits of Binary representation of n
Return W=1 ? n&1 : ToBin(n>>1,W1) . n&1
}
[edit] BBC BASIC
DIM list1$(3)
list1$() = "1", "2", "3", "4"
PRINT "For [1, 2, 3, 4] noncontinuous subsequences are:"
PROCnon_continuous_subsequences(list1$())
DIM list2$(4)
list2$() = "1", "2", "3", "4", "5"
PRINT "For [1, 2, 3, 4, 5] noncontinuous subsequences are:"
PROCnon_continuous_subsequences(list2$())
END
DEF PROCnon_continuous_subsequences(l$())
LOCAL i%, j%, g%, n%, r%, s%, w%, a$, b$
n% = DIM(l$(),1)
FOR s% = 0 TO n%2
FOR g% = s%+1 TO n%1
a$ = "["
FOR i% = s% TO g%1
a$ += l$(i%) + ", "
NEXT
FOR w% = 1 TO n%g%
r% = n%+1g%w%
FOR i% = 1 TO 2^r%1 STEP 2
b$ = a$
FOR j% = 0 TO r%1
IF i% AND 2^j% b$ += l$(g%+w%+j%) + ", "
NEXT
PRINT LEFT$(LEFT$(b$)) + "]"
NEXT i%
NEXT w%
NEXT g%
NEXT s%
ENDPROC
Output:
For [1, 2, 3, 4] noncontinuous subsequences are: [1, 3] [1, 3, 4] [1, 4] [1, 2, 4] [2, 4] For [1, 2, 3, 4, 5] noncontinuous subsequences are: [1, 3] [1, 3, 4] [1, 3, 5] [1, 3, 4, 5] [1, 4] [1, 4, 5] [1, 5] [1, 2, 4] [1, 2, 4, 5] [1, 2, 5] [1, 2, 3, 5] [2, 4] [2, 4, 5] [2, 5] [2, 3, 5] [3, 5]
[edit] Bracmat
( ( noncontinuous
= sub
. ( sub
= su a nc
. !arg:(?su.?nc)
& !su
: %
%?a
( %:[%(sub$(!sjt.!nc !a))
 ?
& !nc:~
& out$(!nc !a)
& ~
)
)
& sub$(dummy !arg.)

)
& noncontinuous$(e r n i t)
);
Output:
e n t e n e n i e n i t e i e i t e t e r i e r i t e r t e r n t r i r i t r t r n t n t
[edit] C
Note: This specimen can only handle lists of length less than the number of bits in an int.
#include <assert.h>
#include <stdio.h>
int main(int c, char **v)
{
unsigned int n = 1 << (c  1), i = n, j, k;
assert(n);
while (i) {
if (!(i & (i + (i & (int)i)))) // consecutive 1s
continue;
for (j = n, k = 1; j >>= 1; k++)
if (i & j) printf("%s ", v[k]);
putchar('\n');
}
return 0;
}
Example use:
$ ./noncont 1 2 3 4 1 2 4 1 3 4 1 3 2 4 1 4 $ ./noncont 1 2 3 4 5 6 7 8 9 0  wc l 968
Using "consecutive + gap + any subsequence" to produce disjointed sequences:
#include <assert.h>
#include <stdio.h>
#include <stdlib.h>
void binprint(unsigned int n, unsigned int m)
{
char c[sizeof(n) * 8 + 1];
int i = 0;
while (m >>= 1) c[i++] = n & m ? '#' : '';
c[i] = 0;
puts(c);
}
int main(int c, char **v)
{
unsigned int n, gap, left, right;
if (c < 2  ! (n = 1 << atoi(v[1]))) n = 16;
for (gap = 2; gap < n; gap <<= 1)
for (left = gap << 1; left < n; left = left << 1)
for (right = 1; right < gap; right++)
binprint(left  right, n);
return 0;
}
[edit] Recursive method
Using recursion and a state transition table.
#include <stdio.h>running it:
typedef unsigned char sint;
enum states { s_blnk = 0, s_tran, s_cont, s_disj };
/* Recursively look at each item in list, taking both choices of
picking the item or not. The state at each step depends on prvious
pickings, with the state transition table:
blank + no pick > blank
blank + pick > contiguous
transitional + no pick > transitional
transitional + pick > disjoint
contiguous + no pick > transitional
contiguous + pick > contiguous
disjoint + pick > disjoint
disjoint + no pick > disjoint
At first step, before looking at any item, state is blank.
Because state is known at each step and needs not be calculated,
it can be quite fast.
*/
unsigned char tbl[][2] = {
{ s_blnk, s_cont },
{ s_tran, s_disj },
{ s_tran, s_cont },
{ s_disj, s_disj },
};
void pick(sint n, sint step, sint state, char **v, unsigned long bits)
{
int i, b;
if (step == n) {
if (state != s_disj) return;
for (i = 0, b = 1; i < n; i++, b <<= 1)
if ((b & bits)) printf("%s ", v[i]);
putchar('\n');
return;
}
bits <<= 1;
pick(n, step + 1, tbl[state][0], v, bits); /* no pick */
pick(n, step + 1, tbl[state][1], v, bits  1); /* pick */
}
int main(int c, char **v)
{
if (c  1 >= sizeof(unsigned long) * 4)
printf("Too many items");
else
pick(c  1, 0, s_blnk, v + 1, 0);
return 0;
}
% ./a.out 1 2 3 4 1 3 1 4 2 4 1 2 4 1 3 4 % ./a.out 1 2 3 4 5 6 7 8 9 0  wc l 968
[edit] Clojure
Here's a simple approach that uses the clojure.contrib.combinatorics library to generate subsequences, and then filters out the continuous subsequences using a naïve subseq test:
(use '[clojure.contrib.combinatorics :only (subsets)])
(defn ofminlength [minlength]
(fn [s] (>= (count s) minlength)))
(defn runs [c l]
(map (partial take l) (takewhile notempty (iterate rest c))))
(defn issubseq? [c sub]
(some identity (map = (runs c (count sub)) (repeat sub))))
(defn noncontinuoussubsequences [s]
(filter (complement (partial issubseq? s)) (subsets s)))
(filter (ofminlength 2) (noncontinuoussubsequences [:a :b :c :d]))
[edit] CoffeeScript
Use binary bitmasks to enumerate our sequences.
is_contigous_binary = (n) >
# return true if binary representation of n is
# of the form 1+0+
# examples:
# 0 true
# 1 true
# 100 true
# 110 true
# 1001 false
# 1010 false
# special case zero, or you'll get an infinite loop later
return true if n == 0
# first remove 0s from end
while n % 2 == 0
n = n / 2
# next, take advantage of the fact that a continuous
# run of 1s would be of the form 2^n  1
is_power_of_two(n + 1)
is_power_of_two = (m) >
while m % 2 == 0
m = m / 2
m == 1
seq_from_bitmap = (arr, n) >
# grabs elements from array according to a bitmap
# e.g. if n == 13 (1101), and arr = ['a', 'b', 'c', 'd'],
# then return ['a', 'c', 'd'] (flipping bits to 1011, so
# that least significant bit comes first)
i = 0
new_arr = []
while n > 0
if n % 2 == 1
new_arr.push arr[i]
n = 1
n /= 2
i += 1
new_arr
non_contig_subsequences = (arr) >
# Return all subsqeuences from an array that have a "hole" in
# them. The order of the subsequences is not specified here.
# This algorithm uses binary counting, so it is limited to
# small lists, but large lists would be unwieldy regardless.
bitmasks = [0...Math.pow(2, arr.length)]
(seq_from_bitmap arr, n for n in bitmasks when !is_contigous_binary n)
arr = [1,2,3,4]
console.log non_contig_subsequences arr
for n in [1..10]
arr = [1..n]
num_solutions = non_contig_subsequences(arr).length
console.log "for n=#{n} there are #{num_solutions} solutions"
output
> coffee non_contig_subseq.coffee
[ [ 1, 3 ],
[ 1, 4 ],
[ 2, 4 ],
[ 1, 2, 4 ],
[ 1, 3, 4 ] ]
for n=1 there are 0 solutions
for n=2 there are 0 solutions
for n=3 there are 1 solutions
for n=4 there are 5 solutions
for n=5 there are 16 solutions
for n=6 there are 42 solutions
for n=7 there are 99 solutions
for n=8 there are 219 solutions
for n=9 there are 466 solutions
for n=10 there are 968 solutions
[edit] Common Lisp
(defun allsubsequences (list)
(labels ((subsequences (tail &optional (acc '()) (result '()))
"Return a list of the subsequence designators of the
subsequences of tail. Each subsequence designator is a
list of tails of tail, the subsequence being the first
element of each tail."
(if (endp tail)
(list* (reverse acc) result)
(subsequences (rest tail) (list* tail acc)
(append (subsequences (rest tail) acc) result))))
(continuousp (subsequenced)
"True if the designated subsequence is continuous."
(loop for i in subsequenced
for j on (first subsequenced)
always (eq i j)))
(designatedsequence (subsequenced)
"Destructively transforms a subsequence designator into
the designated subsequence."
(mapinto subsequenced 'first subsequenced)))
(let ((ncsubsequences (deleteif #'continuousp (subsequences list))))
(mapinto ncsubsequences #'designatedsequence ncsubsequences))))
(defun allsubsequences2 (list)
(labels ((recurse (s list)
(if (endp list)
(if (>= s 3)
'(())
'())
(let ((x (car list))
(xs (cdr list)))
(if (evenp s)
(append (mapcar (lambda (ys) (cons x ys))
(recurse (+ s 1) xs))
(recurse s xs))
(append (mapcar (lambda (ys) (cons x ys))
(recurse s xs))
(recurse (+ s 1) xs)))))))
(recurse 0 list)))
[edit] D
[edit] Recursive Version
import std.stdio;
T[][] ncsub(T)(in T[] seq, in int s=0) pure nothrow {
if (seq.length) {
T[][] aux;
foreach (ys; ncsub(seq[1..$], s + !(s % 2)))
aux ~= seq[0] ~ ys;
return aux ~ ncsub(seq[1..$], s + s % 2);
} else
return new T[][](s >= 3, 0);
}
void main() {
writeln(ncsub([1, 2, 3]));
writeln(ncsub([1, 2, 3, 4]));
foreach (nc; ncsub([1, 2, 3, 4, 5]))
writeln(nc);
}
 Output:
[[1, 3]] [[1, 2, 4], [1, 3, 4], [1, 3], [1, 4], [2, 4]] [1, 2, 3, 5] [1, 2, 4, 5] [1, 2, 4] [1, 2, 5] [1, 3, 4, 5] [1, 3, 4] [1, 3, 5] [1, 3] [1, 4, 5] [1, 4] [1, 5] [2, 3, 5] [2, 4, 5] [2, 4] [2, 5] [3, 5]
[edit] Faster Lazy Version
This version doesn't copy the subarrays.
struct Ncsub(T) {
T[] seq;
int opApply(int delegate(ref int[]) dg) const {
immutable int n = seq.length;
int result;
auto S = new int[n];
FOR_I:
foreach (i; 1 .. 1 << seq.length) {
int len_S;
bool nc = false;
foreach (j; 0 .. seq.length + 1) {
immutable int k = i >> j;
if (k == 0) {
if (nc) {
auto auxS = S[0 .. len_S];
result = dg(auxS);
if (result)
break FOR_I;
}
break;
} else if (k % 2) {
S[len_S] = seq[j];
len_S++;
} else if (len_S)
nc = true;
}
}
return result;
}
}
void main() {
import std.array, std.range;
//assert(iota(24).array().Ncsub!int().walkLength() == 16_776_915);
auto r = array(iota(24));
int counter;
foreach (s; Ncsub!int(r))
counter++;
assert(counter == 16_776_915);
}
[edit] Erlang
Erlang's not optimized for strings or math, so this is pretty inefficient. Nonetheless, it works by generating the set of all possible "bitmasks" (represented as strings), filters for those with noncontinuous subsequences, and maps from that set over the list. One immediate point for optimization that would complicate the code a bit would be to compile the regular expression, the problem being where you'd put it.
module(rosetta).
export([ncs/1]).
masks(N) >
MaxMask = trunc(math:pow(2, N)),
Total = lists:map(fun(X) > integer_to_list(X, 2) end,
lists:seq(3, MaxMask)),
Filtered = lists:filter(fun(X) > contains_noncont(X) end, Total),
lists:map(fun(X) > string:right(X, N, $0) end, Filtered). % padding
contains_noncont(N) >
case re:run(N, "10+1") of
{match, _} > true;
nomatch > false
end.
apply_mask_to_list(Mask, List) >
Zipped = lists:zip(Mask, List),
Filtered = lists:filter(fun({Include, _}) > Include > 48 end, Zipped),
lists:map(fun({_, Value}) > Value end, Filtered).
ncs(List) >
lists:map(fun(Mask) > apply_mask_to_list(Mask, List) end,
masks(length(List))).
Output:
Eshell V5.10.1 (abort with ^G) 1> c(rosetta). {ok,rosetta} 2> rosetta:ncs([1,2,3,4]). [[2,4],[1,4],[1,3],[1,3,4],[1,2,4]]
[edit] Go
Generate the power set (power sequence, actually) with a recursive function, but keep track of the state of the subsequence on the way down. When you get to the bottom, if state == noncontinuous, then include the subsequence. It's just filtering merged in with generation.
package main
import "fmt"
const ( // state:
m = iota // missing: all elements missing so far
c // continuous: all elements included so far are continuous
cm // one or more continuous followed by one or more missing
cmc // noncontinuous subsequence
)
func ncs(s []int) [][]int {
if len(s) < 3 {
return nil
}
return append(n2(nil, s[1:], m), n2([]int{s[0]}, s[1:], c)...)
}
var skip = []int{m, cm, cm, cmc}
var incl = []int{c, c, cmc, cmc}
func n2(ss, tail []int, seq int) [][]int {
if len(tail) == 0 {
if seq != cmc {
return nil
}
return [][]int{ss}
}
return append(n2(append([]int{}, ss...), tail[1:], skip[seq]),
n2(append(ss, tail[0]), tail[1:], incl[seq])...)
}
func main() {
ss := ncs([]int{1, 2, 3, 4})
fmt.Println(len(ss), "noncontinuous subsequences:")
for _, s := range ss {
fmt.Println(" ", s)
}
}
Output:
5 noncontinuous subsequences: [2 4] [1 4] [1 3] [1 3 4] [1 2 4]
[edit] Haskell
[edit] Generalized monadic filter
action p x = if p x then succ x else x
fenceM p q s [] = guard (q s) >> return []
fenceM p q s (x:xs) = do
(f,g) < p
ys < fenceM p q (g s) xs
return $ f x ys
ncsubseq = fenceM [((:), action even), (flip const, action odd)] (>= 3) 0
Output:
*Main> ncsubseq [1..3] [[1,3]] *Main> ncsubseq [1..4] [[1,2,4],[1,3,4],[1,3],[1,4],[2,4]] *Main> ncsubseq [1..5] [[1,2,3,5],[1,2,4,5],[1,2,4],[1,2,5],[1,3,4,5],[1,3,4],[1,3,5],[1,3],[1,4,5],[1,4],[1,5],[2,3,5],[2,4,5],[2,4],[2,5],[3,5]]
[edit] Filtered templates
This implementation works by computing templates of all possible subsequences of the given length of sequence, discarding the continuous ones, then applying the remaining templates to the input list.
continuous = null . dropWhile not . dropWhile id . dropWhile not
ncs xs = map (map fst . filter snd . zip xs) $
filter (not . continuous) $
mapM (const [True,False]) xs
[edit] Recursive
Recursive method with powerset as helper function.
import Data.List
poset = foldr (\x p > p ++ map (x:) p) [[]]
ncsubs [] = [[]]
ncsubs (x:xs) = tail $ nc [x] xs
where
nc [_] [] = [[]]
nc (_:x:xs) [] = nc [x] xs
nc xs (y:ys) = (nc (xs++[y]) ys) ++ map (xs++) (tail $ poset ys)
Output:
*Main> ncsubs "aaa" ["aa"] (0.00 secs, 0 bytes) *Main> ncsubs [9..12] [[10,12],[9,10,12],[9,12],[9,11],[9,11,12]] (0.00 secs, 522544 bytes) *Main> ncsubs [] [[]] (0.00 secs, 0 bytes) *Main> ncsubs [1] [] (0.00 secs, 0 bytes)
A disjointed subsequence is a consecutive subsequence followed by a gap, then by any nonempty subsequence to its right:
import Data.List (subsequences, tails, delete)
disjoint a = concatMap (cutAt a) [1..length a  2] where
cutAt s n = [a ++ b  b < delete [] (subsequences right),
a < init (tails left) ] where
(left, _:right) = splitAt n s
main = print $ length $ disjoint [1..20]
Build a lexicographic list of consecutive subsequences, and a list of all subsequences, then subtract one from the other:
import Data.List (inits, tails)
subseqs = foldr (\x s > [x] : map (x:) s ++ s) []
consecs = concatMap (tail.inits) . tails
minus [] [] = []
minus (a:as) bb@(b:bs)
 a == b = minus as bs
 otherwise = a:minus as bb
disjoint s = (subseqs s) `minus` (consecs s)
main = mapM_ print $ disjoint [1..4]
[edit] J
We select those combinations where the end of the first continuous subsequence appears before the start of the last continuous subsequence:
allmasks=: 2 #:@i.@^ #
firstend=:1 0 i.&1@E."1 ]
laststart=: 0 1 {:@I.@E."1 ]
noncont=: <@#~ (#~ firstend < laststart)@allmasks
Example use:
noncont 1+i.4
┌───┬───┬───┬─────┬─────┐
│2 4│1 4│1 3│1 3 4│1 2 4│
└───┴───┴───┴─────┴─────┘
noncont 'aeiou'
┌──┬──┬──┬───┬───┬──┬──┬───┬──┬───┬───┬────┬───┬───┬────┬────┐
│iu│eu│eo│eou│eiu│au│ao│aou│ai│aiu│aio│aiou│aeu│aeo│aeou│aeiu│
└──┴──┴──┴───┴───┴──┴──┴───┴──┴───┴───┴────┴───┴───┴────┴────┘
#noncont i.10
968
Alternatively, since there are relatively few continuous sequences, we could specifically exclude them:
contmasks=: a: ;@, 1 <:/~@i.&.>@i.@+ #
noncont=: <@#~ (allmasks . contmasks)
[edit] JavaScript
Uses powerset() function from here. Uses a JSON stringifier from http://www.json.org/js.html
function non_continuous_subsequences(ary) {
var non_continuous = new Array();
for (var i = 0; i < ary.length; i++) {
if (! is_array_continuous(ary[i])) {
non_continuous.push(ary[i]);
}
}
return non_continuous;
}
function is_array_continuous(ary) {
if (ary.length < 2)
return true;
for (var j = 1; j < ary.length; j++) {
if (ary[j]  ary[j1] != 1) {
return false;
}
}
return true;
}
load('json2.js'); /* http://www.json.org/js.html */
print(JSON.stringify( non_continuous_subsequences( powerset([1,2,3,4]))));
Outputs:
[[1,3],[1,4],[2,4],[1,2,4],[1,3,4]]
[edit] Mathematica
We make all the subsets then filter out the continuous ones:
GoodBad[i_List]:=Not[MatchQ[Differences[i],{1..}{}]]
n=5
Select[Subsets[Range[n]],GoodBad]
gives back:
{{1,3},{1,4},{1,5},{2,4},{2,5},{3,5},{1,2,4},{1,2,5},{1,3,4},{1,3,5},{1,4,5},{2,3,5},{2,4,5},{1,2,3,5},{1,2,4,5},{1,3,4,5}}
[edit] OCaml
let rec fence s = function
[] >
if s >= 3 then
[[]]
else
[]
 x :: xs >
if s mod 2 = 0 then
List.map
(fun ys > x :: ys)
(fence (s + 1) xs)
@
fence s xs
else
List.map
(fun ys > x :: ys)
(fence s xs)
@
fence (s + 1) xs
let ncsubseq = fence 0
Output:
# ncsubseq [1;2;3];;  : int list list = [[1; 3]] # ncsubseq [1;2;3;4];;  : int list list = [[1; 2; 4]; [1; 3; 4]; [1; 3]; [1; 4]; [2; 4]] # ncsubseq [1;2;3;4;5];;  : int list list = [[1; 2; 3; 5]; [1; 2; 4; 5]; [1; 2; 4]; [1; 2; 5]; [1; 3; 4; 5]; [1; 3; 4]; [1; 3; 5]; [1; 3]; [1; 4; 5]; [1; 4]; [1; 5]; [2; 3; 5]; [2; 4; 5]; [2; 4]; [2; 5]; [3; 5]]
[edit] Oz
A nice application of finite set constraints. We just describe what we want and the constraint system will deliver it:
declare
fun {NCSubseq SeqList}
Seq = {FS.value.make SeqList}
proc {Script Result}
%% the result is a subset of Seq
{FS.subset Result Seq}
%% at least one element of Seq is missing
local Gap in
{FS.include Gap Seq}
{FS.exclude Gap Result}
%% and this element is between the smallest
%% and the largest elements of the subsequence
Gap >: {FS.int.min Result}
Gap <: {FS.int.max Result}
end
%% enumerate all such sets
{FS.distribute naive [Result]}
end
in
{Map {SearchAll Script} FS.reflect.lowerBoundList}
end
in
{Inspect {NCSubseq [1 2 3 4]}}
[edit] PARI/GP
Just a simple script, but it's I/O bound so efficiency isn't a concern. (Almost all subsequences are noncontiguous so looping over all possibilities isn't that bad. For length 20 about 99.98% of subsequences are noncontiguous.)
noncontig(n)=n>>=valuation(n,2);n++;n>>=valuation(n,2);n>1;
nonContigSubseq(v)={
for(i=5,2^#v1,
if(noncontig(i),
print(vecextract(v,i))
)
)
};
nonContigSubseq([1,2,3])
nonContigSubseq(["a","b","c","d","e"])
Output:
[1, 3] ["a", "c"] ["a", "d"] ["b", "d"] ["a", "b", "d"] ["a", "c", "d"] ["a", "e"] ["b", "e"] ["a", "b", "e"] ["c", "e"] ["a", "c", "e"] ["b", "c", "e"] ["a", "b", "c", "e"] ["a", "d", "e"] ["b", "d", "e"] ["a", "b", "d", "e"] ["a", "c", "d", "e"]
[edit] Perl
my ($max, @current);
sub non_continuous {
my ($idx, $has_gap, $found) = @_;
for ($idx .. $max) {
push @current, $_;
# print "@current\n" if $has_gap; # uncomment for huge output
$found ++ if $has_gap;
$found += non_continuous($_ + 1, $has_gap) if $_ < $max;
pop @current;
$has_gap = @current; # don't set gap flag if it's empty still
}
$found;
}
$max = 20; # 1048365 sequences, 10 secondsish
print "found ", non_continuous(1), " sequences\n";
[edit] Perl 6
Uses powerset() function from here.
sub non_continuous_subsequences ( *@list ) {Output:
powerset(@list).grep: { 1 != all( .[ 0 ^.. .end] Z .[0 ..^ .end] ) }
}
sub powerset ( *@list ) {
reduce( > @L, $n { [ @L, @L.map: {[ .list, $n ]} ] }, [[]], @list );
}
say ~ non_continuous_subsequences( 1..3 )».perl;
say ~ non_continuous_subsequences( 1..4 )».perl;
say ~ non_continuous_subsequences( ^4 ).map: {[<a b c d>[.list]].perl};
[1, 3] [1, 3] [1, 4] [2, 4] [1, 2, 4] [1, 3, 4] ["a", "c"] ["a", "d"] ["b", "d"] ["a", "b", "d"] ["a", "c", "d"]
[edit] PicoLisp
(de ncsubseq (Lst)
(let S 0
(recur (S Lst)
(ifn Lst
(and (>= S 3) '(NIL))
(let (X (car Lst) XS (cdr Lst))
(ifn (bit? 1 S) # even
(conc
(mapcar '((YS) (cons X YS))
(recurse (inc S) XS) )
(recurse S XS) )
(conc
(mapcar '((YS) (cons X YS))
(recurse S XS) )
(recurse (inc S) XS) ) ) ) ) ) ) )
[edit] Pop11
We modify classical recursive generation of subsets, using variables to keep track if subsequence is continuous.
define ncsubseq(l);
lvars acc = [], gap_started = false, is_continuous = true;
define do_it(l1, l2);
dlocal gap_started;
lvars el, save_is_continuous = is_continuous;
if l2 = [] then
if not(is_continuous) then
cons(l1, acc) > acc;
endif;
else
front(l2) > el;
back(l2) > l2;
not(gap_started) and is_continuous > is_continuous;
do_it(cons(el, l1), l2);
save_is_continuous > is_continuous;
not(l1 = []) or gap_started > gap_started;
do_it(l1, l2);
endif;
enddefine;
do_it([], rev(l));
acc;
enddefine;
ncsubseq([1 2 3 4 5]) =>
Output:
[[1 3] [1 4] [2 4] [1 2 4] [1 3 4] [1 5] [2 5] [1 2 5] [3 5] [1 3 5]
[2 3 5] [1 2 3 5] [1 4 5] [2 4 5] [1 2 4 5] [1 3 4 5]]
[edit] PowerShell
Function SubSequence ( [Array] $S, [Boolean] $all=$false )
{
$sc = $S.count
if( $sc gt ( 2  [Int32] $all ) ) {
[void] $sc
0..$sc  ForEachObject {
$gap = $_
"$( $S[ $_ ] )"
if( $gap lt $sc )
{
SubSequence ( ( $gap + 1 )..$sc  WhereObject { $_ ne $gap } ) ( ( $gap ne 0 ) or $all )  ForEachObject {
[String]::Join( ',', ( ( [String]$_ ).Split(',')  ForEachObject {
$lt = $true
} {
if( $lt and ( $_ gt $gap ) )
{
$S[ $gap ]
$lt = $false
}
$S[ $_ ]
} {
if( $lt )
{
$S[ $gap ]
}
}
) )
}
}
}
#[String]::Join( ',', $S)
} else {
$S  ForEachObject { [String] $_ }
}
}
Function NonContinuousSubSequence ( [Array] $S )
{
$sc = $S.count
if( $sc eq 3 )
{
[String]::Join( ',', $S[ ( 0,2 ) ] )
} elseif ( $sc gt 3 ) {
[void] $sc
$gaps = @()
$gaps += ( ( NonContinuousSubSequence ( 1..$sc ) )  ForEachObject {
$gap1 = ",$_,"
"0,{0}" f ( [String]::Join( ',', ( 1..$sc  WhereObject { $gap1 notmatch "$_," } ) ) )
} )
$gaps += 1..( $sc  1 )
2..( $sc  1 )  ForEachObject {
$gap2 = $_  1
$gaps += ( ( SubSequence ( $_..$sc ) )  ForEachObject {
"$gap2,$_"
} )
}
#WriteHost "S $S gaps $gaps"
$gaps  ForEachObject {
$gap3 = ",$_,"
"$( 0..$sc  WhereObject { $gap3 notmatch ",$_," }  ForEachObject {
$S[$_]
} )" replace ' ', ','
}
} else {
$null
}
}
( NonContinuousSubSequence 'a','b','c','d','e' )  SelectObject length, @{Name='value';Expression={ $_ } }  SortObject length, value  ForEachObject { $_.value }
[edit] Prolog
Works with SWIProlog.
We explain to Prolog how to build a non continuous subsequence of a list L, then we ask Prolog to fetch all the subsequences.
% fetch all the subsequences
ncsubs(L, LNCSL) :
setof(NCSL, one_ncsubs(L, NCSL), LNCSL).
% how to build one subsequence
one_ncsubs(L, NCSL) :
extract_elem(L, NCSL);
( sublist(L, L1),
one_ncsubs(L1, NCSL)).
% extract one element of the list
% this element is neither the first nor the last.
extract_elem(L, NCSL) :
length(L, Len),
Len1 is Len  2,
between(1, Len1, I),
nth0(I, L, Elem),
select(Elem, L, NCS1),
( NCSL = NCS1; extract_elem(NCS1, NCSL)).
% extract the first or the last element of the list
sublist(L, SL) :
(L = [_SL];
reverse(L, [_SL1]),
reverse(SL1, SL)).
Example :
? ncsubs([a,e,i,o,u], L).
L = [[a,e,i,u],[a,e,o],[a,e,o,u],[a,e,u],[a,i],[a,i,o],[a,i,o,u],[a,i,u],[a,o],[a,o,u],[a,u],[e,i,u],[e,o],[e,o,u],[e,u],[i,u]]
[edit] Python
def ncsub(seq, s=0):
if seq:
x = seq[:1]
xs = seq[1:]
p2 = s % 2
p1 = not p2
return [x + ys for ys in ncsub(xs, s + p1)] + ncsub(xs, s + p2)
else:
return [[]] if s >= 3 else []
Output:
>>> ncsub(range(1, 4)) [[1, 3]] >>> ncsub(range(1, 5)) [[1, 2, 4], [1, 3, 4], [1, 3], [1, 4], [2, 4]] >>> ncsub(range(1, 6)) [[1, 2, 3, 5], [1, 2, 4, 5], [1, 2, 4], [1, 2, 5], [1, 3, 4, 5], [1, 3, 4], [1, 3, 5], [1, 3], [1, 4, 5], [1, 4], [1, 5], [2, 3, 5], [2, 4, 5], [2, 4], [2, 5], [3, 5]]
A faster Python + Psyco JIT version:
from sys import argv
import psyco
def C(n, k):
result = 1
for d in xrange(1, k+1):
result *= n
n = 1
result /= d
return result
# http://oeis.org/A002662
nsubs = lambda n: sum(C(n, k) for k in xrange(3, n+1))
def ncsub(seq):
n = len(seq)
result = [None] * nsubs(n)
pos = 0
for i in xrange(1, 2 ** n):
S = []
nc = False
for j in xrange(n + 1):
k = i >> j
if k == 0:
if nc:
result[pos] = S
pos += 1
break
elif k % 2:
S.append(seq[j])
elif S:
nc = True
return result
from sys import argv
import psyco
psyco.full()
n = 10 if len(argv) < 2 else int(argv[1])
print len( ncsub(range(1, n)) )
[edit] R
The idea behind this is to loop over the possible lengths of subsequence, finding all subsequences then discarding those which are continuous.
ncsub < function(x)
{
n < length(x)
a < seq_len(n)
seqlist < list()
for(i in 2:(n1))
{
seqs < combn(a, i) # Get all subseqs
ok < apply(seqs, 2, function(x) any(diff(x)!=1)) # Find noncts ones
newseqs < unlist(apply(seqs[,ok], 2, function(x) list(x)), recursive=FALSE) # Convert matrix to list of its columns
seqlist < c(seqlist, newseqs) # Append to existing list
}
lapply(seqlist, function(index) x[index])
}
# Example usage
ncsub(1:4)
ncsub(letters[1:5])
[edit] Racket
Take a simple subsets definition:
(define (subsets l)
(if (null? l) '(())
(append (for/list ([l2 (subsets (cdr l))]) (cons (car l) l2))
(subsets (cdr l)))))
since the subsets are returned in their original order, it is also a subsequences function.
Now add to it a "state" counter which count one for each chunk of items included or excluded. It's always even when we're in an excluded chunk (including the beginning) and odd when we're including items  increment it whenever we switch from one kind of chunk to the other. This means that we should only include subsequences where the state is 3 (included>excluded>included) or more. Note that this results in code that is similar to the "Generalized monadic filter" entry, except a little simpler.
#lang racket
(define (noncontinuoussubseqs l)
(let loop ([l l] [x 0])
(if (null? l) (if (>= x 3) '(()) '())
(append (for/list ([l2 (loop (cdr l) (if (even? x) (add1 x) x))])
(cons (car l) l2))
(loop (cdr l) (if (odd? x) (add1 x) x))))))
(noncontinuoussubseqs '(1 2 3 4))
;; => '((1 2 4) (1 3 4) (1 3) (1 4) (2 4))
[edit] REXX
/*REXX program to list noncontinuous subsequences (NCS), given a seq.*/
parse arg list /*the the list from the CL.*/
if list='' then list=1 2 3 4 5 /*Specified? Use default. */
say 'list=' space(list); say /*show list to the terminal*/
w=words(list) ; #=0 /*# words in list; # of NCS*/
$=left(123456789,w) /*build a string of digits.*/
tail=right($,max(0,w2)) /*construct a "fast" tail. */
do j=13 to left($,1)  tail /*step through the list. */
if verify(j,$)\==0 then iterate /*Not one of the chosen? */
f=left(j,1) /*the first digit of j. */
NCS=0 /*not noncontinuous subseq*/
do k=2 to length(j); _=substr(j,k,1) /*pick off a single digit. */
if _ <= f then iterate j /*if next digit ≤ then skip*/
if _ \== f+1 then NCS=1 /*it's OK as of now. */
f=_ /*we now got a new next dig*/
end /*k*/
if \NCS then iterate /*¬OK? Then skip this num.*/
#=#+1 /*Eureka! We found one. */
x= /*the beginning of the NCS.*/
do m=1 for length(j) /*build a thingy to display*/
x=x word(list,substr(j,m,1)) /*pick off a number to show*/
end /*m*/
say 'a noncontinuous subsequence: ' x /*show a noncont. subseq. */
end /*j*/
if #==0 then #='no' /*make it more gooder Eng. */
say; say # "noncontinuous subsequence"s(#) 'were found.'
exit /*stick a fork in it, we're done.*/
/*──────────────────────────────────S subroutine───────────────────────*/
s: if arg(1)==1 then return ''; return word(arg(2) 's',1) /*plurals.*/
output when using the input: 1 2 3 4
list= 1 2 3 4 a noncontinuous subsequence: 1 3 a noncontinuous subsequence: 1 4 a noncontinuous subsequence: 2 4 a noncontinuous subsequence: 1 2 4 a noncontinuous subsequence: 1 3 4 5 noncontinuous subsequences were found.
output when using the following input: a e I o u
list= a e I o u a noncontinuous subsequence: a I a noncontinuous subsequence: a o a noncontinuous subsequence: a u a noncontinuous subsequence: e o a noncontinuous subsequence: e u a noncontinuous subsequence: I u a noncontinuous subsequence: a e o a noncontinuous subsequence: a e u a noncontinuous subsequence: a I o a noncontinuous subsequence: a I u a noncontinuous subsequence: a o u a noncontinuous subsequence: e I u a noncontinuous subsequence: e o u a noncontinuous subsequence: a e I u a noncontinuous subsequence: a e o u a noncontinuous subsequence: a I o u 16 noncontinuous subsequences were found.
output when using the [channel Islands (Great Britain)] as input: Alderney Guernsey Herm Jersey Sark
list= Alderney Guernsey Herm Jersey Sark a noncontinuous subsequence: Alderney Herm a noncontinuous subsequence: Alderney Jersey a noncontinuous subsequence: Alderney Sark a noncontinuous subsequence: Guernsey Jersey a noncontinuous subsequence: Guernsey Sark a noncontinuous subsequence: Herm Sark a noncontinuous subsequence: Alderney Guernsey Jersey a noncontinuous subsequence: Alderney Guernsey Sark a noncontinuous subsequence: Alderney Herm Jersey a noncontinuous subsequence: Alderney Herm Sark a noncontinuous subsequence: Alderney Jersey Sark a noncontinuous subsequence: Guernsey Herm Sark a noncontinuous subsequence: Guernsey Jersey Sark a noncontinuous subsequence: Alderney Guernsey Herm Sark a noncontinuous subsequence: Alderney Guernsey Jersey Sark a noncontinuous subsequence: Alderney Herm Jersey Sark 16 noncontinuous subsequences were found.
output when using the following [six noble gases] as input: helium neon argon krypton xenon radon
list= helium neon argon krypton xenon radon a noncontinuous subsequence: helium argon a noncontinuous subsequence: helium krypton a noncontinuous subsequence: helium xenon a noncontinuous subsequence: helium radon a noncontinuous subsequence: neon krypton a noncontinuous subsequence: neon xenon a noncontinuous subsequence: neon radon a noncontinuous subsequence: argon xenon a noncontinuous subsequence: argon radon a noncontinuous subsequence: krypton radon a noncontinuous subsequence: helium neon krypton a noncontinuous subsequence: helium neon xenon a noncontinuous subsequence: helium neon radon a noncontinuous subsequence: helium argon krypton a noncontinuous subsequence: helium argon xenon a noncontinuous subsequence: helium argon radon a noncontinuous subsequence: helium krypton xenon a noncontinuous subsequence: helium krypton radon a noncontinuous subsequence: helium xenon radon a noncontinuous subsequence: neon argon xenon a noncontinuous subsequence: neon argon radon a noncontinuous subsequence: neon krypton xenon a noncontinuous subsequence: neon krypton radon a noncontinuous subsequence: neon xenon radon a noncontinuous subsequence: argon krypton radon a noncontinuous subsequence: argon xenon radon a noncontinuous subsequence: helium neon argon xenon a noncontinuous subsequence: helium neon argon radon a noncontinuous subsequence: helium neon krypton xenon a noncontinuous subsequence: helium neon krypton radon a noncontinuous subsequence: helium neon xenon radon a noncontinuous subsequence: helium argon krypton xenon a noncontinuous subsequence: helium argon krypton radon a noncontinuous subsequence: helium argon xenon radon a noncontinuous subsequence: helium krypton xenon radon a noncontinuous subsequence: neon argon krypton radon a noncontinuous subsequence: neon argon xenon radon a noncontinuous subsequence: neon krypton xenon radon a noncontinuous subsequence: helium neon argon krypton radon a noncontinuous subsequence: helium neon argon xenon radon a noncontinuous subsequence: helium neon krypton xenon radon a noncontinuous subsequence: helium argon krypton xenon radon 42 noncontinuous subsequences were found.
[edit] Ruby
Uses code from Power Set.
class Array
def func_power_set
inject([[]]) { ps,item # for each item in the Array
ps + # take the powerset up to now and add
ps.map { e e + [item] } # it again, with the item appended to each element
}
end
def non_continuous_subsequences
func_power_set.reject {seq continuous?(seq)}
end
def continuous?(seq)
seq.each_cons(2) {a, b return false if a.succ != b}
true
end
end
p (1..3).to_a.non_continuous_subsequences
p (1..4).to_a.non_continuous_subsequences
p (1..5).to_a.non_continuous_subsequences
p ("a".."d").to_a.non_continuous_subsequences
 Output:
[[1, 3]] [[1, 3], [1, 4], [2, 4], [1, 2, 4], [1, 3, 4]] [[1, 3], [1, 4], [2, 4], [1, 2, 4], [1, 3, 4], [1, 5], [2, 5], [1, 2, 5], [3, 5], [1, 3, 5], [2, 3, 5], [1, 2, 3, 5], [1, 4, 5], [2, 4, 5], [1, 2, 4, 5], [1, 3, 4, 5]] [["a", "c"], ["a", "d"], ["b", "d"], ["a", "b", "d"], ["a", "c", "d"]]
It is not the value of the array element and when judging continuation in the position, it changes as follows.
class Array
def continuous?(seq)
seq.each_cons(2) {a, b return false if index(a)+1 != index(b)}
true
end
end
p %w(a e i o u).non_continuous_subsequences
 Output:
[["a", "i"], ["a", "o"], ["e", "o"], ["a", "e", "o"], ["a", "i", "o"], ["a", "u"], ["e", "u"], ["a", "e", "u"], ["i", "u"], ["a", "i", "u"], ["e", "i", "u"], ["a", "e", "i", "u"], ["a", "o", "u"], ["e", "o", "u"], ["a", "e", "o", "u"], ["a", "i", "o", "u"]]
[edit] Scheme
(define (ncsubseq lst)
(let recurse ((s 0)
(lst lst))
(if (null? lst)
(if (>= s 3)
'(())
'())
(let ((x (car lst))
(xs (cdr lst)))
(if (even? s)
(append
(map (lambda (ys) (cons x ys))
(recurse (+ s 1) xs))
(recurse s xs))
(append
(map (lambda (ys) (cons x ys))
(recurse s xs))
(recurse (+ s 1) xs)))))))
Output:
> (ncsubseq '(1 2 3)) ((1 3)) > (ncsubseq '(1 2 3 4)) ((1 2 4) (1 3 4) (1 3) (1 4) (2 4)) > (ncsubseq '(1 2 3 4 5)) ((1 2 3 5) (1 2 4 5) (1 2 4) (1 2 5) (1 3 4 5) (1 3 4) (1 3 5) (1 3) (1 4 5) (1 4) (1 5) (2 3 5) (2 4 5) (2 4) (2 5) (3 5))
[edit] Standard ML
fun fence s [] =
if s >= 3 then
[[]]
else
[]
 fence s (x :: xs) =
if s mod 2 = 0 then
map
(fn ys => x :: ys)
(fence (s + 1) xs)
@
fence s xs
else
map
(fn ys => x :: ys)
(fence s xs)
@
fence (s + 1) xs
fun ncsubseq xs = fence 0 xs
Output:
 ncsubseq [1,2,3]; val it = [[1,3]] : int list list  ncsubseq [1,2,3,4]; val it = [[1,2,4],[1,3,4],[1,3],[1,4],[2,4]] : int list list  ncsubseq [1,2,3,4,5]; val it = [[1,2,3,5],[1,2,4,5],[1,2,4],[1,2,5],[1,3,4,5],[1,3,4],[1,3,5],[1,3], [1,4,5],[1,4],[1,5],[2,3,5],...] : int list list
[edit] Tcl
This Tcl implementation uses the subsets function from Power Set, which is acceptable as that conserves the ordering, as well as a problemspecific test function is_not_continuous and a generic list filter lfilter:
proc subsets l {
set res [list [list]]
foreach e $l {
foreach subset $res {lappend res [lappend subset $e]}
}
return $res
}
proc is_not_continuous seq {
set last [lindex $seq 0]
foreach e [lrange $seq 1 end] {
if {$e1 != $last} {return 1}
set last $e
}
return 0
}
proc lfilter {f list} {
set res {}
foreach i $list {if [$f $i] {lappend res $i}}
return $res
}
% lfilter is_not_continuous [subsets {1 2 3 4}]
{1 3} {1 4} {2 4} {1 2 4} {1 3 4}
[edit] Ursala
To do it the lazy programmer way, apply the powerset library function to the list, which will generate all continuous and noncontinuous subsequences of it, and then delete the subsequences that are also substrings (hence continuous) using a judicious combination of the built in substring predicate (K3), negation (Z), and distributing filter (K17) operator suffixes. This function will work on lists of any type. To meet the requirement for structural equivalence, the list items are first uniquely numbered (num), and the numbers are removed afterwards (rSS).
#import std
noncontinuous = num; ^rlK3ZK17rSS/~& powerset
#show+
examples = noncontinuous 'abcde'
Output:
abce abd abde abe ac acd acde ace ad ade ae bce bd bde be ce