Non-continuous subsequences

From Rosetta Code
Task
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.

D

The list of non-continuous subsequences is constructed in the following way:

  1. Select some continuous subsequences of length at least 3 from the original sequence;
  2. From each such continuous subsequences, remove arbitrary elements from the middle, but always keep the first and last element.

That cannot generate duplicate sequences, because first and last elements determine the corresponding continous sequence uniquely. Also, sequences of length less than three cannot contain non-continuous subsequences by definition.

<d>module ncsub ; import std.stdio ;

struct Combi {

 private int n_, m_ ;
 alias int delegate(inout int[]) dg_type ;
 int opApply(dg_type dg) { return combinate([], 0, m_, dg) ; }
 int combinate(int[] fixed, int next, int left, dg_type dg) {
   if (left <= 0) dg(fixed) ;
   else
     for(int i = next ; i < n_ - left + 1; i++)
       combinate(fixed ~ [i+1], i + 1, left - 1, dg) ;
   return 0 ;
 }

}

T[] takesome(T)(T[] seq, int[] rmIndexs) {

 T[] res = seq.dup ;
 foreach(idx ; rmIndexs.reverse) 
   res = res[0..idx] ~ res[idx+1..$] ;
 return res ;

}

T[][] ncsub(T)(T[] seq) {

 if(seq.length < 3) return [] ;
 T[][] ncset ;
 for(int head = 0 ; head < seq.length - 2 ; head++)
   for(int tail = head + 2 ; tail < seq.length ; tail++) {
     T[] contseq = seq[head..tail+1] ;
     for(int takeNum = 1 ; takeNum < contseq.length - 1 ; takeNum++)
       foreach(removeIndexs ; Combi(contseq.length - 2, takeNum))
         ncset ~= takesome(contseq, removeIndexs) ;
   }
 return ncset ;

}

void main() {

 writefln(ncsub([1,2,3])) ;
 writefln(ncsub([1,2,3,4])) ;
 writefln(ncsub([1,2,3,4,5])) ;  // results match Haskell examples
 writefln(ncsub([1,1,1,1,1])) ;  

}</d>

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

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.

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

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

print ncsub(range(1, 4))
print ncsub(range(1, 5))
print ncsub(range(1, 6))

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

Scheme

Taken from the Haskell's monadic filter example.

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

</scheme>

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