Non-continuous 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 continous subsequences, no matter which values are substituted; it may be even the same value.
Task: Find all non-continuous subsequences for a given sequence. Example: For the sequence 1,2,3,4, there are five non-continuous 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.
Ada
<lang ada> 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; </lang> 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
AutoHotkey
ahk forum: discussion <lang AutoHotkey>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 0-1 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 W-bits of Binary representation of n
Return W=1 ? n&1 : ToBin(n>>1,W-1) . n&1
} </lang>
D
A short version adapted from the Python code:
<lang d> import std.stdio: writefln;
T[][] ncsub(T)(T[] seq, int s=0) {
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 s >= 3 ? new T[][](1, 0) : null;
}
void main() {
writefln(ncsub([1, 2, 3])); writefln(ncsub([1, 2, 3, 4])); writefln(ncsub([1, 2, 3, 4, 5]));
} </lang>
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]]
A fast lazy version, it doesn't copy the generated sub-arrays, so if you want to keep them you have to copy (dup) them:
<lang d> import std.conv: toInt; import std.stdio: writefln;
struct Ncsub(T) {
T[] seq;
int opApply(int delegate(ref int[]) dg) { int result, n = seq.length; auto S = new int[n];
OUTER: for (int i = 1; i < (1 << seq.length); i++) { int len_S; bool nc = false; for (int j; j < seq.length + 1; j++) { int k = i >> j; if (k == 0) { if (nc) { T[] auxS = S[0 .. len_S]; result = dg(auxS); if (result) break OUTER; } break; } else if (k % 2) S[len_S++] = seq[j]; else if (len_S) nc = true; } }
return result; }
}
void main(string[] args) {
int n = args.length == 2 ? toInt(args[1]) : 10;
auto range = new int[n - 1]; foreach (i, ref el; range) el = i + 1;
int count; foreach (sub; Ncsub!(int)(range)) count++; writefln(count);
} </lang>
Haskell
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]]
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
Recursive
Recursive method with powerset as helper function.
import Data.List poset [] = [[]] poset (x:xs) = let p = poset xs in p ++ map (x:) p ncsubs [] = [[]] ncsubs (x:xs) = let nc (_:[]) [] = [[]] nc (_:x:xs) [] = nc [x] xs nc xs (y:ys) = (nc (xs++[y]) ys) ++ map (xs++) (tail $ poset ys) in tail $ nc [x] xs
- 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)
J
Here, solution sequences are calculated abstractly by ncs, then used by ncs_of to draw items from the input list. The algorithm is filtered templates. As marked by sections, ncs (a) makes all possible sub-sequences of the given length, (b) retains those that contain an internal gap, then (c) returns a list of their index-lists.
NB. ======= c ======= ----b---- ========== a ========== ncs=: (#&.> <@:i.)~ <"1@: (#~ gap) @:(([ $ 2:) #: i.@(2^])) gap=: +./@:((1 i.~ 1 0 E. ])<(1 i:~ 0 1 E. ]))"1 1 @: ((##0:),.]) ncs_of=: # (ncs@[ {&.> ]) <
Examples:
ncs 4 +---+---+---+-----+-----+ |1 3|0 3|0 2|0 2 3|0 1 3| +---+---+---+-----+-----+ ncs_of 9 8 7 6 +---+---+---+-----+-----+ |8 6|9 6|9 7|9 7 6|9 8 6| +---+---+---+-----+-----+ ncs_of 'aeiou' +--+--+--+---+---+--+--+---+--+---+---+----+---+---+----+----+ |iu|eu|eo|eou|eiu|au|ao|aou|ai|aiu|aio|aiou|aeu|aeo|aeou|aeiu| +--+--+--+---+---+--+--+---+--+---+---+----+---+---+----+----+
OCaml
Taken from the Haskell's monadic filter example.
<lang 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 </lang>
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]]
Pop11
We modify classical recusive 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]]
Python
Adapted from the Scheme version.
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 # www.research.att.com/~njas/sequences/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)) )
Ruby
Uses code from Power Set <lang ruby>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.find_all {|seq| not seq.continuous} end
def continuous each_cons(2) {|a, b| return false if a+1 != 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</lang>
[[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]]
Scheme
Taken from the Haskell's monadic filter example.
<lang 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)))))))
</lang>
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))
Standard ML
Taken from the Haskell's monadic filter example.
<lang sml> 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 </lang>
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
Tcl
This Tcl implementation uses the subsets function from Power Set, which is acceptable as that conserves the ordering, as well as a problem-specific test function is_not_continuous and a generic list filter lfilter:
<lang Tcl>
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 {$e-1 != $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} </lang>