Non-continuous subsequences: Difference between revisions
(Added PowerShell example) |
|||
Line 718: | Line 718: | ||
[2 3 5] [1 2 3 5] [1 4 5] [2 4 5] [1 2 4 5] [1 3 4 5]]</lang> |
[2 3 5] [1 2 3 5] [1 4 5] [2 4 5] [1 2 4 5] [1 3 4 5]]</lang> |
||
=={{header|PowerShell}}== |
|||
<lang PowerShell>Function SubSequence ( [Array] $S, [Boolean] $all=$false ) |
|||
{ |
|||
$sc = $S.count |
|||
if( $sc -gt ( 2 - [Int32] $all ) ) { |
|||
[void] $sc-- |
|||
0..$sc | ForEach-Object { |
|||
$gap = $_ |
|||
"$( $S[ $_ ] )" |
|||
if( $gap -lt $sc ) |
|||
{ |
|||
SubSequence ( ( $gap + 1 )..$sc | Where-Object { $_ -ne $gap } ) ( ( $gap -ne 0 ) -or $all ) | ForEach-Object { |
|||
[String]::Join( ',', ( ( [String]$_ ).Split(',') | ForEach-Object { |
|||
$lt = $true |
|||
} { |
|||
if( $lt -and ( $_ -gt $gap ) ) |
|||
{ |
|||
$S[ $gap ] |
|||
$lt = $false |
|||
} |
|||
$S[ $_ ] |
|||
} { |
|||
if( $lt ) |
|||
{ |
|||
$S[ $gap ] |
|||
} |
|||
} |
|||
) ) |
|||
} |
|||
} |
|||
} |
|||
#[String]::Join( ',', $S) |
|||
} else { |
|||
$S | ForEach-Object { [String] $_ } |
|||
} |
|||
} |
|||
Function NonContinuous-SubSequence ( [Array] $S ) |
|||
{ |
|||
$sc = $S.count |
|||
if( $sc -eq 3 ) |
|||
{ |
|||
[String]::Join( ',', $S[ ( 0,2 ) ] ) |
|||
} elseif ( $sc -gt 3 ) { |
|||
[void] $sc-- |
|||
$gaps = @() |
|||
$gaps += ( ( NonContinuous-SubSequence ( 1..$sc ) ) | ForEach-Object { |
|||
$gap1 = ",$_," |
|||
"0,{0}" -f ( [String]::Join( ',', ( 1..$sc | Where-Object { $gap1 -notmatch "$_," } ) ) ) |
|||
} ) |
|||
$gaps += 1..( $sc - 1 ) |
|||
2..( $sc - 1 ) | ForEach-Object { |
|||
$gap2 = $_ - 1 |
|||
$gaps += ( ( SubSequence ( $_..$sc ) ) | ForEach-Object { |
|||
"$gap2,$_" |
|||
} ) |
|||
} |
|||
#Write-Host "S $S gaps $gaps" |
|||
$gaps | ForEach-Object { |
|||
$gap3 = ",$_," |
|||
"$( 0..$sc | Where-Object { $gap3 -notmatch ",$_," } | ForEach-Object { |
|||
$S[$_] |
|||
} )" -replace ' ', ',' |
|||
} |
|||
} else { |
|||
$null |
|||
} |
|||
} |
|||
( NonContinuous-SubSequence 'a','b','c','d','e' ) | Select-Object length, @{Name='value';Expression={ $_ } } | Sort-Object length, value | ForEach-Object { $_.value }</lang> |
|||
=={{header|Prolog}}== |
=={{header|Prolog}}== |
Revision as of 22:24, 3 December 2010
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
Recursive
<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
ALGOL 68
Recursive
- note: This specimen retains the original Ada coding style.
<lang algol68>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</lang> Output:
aeiu aeo aeou aeu ai aio aiou aiu ao aou au eiu eo eou eu iu
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. <lang algol68>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 lim-1 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 # )
)</lang> Output:
iu eu eo eou eiu au ao aou ai aiu aio aiou aeu aeo aeou aeiu
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>
C
Loosely based on the J implementation.
Note: This specimen can only handle lists of length less than the number of bits in an int. <lang C>#include <assert.h>
- include <stdio.h>
main(int c, char**v) {
int i, j, k; int n= c-1; unsigned int lim=1<<n; assert(lim); /* check int's bit width limit */ int K= lim>>1; for (j= 1; j < lim; j++) { int state= 0; for (k= K; k; k>>=1) { int b= j&k; switch (state) { case 0: if (b) state++; break; case 1: if (!b) state++; break; case 2: if (!b) continue; for (k= K, i= 1; k; k>>=1, i++) if (j&k) printf("%s\t", v[i]); printf("\n"); /* k=0, now, ending containing loop */ } } }
}</lang> Example use:
$ ./noncont 1 2 3 4 2 4 1 4 1 3 1 3 4 1 2 4
Using GMP
The use of GMP allows for more than 8*sizeof(unsigned int) (being 8 the bits in a char/byte) arguments. The following code is a translation basically 1:1 of the previous code and is not tested for a lot of arguments. The limit is now given by the maximum number of arguments on the command line.
<lang c>#include <stdio.h>
- include <gmp.h>
int main(int c, char **v) {
int n= c-1, i; mpz_t lim, K, j, k, b; mpz_init_set_ui(lim, 1); mpz_mul_2exp(lim, lim, n); // lim = 1<<n mpz_init_set(K, lim); mpz_tdiv_q_2exp(K, K, 1); // K = lim >> 1
mpz_init(j); mpz_init(k); mpz_init(b);
for (mpz_set_ui(j, 1); mpz_cmp(j, lim) < 0; mpz_add_ui(j, j, 1)) { int state= 0; for (mpz_set(k, K); mpz_cmp_ui(k, 0) != 0; mpz_tdiv_q_2exp(k, k, 1)) { mpz_and(b, j, k); int cmb = mpz_cmp_ui(b, 0); switch (state) { case 0: if (cmb) state++; break; case 1: if (!cmb) state++; break; case 2: if (!cmb) continue;
for (mpz_set(k, K), i=1; mpz_cmp_ui(k, 0) != 0; mpz_tdiv_q_2exp(k, k, 1), i++) { mpz_and(b, j, k); if ( mpz_cmp_ui(b, 0) != 0 ) printf("%s\t", v[i]); } printf("\n"); /* k=0, now, ending containing loop */
} } } return 0;
}</lang>
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:
<lang lisp> (use '[clojure.contrib.combinatorics :only (subsets)])
(defn of-min-length [min-length]
(fn [s] (>= (count s) min-length)))
(defn runs [c l]
(map (partial take l) (take-while not-empty (iterate rest c))))
(defn is-subseq? [c sub]
(some identity (map = (runs c (count sub)) (repeat sub))))
(defn non-continuous-subsequences [s]
(filter (complement (partial is-subseq? s)) (subsets s)))
(filter (of-min-length 2) (non-continuous-subsequences [:a :b :c :d]))
</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>
<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 = 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)</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
We select those combinations where the end of the first continuous subsequence appears before the start of the last continuous subsequence:
<lang J>allmasks=: 2 #:@i.@^ # firstend=:1 0 i.&1@E."1 ] laststart=: 0 1 {:@I.@E."1 ] noncont=: <@#~ (#~ firstend < laststart)@allmasks</lang>
Example use: <lang J> 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│ └──┴──┴──┴───┴───┴──┴──┴───┴──┴───┴───┴────┴───┴───┴────┴────┘</lang>
Alternatively, since there are relatively few continuous sequences, we could specifically exclude them:
<lang J>contmasks=: a: ;@, 1 <:/~@i.&.>@i.@+ # noncont=: <@#~ (allmasks -. contmasks)</lang>
JavaScript
Uses powerset() function from here. Uses a JSON stringifier from http://www.json.org/js.html
<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:
<lang Mathematica> {{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}}</lang>
OCaml
<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 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]}}</lang>
PicoLisp
<lang 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) ) ) ) ) ) ) )</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>
PowerShell
<lang PowerShell>Function SubSequence ( [Array] $S, [Boolean] $all=$false ) {
$sc = $S.count if( $sc -gt ( 2 - [Int32] $all ) ) { [void] $sc-- 0..$sc | ForEach-Object { $gap = $_ "$( $S[ $_ ] )" if( $gap -lt $sc ) { SubSequence ( ( $gap + 1 )..$sc | Where-Object { $_ -ne $gap } ) ( ( $gap -ne 0 ) -or $all ) | ForEach-Object { [String]::Join( ',', ( ( [String]$_ ).Split(',') | ForEach-Object { $lt = $true } { if( $lt -and ( $_ -gt $gap ) ) { $S[ $gap ] $lt = $false } $S[ $_ ] } { if( $lt ) { $S[ $gap ] } } ) ) } } } #[String]::Join( ',', $S) } else { $S | ForEach-Object { [String] $_ } }
}
Function NonContinuous-SubSequence ( [Array] $S ) {
$sc = $S.count if( $sc -eq 3 ) { [String]::Join( ',', $S[ ( 0,2 ) ] ) } elseif ( $sc -gt 3 ) { [void] $sc-- $gaps = @() $gaps += ( ( NonContinuous-SubSequence ( 1..$sc ) ) | ForEach-Object { $gap1 = ",$_," "0,{0}" -f ( [String]::Join( ',', ( 1..$sc | Where-Object { $gap1 -notmatch "$_," } ) ) ) } ) $gaps += 1..( $sc - 1 ) 2..( $sc - 1 ) | ForEach-Object { $gap2 = $_ - 1 $gaps += ( ( SubSequence ( $_..$sc ) ) | ForEach-Object { "$gap2,$_" } ) } #Write-Host "S $S gaps $gaps" $gaps | ForEach-Object { $gap3 = ",$_," "$( 0..$sc | Where-Object { $gap3 -notmatch ",$_," } | ForEach-Object { $S[$_] } )" -replace ' ', ',' } } else { $null }
}
( NonContinuous-SubSequence 'a','b','c','d','e' ) | Select-Object length, @{Name='value';Expression={ $_ } } | Sort-Object length, value | ForEach-Object { $_.value }</lang>
Prolog
Works with SWI-Prolog.
We explain to Prolog how to build a non continuous subsequence of a list L, then we ask Prolog to fetch all the subsequences.
<lang Prolog> % 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)). </lang> Example : <lang Prolog>?- 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]]</lang>
Python
<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>
REXX
<lang rexx> /*REXX program to list non-continuous subsequences. */
parse arg list /*the the list from arg. */ if list== then list=1 2 3 4 /*if null, then use default*/ list=space(list) /*remove extraneous blanks.*/ say 'list='list /*echo the list to console.*/ say w=words(list) /*number of words in list. */ seqs=0 /*number of NCS's so far. */
do j=1 for w /*step thought the list. */
do k=2 to w /*insure non-continuity. */ _=word(list,j) /*assume the start of NCS. */
do m=j+k to w /*non-continuity skip is K.*/ _=_ word(list,m) if words(_)\==1 then do /*have we found a NCS yet? */ seqs=seqs+1 /*bump the NCS counter. */ say _ /*display the NCS. */ end end /*m*/ end /*k*/ end /*j*/
say say 'The list has' seqs "non-continuous subsequences." </lang> Output from the default (with no input):
list=1 2 3 4 1 3 1 3 4 1 4 2 4 The list has 4 non-continuous subsequences.
Output from the following input:
a e I o u
list=a e I o u a I a I o a I o u a o a o u a u e o e o u e u I u The list has 10 non-continuous subsequences.
Output from the following input [channel Islands (Great Britain)]:
Alderney Guernsey Herm Jersey Sark
list=Alderney Guernsey Herm Jersey Sark Alderney Herm Alderney Herm Jersey Alderney Herm Jersey Sark Alderney Jersey Alderney Jersey Sark Alderney Sark Guernsey Jersey Guernsey Jersey Sark Guernsey Sark Herm Sark The list has 10 non-continuous subsequences.
Output from the following input [six nobel gases]:
helium neon argon krypton xenon radon
list=helium neon argon kyptron xenon radon helium argon helium argon kyptron helium argon kyptron xenon helium argon kyptron xenon radon helium kyptron helium kyptron xenon helium kyptron xenon radon helium xenon helium xenon radon helium radon neon kyptron neon kyptron xenon neon kyptron xenon radon neon xenon neon xenon radon neon radon argon xenon argon xenon radon argon radon kyptron radon The list has 20 non-continuous subsequences.
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
<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
<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