Non-continuous subsequences: Difference between revisions

From Rosetta Code
Content added Content deleted
(Added J solution.)
(→‎{{header|Haskell}}: added my own version)
Line 82: Line 82:
[[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]]
[[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]]
</pre>
</pre>

===A different implementation===
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


=={{header|J}}==
=={{header|J}}==

Revision as of 00:50, 29 March 2008

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.

A subsequence contains some, but not all elements of this sequence, in the same order.

A continuous subsequence is missing elements only before its beginning and after its end.

The task is to 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.


D

(I may be misunderstood...) The list of non-continuous subsequences is constructed from some what different from task description, but should be equivalent way:

  1. from the original sequence, select some continuous subsequences of length >= 3,
  2. from each continuous subsequences in (1), remove some in-between elements beside first and last element,
  3. each subsequences some elements removed in (2) is a non-continuous subsequences.

Notes:assumes continuous subsequences of length < 3 does not contain non continuous subsequences, <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])) ;  // should this return [] ? that is, no non-cont subseq.

}</d>

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 

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

A different implementation

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

   ncs=: (#&.> <@:i.)~ <"1@:(#~ gap)@:(([ $ 2:) #: i.@(2^]))
   gap=: +./@:((1 i.~ 1 0 E. ])<(1 i:~ 0 1 E. ]))"1 1 @: ((##0:),.])

Example use:

   ncs 4
+---+---+---+-----+-----+
|1 3|0 3|0 2|0 2 3|0 1 3|
+---+---+---+-----+-----+