Non-continuous subsequences: Difference between revisions

Content added Content deleted

Inline

Revision as of 23:05, 18 December 2009

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:

AutoHotkey

using filtered templates 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>

Common Lisp

<lang lisp>(defun all-subsequences (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))))
          (continuous-p (subsequence-d)
            "True if the designated subsequence is continuous."
            (loop for i in subsequence-d
                  for j on (first subsequence-d)
                  always (eq i j)))
          (designated-sequence (subsequence-d)
            "Destructively transforms a subsequence designator into
             the designated subsequence."
            (map-into subsequence-d 'first subsequence-d)))
   (let ((nc-subsequences (delete-if #'continuous-p (subsequences list))))
     (map-into nc-subsequences #'designated-sequence nc-subsequences))))</lang>

Translation of: Scheme

<lang lisp>(defun all-subsequences2 (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)))</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

<lang haskell>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</lang>

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.

<lang haskell>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</lang>

Recursive

Recursive method with powerset as helper function.

<lang haskell>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</lang>

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. <lang j>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@[ {&.> ]) <</lang> Examples: <lang j> 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| +--+--+--+---+---+--+--+---+--+---+---+----+---+---+----+----+</lang>

JavaScript

Uses powerset() function from here. Uses a JSON stringifier from http://www.json.org/js.html

Works with: SpiderMonkey

<lang javascript>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[j-1] != 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]))));</lang>

Outputs:

[[1,3],[1,4],[2,4],[1,2,4],[1,3,4]]

Mathematica

We make all the subsets then filter out the continuous ones:

<lang Mathematica>GoodBad[i_List]:=Not[MatchQ[Differences[i],{1..}|{}]] n=5 Select[Subsets[Range[n]],GoodBad]</lang>

gives back:

OCaml

Translation of: Generalized monadic filter

<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]]

Oz

A nice application of finite set constraints. We just describe what we want and the constraint system will deliver it: <lang oz>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 subseqence
          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]}}</lang>

Pop11

We modify classical recusive generation of subsets, using variables to keep track if subsequence is continuous.

<lang pop11>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]) =></lang>

Output: <lang pop11>[[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]]</lang>

Python

Translation of: Scheme

<lang 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 []</lang>

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:

<lang python>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)) )</lang>

R

The idea behind this is to loop over the possible lengths of subsequence, finding all subsequences then discarding those which are continuous.

<lang r>ncsub <- function(x) {

  n <- length(x)
  a <- seq_len(n)
  seqlist <- list()
  for(i in 2:(n-1))
  {
     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])</lang>

Ruby

Translation of: Tcl

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

Translation of: Generalized monadic filter

<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

Translation of: Generalized monadic filter

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

Ursala

To do it the lazy programmer way, apply the powerset library function to the list, which will generate all continuous and non-continuous 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).

<lang Ursala>#import std

noncontinuous = num; ^rlK3ZK17rSS/~& powerset

show+

examples = noncontinuous 'abcde'</lang>

Output:

abce
abd
abde
abe
ac
acd
acde
ace
ad
ade
ae
bce
bd
bde
be
ce