Font "Courier New"
cls
Module Checkit {
      t=(((1,2), (3,4,1),5),)    ' use (1,) for one item tuple
      Tuple$ = lambda$ (a, feed$=" ") -> {
            \\ we can pass a tuple of two arguments or two arguments
            k=each(a)
            lim=len(a)-1
            res$="("
            link a to a() ' to use type$()
            while k {
                  if type$(a(k^))="mArray" then
                        res$+=Lambda$(array(a, k^),feed$+" ")
                        if k^<lim then
                              res$+={,
                              }+feed$
                        end if
                  else
                        res$+= trim$(str$(array(k)))
                        if k^<lim then res$+=", "
                  end if
            }
            =res$+")"
      }
      TotalPayload = lambda (a)->{
            k=each(a)
            link a to a()
            res=0
            while k {
                  if type$(a(k^))="mArray" then
                        res+=Lambda(a(k^))
                  else
                        res++
                  end if
            }
            =res
      }
      Payload = lambda (a,payloads as list)->{
           misspayloads=List
           used=list
           inner=lambda misspayloads, p=1, payloads, used (a)-> {
                  k=each(a)
                  res=(,)
                  link a to a()
                  while k {
                        if type$(a(k^))="mArray" then
                             Append res, (Lambda(a(k^)),)
                        else
                              curpayload$="Payload#"+trim$(str$(array(k)))

                              if not exist(payloads, curpayload$) Then
                                    if not exist(used, curpayload$) Then
                                          Append res, ("missing#pos"+trim$(str$(p)),)
                                          append misspayloads, p:=curpayload$
                                    else
                                          Append res, (curpayload$,)
                                    End if
                                    p++
                              else
                                    Append res, (curpayload$,)
                                    if exist(payloads, curpayload$) then
                                          delete payloads, curpayload$
                                          if not exist(used, curpayload$) then append used, curpayload$
                                    end if
                                    p++
                              end if
                        end if
                  }
                  =res
            }
            =inner(a), payloads, misspayloads
      }
      Expand$ =lambda$ (a as array, unused as list, misspayloads as list)-> {
            Read ? space$
            inner$= lambda$ (a, feed$=" ")->{
                  k=each(a)
                  lim=len(a)-1
                  res$="["
                  link a to a() ' to use type$()
                  while k {
                        if type$(a(k^))="mArray" then
                              res$+=Lambda$(array(a, k^),feed$+" ")
                              if k^<lim then
                                    res$+={,
                                    }+feed$
                              end if
                        else
                              res$+= "'"+array$(k)+"'"
                              if k^<lim then res$+=", "
                        end if
                  }
                  =res$+"]"
            }
            document unused$="Unused Payloads"+{
            }
            if len(unused)>0 then
                  un=each(unused)
                  while un {
                        unused$="  "+eval$(un)+{
                        }
                  }
            else
                  unused$="  -"
            end if
            if len(misspayloads)>0 then
                  un=each(misspayloads)
                  lim=len(misspayloads)-1
                  document missing$="Missing in position: "+{
                  }
                  while un {
                        missing$="  "+eval$(un)+"-pos"+eval$(un,un^)+{
                        }
                  }
                  =inner$(a, space$)+{
                  }+unused$+missing$
            Else
                  =inner$(a, space$)+{
                  } + unused$
            End if
      }
      flush
      Data t, (((1,10), (3,4,16),5),)
      While not empty {
            Read t
            Document result$="Payloads:"+{
            }
            p=list
            for i=0 to 6 {
                  Append p, "Payload#"+trim$(str$(i))
                  result$="  "+eval$(p, i)+{
                  }
            }
            result$="Template:"+{
            }
            result$="  "+Tuple$(t, "   ")+{
            }
            result$="Template with Payloads:"+{
            }
            m=Payload(t, p)
            result$="  "+Expand$(!m, "   ")

            clipboard result$
      }

}
Checkit
Report clipboard$


import macros,sugar,strformat
#macro to take a nested tuple and return a type
#e.g. (int,(int,int))=>(string,(string,string))
proc intstr(n: NimNode): NimNode =
  if n.kind == nnkSym:
    return ident("string")
  result = nnkPar.newNimNode()
  for i in 1..<n.len:
    result.add(intstr(n[i]))

macro tuptype(t: typed): untyped = intstr(t.getType)

proc replace(t: tuple | int, p: openArray[string]): auto =
  when t is int: (if t in 0..<p.len: p[t] else: "nil")
  else:
    var res: tuptype(t)
    for k, v in t.fieldpairs:
      #k will be 'Field0', so we convert to an integer index
      res[k[^1].int - '0'.int] = replace(v, p)
    return res
when isMainModule:
  let p = collect(for i in 0..5: &"payload{i}")

  let tplt1 = ((1,2),(3,4,1),5)
  let tplt2 = ((1,2),(3,4,1),6)
  echo replace(tplt1, p)
  echo replace(tplt2, p)


sub fulfill {
    my   @payloads;
    push @payloads, 'Payload#' . $_ for 0..5;
    my      @result;
    push    @result, ref $_ eq 'ARRAY' ? [@payloads[@$_]] : @payloads[$_] for @{@_[0]};
    return [@result];
}

sub formatted {
    my $result;
    $result .= ref $_ eq 'ARRAY' ? '[ "'. join('", "', @$_) . '" ], ' : qq{"$_"} for @{@_[0]};
    return '[ ' . $result . " ]\n";
}

print formatted fulfill( [[1,2], [ 3,4,1], 5] );
print formatted fulfill( [[1,2], [10,4,1], 5] );


constant template = { { { 1, 2 }, { 3, 4, 1, }, 5 } },
         template2 =  { { { 1, 2 }, { 10, 4, 1 }, 5 } },
         payload = {"Payload#0", "Payload#1", "Payload#2", "Payload#3", "Payload#4", "Payload#5", "Payload#6"}
sequence unused = repeat(true,length(payload)),
         missing = {}

function fill(object t, sequence p)
    if integer(t) then
        if t>=length(p) then
            if not find(t,missing) then missing &= t end if
            return sprintf("*** index error (%d>%d) ***",{t,length(p)-1})
        end if
        unused[t+1] = false
        return p[t+1]
    end if
    for i=1 to length(t) do
        t[i] = fill(t[i],p)
    end for
    return t
end function

ppOpt({pp_Nest,2})
pp(fill(template,payload))
pp(fill(template2,payload))

sequence idx = {}
for i=1 to length(unused) do
    if unused[i] then idx &= i-1 end if
end for
printf(1,"\nThe unused payloads have indices of :%s\n", {sprint(idx)})

if length(missing) then
    printf(1,"Missing payloads: %s\n", {sprint(missing)})
end if


from pprint import pprint as pp

class Template():
    def __init__(self, structure):
        self.structure = structure
        self.used_payloads, self.missed_payloads = [], []

    def inject_payload(self, id2data):

        def _inject_payload(substruct, i2d, used, missed):
            used.extend(i2d[x] for x in substruct if type(x) is not tuple and x in i2d)
            missed.extend(f'??#{x}'
                          for x in substruct if type(x) is not tuple and x not in i2d)
            return tuple(_inject_payload(x, i2d, used, missed)
                           if type(x) is tuple
                           else i2d.get(x, f'??#{x}')
                         for x in substruct)

        ans = _inject_payload(self.structure, id2data,
                              self.used_payloads, self.missed_payloads)
        self.unused_payloads = sorted(set(id2data.values())
                                      - set(self.used_payloads))
        self.missed_payloads = sorted(set(self.missed_payloads))
        return ans

if __name__ == '__main__':
    index2data = {p: f'Payload#{p}' for p in range(7)}
    print("##PAYLOADS:\n  ", end='')
    print('\n  '.join(list(index2data.values())))
    for structure in [
     (((1, 2),
       (3, 4, 1),
       5),),

     (((1, 2),
       (10, 4, 1),
       5),)]:
        print("\n\n# TEMPLATE:")
        pp(structure, width=13)
        print("\n TEMPLATE WITH PAYLOADS:")
        t = Template(structure)
        out = t.inject_payload(index2data)
        pp(out)
        print("\n UNUSED PAYLOADS:\n  ", end='')
        unused = t.unused_payloads
        print('\n  '.join(unused) if unused else '-')
        print(" MISSING PAYLOADS:\n  ", end='')
        missed = t.missed_payloads
        print('\n  '.join(missed) if missed else '-')


fill_template <- function(x, template, prefix = "Payload#") {
  for (i in seq_along(template)) {
    temp_slice <- template[[i]]
    if (is.list(temp_slice)) {
      template[[i]] <- fill_template(x, temp_slice, prefix)
    } else {
      temp_slice <- paste0(prefix, temp_slice)
      template[[i]] <- x[match(temp_slice, x)]
    }
  }
  return(template)
}

library("jsonlite") # for printing the template and result
template <- list(list(c(1, 2), c(3, 4), 5))
payload  <- paste0("Payload#", 0:6)
result   <- fill_template(payload, template)

cat(sprintf(
  "Template\t%s\nPayload\t%s\nResult\t%s",
  toJSON(template, auto_unbox = TRUE),
  toJSON(payload, auto_unbox = TRUE),
  toJSON(result, auto_unbox = TRUE)
))


#lang racket

(define current-not-found-handler
  (make-parameter (λ (idx max) (raise-range-error 'substitute-template "integer?" "" idx 0 max))))

(define ((substitute-template template) payloads)
  (define match-function
    (match-lambda
      [(? nonnegative-integer? idx) #:when (< idx (length payloads)) (list-ref payloads idx)]
      [(? nonnegative-integer? idx) ((current-not-found-handler) idx (sub1 (length payloads)))]
      [(list (app match-function substitutions) ...) substitutions]))
  (match-function template))

(module+ test
  (require rackunit)

  (define substitute-in-t (substitute-template '(((1 2)
                                                  (3 4 1)
                                                  5))))

  (define p '(Payload#0 Payload#1 Payload#2 Payload#3 Payload#4 Payload#5 Payload#6))

  (check-equal? (substitute-in-t p)
                '(((Payload#1 Payload#2)
                   (Payload#3 Payload#4 Payload#1)
                   Payload#5)))

  (define out-of-bounds-generating-template-substitution (substitute-template '(7)))

  (check-exn exn:fail:contract? (λ () (out-of-bounds-generating-template-substitution p)))

  (parameterize ((current-not-found-handler (λ (idx max) (format "?~a" idx))))
    (check-equal? (out-of-bounds-generating-template-substitution p) '("?7"))))


/* REXX */
tok.=''
Do i=0 To 6
  tok.i="'Payload#"i"'"
  End
t1='[[[1,2],[3,4,1],5]]'
t2='[[[1,6],[3,4,7,0],5]]'
Call transform t1
Call transform t2
Exit

transform:
Parse Arg t 1 tt
/* http://rosettacode.org/wiki/Nested_templated_data */
/*
[[['Payload#1', 'Payload#2'],
  ['Payload#3', 'Payload#4', 'Payload#1'],
  'Payload#5']]
*/
lvl=0
n.=0
o=''
w=''
used.=0
Do While t<>''
  Parse Var t c +1 1 c3 +3 1 c2 +2
  u=' '
  v=' '
  Select
    When c3='],[' Then Do
      o=o'  '
      w=w'  '
      t=substr(t,3)
      End
    When c2='],' Then Do
      o=o' '
      w=w' '
      t=substr(t,2)
      lvl=lvl-1
      End
    When c='[' Then
      lvl=lvl+1
    When c=']' Then
      lvl=lvl-1
    When c=',' Then
      Nop
    Otherwise Do
      u=lvl
      v=c
      End
    End
  t=substr(t,2)
  o=o||u
  w=w||v
  End
Say 'Template' tt
Do i=1 By 1 While w<>''
  If i=1 Then Do
    w=substr(w,4)
    p=pos('  ',w)
    Call o '[[['cont(left(w,p-1))'],'
    w=substr(w,p)
    End
  Else Do
    If left(w,3)='' Then Do
      w=substr(w,4)
      p=pos('  ',w)
      Call o '  ['cont(left(w,p-1))'],'
      w=substr(w,p)
      End
    Else Do
      w=substr(w,3)
      p=pos('  ',w)
      Call o '  'cont(left(w,p-1))']]'
      w=substr(w,p)
      End
    End
  End
Do i=0 To 6
  If used.i=0 Then Say 'Payload' i 'not used'
  End
Call o ' '
Return

o: Say arg(1)
   Return

cont: Procedure Expose tok. used.
  Parse Arg list
  res=''
  Do while list>''
    Parse Var list i list
    res= res tok(i)','
    End
  res=strip(res)
  res=strip(res,'T',',')
  Return res

tok: Procedure Expose tok. used.
Parse Arg i
If tok.i<>'' Then Do
  used.i=1
  Return tok.i
  End
Else
  Return "'Payload#" i "not defined'"


Public Sub test()
    Dim t(2) As Variant
    t(0) = [{1,2}]
    t(1) = [{3,4,1}]
    t(2) = 5
    p = [{"Payload#0","Payload#1","Payload#2","Payload#3","Payload#4","Payload#5","Payload#6"}]
    Dim q(6) As Boolean
    For i = LBound(t) To UBound(t)
        If IsArray(t(i)) Then
            For j = LBound(t(i)) To UBound(t(i))
                q(t(i)(j)) = True
                t(i)(j) = p(t(i)(j) + 1)
            Next j
        Else
            q(t(i)) = True
            t(i) = p(t(i) + 1)
        End If
    Next i
    For i = LBound(t) To UBound(t)
        If IsArray(t(i)) Then
            Debug.Print Join(t(i), ", ")
        Else
            Debug.Print t(i)
        End If
    Next i
    For i = LBound(q) To UBound(q)
        If Not q(i) Then Debug.Print p(i + 1); " is not used"
    Next i
End Sub


import "/set" for Set
import "/sort" for Sort

var withPayload // recursive function
withPayload = Fn.new { |template, payload, used|
    return template.map { |item|
        if (item is List) {
            return withPayload.call(item, payload, used)
        } else {
            used.add(item)
            return "'%(payload[item])'"
        }
    }.toList
}

var p = ["Payload#0", "Payload#1", "Payload#2", "Payload#3", "Payload#4", "Payload#5", "Payload#6"]
var t = [[[1, 2], [3, 4, 1], 5]]
var used = []
System.print(withPayload.call(t, p, used))
System.print()
var unused  = Set.new(0..6).except(Set.new(used)).toList
Sort.insertion(unused)
System.print("The unused payloads have indices of %(unused).")


var payloads=[1..6].pump(List,"Payload#".append);

fcn get(n){ try{ payloads[n - 1] }catch{ Void } }
fcn sub(list){ list.pump(List, fcn(n){ if(n.isType(List)) sub(n) else get(n) }) }


F ncsub(seq, s = 0)
   I seq.empty
      R I s >= 3 {[[Int]()]} E [[Int]]()
   E
      V x = seq[0.<1]
      V xs = seq[1..]
      V p2 = s % 2
      V p1 = !p2
      R ncsub(xs, s + p1).map(ys -> @x + ys) [+] ncsub(xs, s + p2)

print(ncsub(Array(1..3)))
print(ncsub(Array(1..4)))
print(ncsub(Array(1..5)))


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;


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


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
}


      DIM list1$(3)
      list1$() = "1", "2", "3", "4"
      PRINT "For [1, 2, 3, 4] non-continuous subsequences are:"
      PROCnon_continuous_subsequences(list1$())
      DIM list2$(4)
      list2$() = "1", "2", "3", "4", "5"
      PRINT "For [1, 2, 3, 4, 5] non-continuous subsequences are:"
      PROCnon_continuous_subsequences(list2$())
      END

      DEF PROCnon_continuous_subsequences(l$())
      LOCAL i%, j%, g%, n%, r%, s%, w%, a$, b$
      n% = DIM(l$(),1)
      FOR s% = 0 TO n%-2
        FOR g% = s%+1 TO n%-1
          a$ = "["
          FOR i% = s% TO g%-1
            a$ += l$(i%) + ", "
          NEXT
          FOR w% = 1 TO n%-g%
            r% = n%+1-g%-w%
            FOR i% = 1 TO 2^r%-1 STEP 2
              b$ = a$
              FOR j% = 0 TO r%-1
                IF i% AND 2^j% b$ += l$(g%+w%+j%) + ", "
              NEXT
              PRINT LEFT$(LEFT$(b$)) + "]"
            NEXT i%
          NEXT w%
        NEXT g%
      NEXT s%
      ENDPROC


( ( noncontinuous
  =   sub
    .     ( sub
          =   su a nc
            .   !arg:(?su.?nc)
              &   !su
                :   %
                    %?a
                    ( %:[%(sub$(!sjt.!nc !a))
                    |   ?
                      & !nc:~
                      & out$(!nc !a)
                      & ~
                    )
          )
        & sub$(dummy !arg.)
      |
  )
& noncontinuous$(e r n i t)
);


#include <assert.h>
#include <stdio.h>

int main(int c, char **v)
{
	unsigned int n = 1 << (c - 1), i = n, j, k;
	assert(n);

	while (i--) {
		if (!(i & (i + (i & -(int)i)))) // consecutive 1s
			continue;

		for (j = n, k = 1; j >>= 1; k++)
			if (i & j) printf("%s ", v[k]);

		putchar('\n');
	}

	return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;

class Program
{
    public static void Main() {
        var sequence = new[] { "A", "B", "C", "D" };
        foreach (var subset in Subsets(sequence.Length).Where(s => !IsContinuous(s))) {
            Console.WriteLine(string.Join(" ", subset.Select(i => sequence[i])));
        }
    }

    static IEnumerable<List<int>> Subsets(int length) {
        int[] values = Enumerable.Range(0, length).ToArray();
        var stack = new Stack<int>(length);
        for (int i = 0; stack.Count > 0 || i < length; ) {
            if (i < length) {
                stack.Push(i++);
                yield return (from index in stack.Reverse() select values[index]).ToList();
            } else {
                i = stack.Pop() + 1;
                if (stack.Count > 0) i = stack.Pop() + 1;
            }
        }
    }

    static bool IsContinuous(List<int> list) => list[list.Count - 1] - list[0] + 1 == list.Count;

}


/*
 * Nigel Galloway, July 19th., 2017 - Yes well is this any better?
 */
class N{
  uint n,i,g,e,l;
public:
  N(uint n): n(n-1),i{},g{},e(1),l(n-1){}
  bool hasNext(){
    g=(1<<n)+e;for(i=l;i<n;++i) g+=1<<i;
    if (l==2)             {l=--n; e=1; return true;}
    if (e<((1<<(l-1))-1)) {++e;        return true;}
                           e=1; --l;   return (l>0);
  }
  uint next() {return g;}
};


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


is_contigous_binary = (n) ->
  # return true if binary representation of n is
  # of the form 1+0+
  # examples:
  #     0 true
  #     1 true
  #   100 true
  #   110 true
  #  1001 false
  #  1010 false

  # special case zero, or you'll get an infinite loop later
  return true if n == 0

  # first remove 0s from end
  while n % 2 == 0
    n = n / 2

  # next, take advantage of the fact that a continuous
  # run of 1s would be of the form 2^n - 1
  is_power_of_two(n + 1)

is_power_of_two = (m) ->
  while m % 2 == 0
    m = m / 2
  m == 1

seq_from_bitmap = (arr, n) ->
  # grabs elements from array according to a bitmap
  # e.g. if n == 13 (1101), and arr = ['a', 'b', 'c', 'd'],
  # then return ['a', 'c', 'd'] (flipping bits to 1011, so
  # that least significant bit comes first)
  i = 0
  new_arr = []
  while n > 0
    if n % 2 == 1
      new_arr.push arr[i]
      n -= 1
    n /= 2
    i += 1
  new_arr

non_contig_subsequences = (arr) ->
  # Return all subsqeuences from an array that have a "hole" in
  # them.  The order of the subsequences is not specified here.

  # This algorithm uses binary counting, so it is limited to
  # small lists, but large lists would be unwieldy regardless.
  bitmasks = [0...Math.pow(2, arr.length)]
  (seq_from_bitmap arr, n for n in bitmasks when !is_contigous_binary n)

arr = [1,2,3,4]
console.log non_contig_subsequences arr
for n in [1..10]
  arr = [1..n]
  num_solutions = non_contig_subsequences(arr).length
  console.log "for n=#{n} there are #{num_solutions} solutions"


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


T[][] ncsub(T)(in T[] seq, in uint s=0) pure nothrow @safe {
    if (seq.length) {
        typeof(return) aux;
        foreach (ys; ncsub(seq[1 .. $], s + !(s % 2)))
            aux ~= seq[0] ~ ys;
        return aux ~ ncsub(seq[1 .. $], s + s % 2);
    } else
        return new typeof(return)(s >= 3, 0);
}

void main() @safe {
    import std.stdio;

    [1, 2, 3].ncsub.writeln;
    [1, 2, 3, 4].ncsub.writeln;
    foreach (const nc; [1, 2, 3, 4, 5].ncsub)
        nc.writeln;
}


defmodule RC do
  defp masks(n) do
    maxmask = trunc(:math.pow(2, n)) - 1
    Enum.map(3..maxmask, &Integer.to_string(&1, 2))
    |> Enum.filter_map(&contains_noncont(&1), &String.rjust(&1, n, ?0)) # padding
  end

  defp contains_noncont(n) do
    Regex.match?(~r/10+1/, n)
  end

  defp apply_mask_to_list(mask, list) do
    Enum.zip(to_char_list(mask), list)
    |> Enum.filter_map(fn {include, _} -> include > ?0 end, fn {_, value} -> value end)
  end

  def ncs(list) do
    Enum.map(masks(length(list)), fn mask -> apply_mask_to_list(mask, list) end)
  end
end

IO.inspect RC.ncs([1,2,3])
IO.inspect RC.ncs([1,2,3,4])
IO.inspect RC.ncs('abcd')


-module(rosetta).
-export([ncs/1]).

masks(N) ->
    MaxMask = trunc(math:pow(2, N)),
    Total = lists:map(fun(X) -> integer_to_list(X, 2) end,
                lists:seq(3, MaxMask)),
    Filtered = lists:filter(fun(X) -> contains_noncont(X) end, Total),
    lists:map(fun(X) -> string:right(X, N, $0) end, Filtered). % padding

contains_noncont(N) ->
    case re:run(N, "10+1") of
        {match, _} -> true;
        nomatch -> false
    end.

apply_mask_to_list(Mask, List) ->
    Zipped = lists:zip(Mask, List),
    Filtered = lists:filter(fun({Include, _}) -> Include > 48 end, Zipped),
    lists:map(fun({_, Value}) -> Value end, Filtered).

ncs(List) ->
    lists:map(fun(Mask) -> apply_mask_to_list(Mask, List) end,
                masks(length(List))).


(*
  A function to generate only the non-continuous subsequences.
  Nigel Galloway July 20th., 2017
*)
let N n =
  let     fn n = Seq.map (fun g->(2<<<n)+g)
  let rec fg n = seq{if n>0 then yield! seq{1..((1<<<n)-1)}|>fn n; yield! fg (n-1)|>fn n}
  Seq.collect fg ({1..(n-2)})


Sub Subsecuencias_no_continuas(l() As String)
    Dim As Integer i, j, g, n, r, s, w
    Dim As String a, b, c
    n = Ubound(l)
    For s = 0 To n-2
        For g = s+1 To n-1
            a = "["
            For i = s To g-1
                a += l(i) + ", "
            Next i
            For w = 1 To n-g
                r = n+1-g-w
                For i = 1 To 2^r-1 Step 2
                    b = a
                    For j = 0 To r-1
                        If i And 2^j Then b += l(g+w+j) + ", "
                    Next j
                    'Print Left(Left(b)) + "]"
                    c = (Left(b, Len (b)-1))
                    Print Left(c, Len(c)-1) + "]"
                Next i
            Next w
        Next g
    Next s
End Sub

Dim lista1(3) As String = {"1", "2", "3", "4"}
Print "Para [1, 2, 3, 4] las subsecuencias no continuas son:"
Subsecuencias_no_continuas(lista1())
Dim lista2(4) As String = {"e", "r", "n", "i", "t"}
Print "Para [e, r, n, i, t] las subsecuencias no continuas son:"
Subsecuencias_no_continuas(lista2())
Sleep


package main

import "fmt"

const ( // state:
    m   = iota // missing:  all elements missing so far
    c          // continuous:  all elements included so far are continuous
    cm         // one or more continuous followed by one or more missing
    cmc        // non-continuous subsequence
)

func ncs(s []int) [][]int {
    if len(s) < 3 {
        return nil
    }
    return append(n2(nil, s[1:], m), n2([]int{s[0]}, s[1:], c)...)
}

var skip = []int{m, cm, cm, cmc}
var incl = []int{c, c, cmc, cmc}

func n2(ss, tail []int, seq int) [][]int {
    if len(tail) == 0 {
        if seq != cmc {
            return nil
        }
        return [][]int{ss}
    }
    return append(n2(append([]int{}, ss...), tail[1:], skip[seq]),
        n2(append(ss, tail[0]), tail[1:], incl[seq])...)
}

func main() {
    ss := ncs([]int{1, 2, 3, 4})
    fmt.Println(len(ss), "non-continuous subsequences:")
    for _, s := range ss {
        fmt.Println("  ", s)
    }
}


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


allmasks=: 2 #:@[email protected]^ #
firstend=:1 0 i.&1@E."1 ]
laststart=: 0 1 {:@[email protected]"1 ]
noncont=: <@#~ (#~ firstend < laststart)@allmasks


public class NonContinuousSubsequences {

    public static void main(String args[]) {
        seqR("1234", "", 0, 0);
    }

    private static void seqR(String s, String c, int i, int added) {
        if (i == s.length()) {
            if (c.trim().length() > added)
                System.out.println(c);
        } else {
            seqR(s, c + s.charAt(i), i + 1, added + 1);
            seqR(s, c + ' ', i + 1, added);
        }
    }
}


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


# Generate a stream of subsets of the input array
def subsets:
  if length == 0 then []
  else .[0] as $first
    | (.[1:] | subsets)
    | ., ([$first] + .)
  end ;

# Generate a stream of non-continuous indices in the range 0 <= i < .
def non_continuous_indices:
  [range(0;.)] | subsets
  | select(length > 1 and length != 1 + .[length-1] - .[0]) ;

def non_continuous_subsequences:
  (length | non_continuous_indices) as $ix
  | [.[ $ix[] ]] ;


using Printf, IterTools

import Base.IteratorSize, Base.iterate, Base.length

iscontseq(n::Integer) = count_zeros(n) == leading_zeros(n) + trailing_zeros(n)
iscontseq(n::BigInt)  = !ismatch(r"0", rstrip(bin(n), '0'))

function makeint2seq(n::Integer)
    idex = collect(1:n)
    function int2seq(m::Integer)
        d = digits(m, base=2, pad=n)
        idex[d .== 1]
    end
    return int2seq
end

struct NCSubSeq{T<:Integer}
    n::T
end

mutable struct NCSubState{T<:Integer}
    m::T
    m2s::Function
end

Base.IteratorSize(::NCSubSeq) = Base.HasLength()
Base.length(a::NCSubSeq) = 2 ^ a.n - a.n * (a.n + 1) ÷ 2 - 1
function Base.iterate(a::NCSubSeq, as::NCSubState=NCSubState(5, makeint2seq(a.n)))
    if 2 ^ a.n - 3 < as.m
        return nothing
    end
    s = as.m2s(as.m)
    as.m += 1
    while iscontseq(as.m)
        as.m += 1
    end
    return (s, as)
end

n = 4
println("Testing NCSubSeq for ", n, " items:\n ", join(NCSubSeq(n), " "))

s = "Rosetta"
cs = split(s, "")
m = 10
n = length(NCSubSeq(length(cs))) - m
println("\nThe first and last ", m, " NC sub-sequences of \"", s, "\":")
for (i, a) in enumerate(NCSubSeq(length(s)))
    i <= m || n < i || continue
    println(@sprintf "%6d %s" i join(cs[a], ""))
    i == m || continue
    println("    .. ......")
end

println("\nThe first and last ", m, " NC sub-sequences of \"", s, "\"")
for x in IterTools.Iterators.flatten([1:10; 20:10:40; big.(50:50:200)])
    @printf "%7d → %d\n" x length(NCSubSeq(x))
end


// version 1.1.2

fun <T> ncs(a: Array<T>) {
    fun generate(m: Int, k: Int, c: IntArray) {
        if (k == m) {
            if (c[m - 1] != c[0] + m - 1) {
                for (i in 0 until m)  print("${a[c[i]]} ")
                println()
            }
        }
        else {
            for (j in 0 until a.size) {
                if (k == 0 || j > c[k - 1]) {
                    c[k] = j
                    generate(m, k + 1, c)
                }
            }
        }
    }

    for (m in 2 until a.size) {
        val c = IntArray(m)
        generate(m, 0, c)
    }
}

fun main(args: Array<String>) {
    val a = arrayOf(1, 2, 3, 4)
    ncs(a)
    println()
    val ca = arrayOf('a', 'b', 'c', 'd', 'e')
    ncs(ca)
}


Module Non_continuous_subsequences (item$(), display){
	Function positions(n) {
		function onebit {
			=lambda b=false (&c)-> {
				=b :if c then  b~:c=not b
			}
		}
		dim k(n)=onebit(), p(n)
		m=true
		flush
		for i=1 to 2^n {
			for j=0 to n-1 :p(j)= k(j)(&m) :next
			m1=p(0)
			m2=0
			for j=1 to n-1
				if m2 then if m1>p(j) then m2=2:exit for
				if m1 < p(j) then m2++
				m1=p(j)
			next
			if m2=2 then data cons(p())' push a copy of p() to end of stack
			m=true
		}
		=array([])
	}

	a=positions(len(item$()))
	if display then
		For i=0 to len(a)-1
			b=array(a,i)
			line$=format$("{0::-5})",i+1,)
			for j=0 to len(b)-1
				if array(b,j) then line$+=" "+item$(j)
			next
			print line$
			doc$<=line$+{
			}
		next
	end if
	line$="Non continuous subsequences:"+str$(len(a))
	Print line$
	doc$<=line$+{
	}
}
global doc$
document doc$   ' change string to document object
Non_continuous_subsequences ("1","2","3","4"), true
Non_continuous_subsequences ("a","e","i","o","u"), true
Non_continuous_subsequences ("R","o","s","e","t","t","a"), true
Non_continuous_subsequences ("1","2","3","4","5","6","7","8","9","0"), false
clipboard doc$


import sequtils

proc ncsub[T](se: seq[T], s = 0): seq[seq[T]] =
  result = @[]
  if se.len > 0:
    let
      x = se[0..0]
      xs = se[1 .. ^1]
      p2 = s mod 2
      p1 = (s + 1) mod 2
    for ys in ncsub(xs, s + p1):
      result.add(x & ys)
    result.add(ncsub(xs, s + p2))
  elif s >= 3:
    result.add(@[])

echo "ncsub(", toSeq 1.. 3, ") = ", ncsub(toSeq 1..3)
echo "ncsub(", toSeq 1.. 4, ") = ", ncsub(toSeq 1..4)
echo "ncsub(", toSeq 1.. 5, ") = ", ncsub(toSeq 1..5)


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


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


noncontig(n)=n>>=valuation(n,2);n++;n>>=valuation(n,2);n>1;
nonContigSubseq(v)={
  for(i=5,2^#v-1,
    if(noncontig(i),
      print(vecextract(v,i))
    )
  )
};
nonContigSubseq([1,2,3])
nonContigSubseq(["a","b","c","d","e"])


my ($max, @current);
sub non_continuous {
        my ($idx, $has_gap) = @_;
        my $found;

        for ($idx .. $max) {
                push @current, $_;
                # print "@current\n" if $has_gap; # uncomment for huge output
                $found ++ if $has_gap;
                $found += non_continuous($_ + 1, $has_gap)   if $_ < $max;
                pop @current;
                $has_gap = @current;   # don't set gap flag if it's empty still
        }
        $found;
}

$max = 20;
print "found ", non_continuous(1), " sequences\n";


with javascript_semantics
integer count = 0

procedure ncs(sequence rest, object taken, integer ri=0, bool contig=false, bool gap=false)
    if ri>=length(rest) then
        if contig then
            if integer(taken) then
                count += 1
            else
                ?taken
            end if
        end if
    else
        ri += 1
        ncs(rest,iff(integer(taken)?taken+1:deep_copy(taken)&rest[ri]),ri,gap,gap)
        ncs(rest,taken,ri,contig,iff(integer(taken)?taken!=0:length(taken)!=0))
    end if
end procedure

ncs({1,2,3},{})
?"==="
ncs({1,2,3,4},{})
?"==="
atom t0 = time()
sequence s = {}
for i=1 to 20 do
    count = 0
    ncs(tagset(i),0)
    s = append(s,count)
end for
?elapsed(time()-t0)
pp(s)


import util.

go =>
  println(1..4=non_cont(1..4)),
  L = "abcde".reverse(),
  println(L=non_cont(L)),
  println(ernit=non_cont("ernit")),
  println(aaa=non_cont("aaa")),
  println(aeiou=non_cont("aeiou")),
  nl,

  println("Printing just the lengths for 1..N for N = 1..20:"),
  foreach(N in 1..20)
    println(1..N=non_cont(1..N).length) % just the length
  end,
  nl.

% get all the non-continuous subsequences
non_cont(L) = [ [L[I] : I in S] : S in non_cont_ixs(L.length)].

% get all the index positions that are non-continuous
non_cont_ixs(N) = [ P:  P in power_set(1..N), length(P) > 1, P.last() - P.first() != P.length-1].


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


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


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 }


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


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


  [ dup 1 & dip [ 1 >> ] ] is 2/mod         (   n --> n n )

  [ 0 swap
    [ dup 0 != while
      2/mod iff
        [ dip 1+ ] done
      again ]
    [ dup 0 != while
      2/mod not iff
        [ dip 1+ ] done
      again ]
    [ dup 0 != while
      2/mod iff
        [ dip 1+ ] done
      again ]
    drop 3 = ]             is noncontinuous (   n --> b   )

  [ [] unrot
    [ dup 0 != while
      dip behead tuck
      1 & iff
        [ nested dip rot
          join unrot ]
      else drop
      1 >> again ]
    2drop ]                is bitems        ( [ n --> [   )

  [ [] swap
    dup size bit times
     [ i^ noncontinuous if
        [ dup i^ bitems
          nested rot
          join swap ] ]
     drop ]                is ncsubs        (   [ --> [   )

  ' [ 1 2 3 4 ] ncsubs echo cr

  $ "quackery" ncsubs 72 wrap$


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


(define (subsets l)
  (if (null? l) '(())
      (append (for/list ([l2 (subsets (cdr l))]) (cons (car l) l2))
              (subsets (cdr l)))))


sub non_continuous_subsequences ( *@list ) {
    @list.combinations.grep: { 1 != all( .[ 0 ^.. .end] Z- .[0 ..^ .end] ) }
}

say non_continuous_subsequences( 1..3 )».gist;
say non_continuous_subsequences( 1..4 )».gist;
say non_continuous_subsequences(   ^4 ).map: {[<a b c d>[.list]].gist};


/*REXX program lists all the  non─continuous subsequences  (NCS),   given a sequence.   */
parse arg list                                   /*obtain optional argument from the CL.*/
if list='' | list==","  then list= 1 2 3 4 5     /*Not specified?  Then use the default.*/
say 'list='  space(list);             say        /*display the list to the terminal.    */
w= words(list)                                   /*W:  is the number of items in list.  */
nums= strip( left(123456789, w) )                /*build a string of decimal digits.    */
tail= right(nums, max(0, w-2) )                  /*construct a fast tail for comparisons*/
#= 0                                             /*#:  number of non─continuous subseq. */
      do j=13  to left(nums,1) || tail           /*step through list (using smart start)*/
      if verify(j, nums) \== 0  then iterate     /*Not one of the chosen  (sequences) ? */
      f= left(j, 1)                              /*use the fist decimal digit of  J.    */
      NCS= 0                                     /*so far, no non─continuous subsequence*/
               do k=2  for length(j)-1           /*search for  "       "          "     */
               x= substr(j, k, 1)                /*extract a single decimal digit of  J.*/
               if x  <= f    then iterate j      /*if next digit ≤, then skip this digit*/
               if x \== f+1  then NCS= 1         /*it's OK as of now  (that is, so far).*/
               f= x                              /*now have a  new  next decimal digit. */
               end   /*k*/
      $=
      if \NCS  then iterate                      /*not OK?  Then skip this number (item)*/
      #= # + 1                                   /*Eureka!  We found a number (or item).*/
               do m=1  for length(j)             /*build a sequence string to display.  */
               $= $ word(list, substr(j, m, 1) ) /*obtain a number (or item) to display.*/
               end   /*m*/

      say 'a non─continuous subsequence: '   $   /*show the non─continuous subsequence. */
      end         /*j*/
say                                              /*help ensure visual fidelity in output*/
if #==0  then #= 'no'                            /*make it look more gooder Angleshy.   */
say  #   "non─continuous subsequence"s(#)    'were found.'             /*handle plurals.*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
s:  if arg(1)==1  then return '';   return word( arg(2) 's',  1)    /*simple pluralizer.*/


# Project : Non-continuous subsequences

load "stdlib.ring"
list = [1,2,3,4]
items = newlist(pow(2,len(list))-1,len(list))
see "For [1, 2, 3, 4] non-continuous subsequences are:" + nl
powerset(list,4)
showarray(items,4)
see nl

list = [1,2,3,4,5]
items = newlist(pow(2,len(list))-1,len(list))
see "For [1, 2, 3, 4, 5] non-continuous subsequences are:" + nl
powerset(list,5)
showarray(items,5)

func showarray(items,ind)
        for n = 1 to len(items)
             flag = 0
             for m = 1 to ind - 1
                  if items[n][m] = 0 or items[n][m+1] = 0
                     exit
                 ok
                 if (items[n][m] + 1) != items[n][m+1]
                     flag = 1
                     exit
                 ok
            next
            if flag = 1
               see "["
               str = ""
               for x = 1 to len(items[n])
                    if items[n][x] != 0
                       str = str + items[n][x] + " "
                    ok
               next
               str = left(str, len(str) - 1)
               see str + "]" + nl
            ok
        next

func powerset(list,ind)
        num = 0
        num2 = 0
        items = newlist(pow(2,len(list))-1,ind)
        for i = 2 to (2 << len(list)) - 1 step 2
             num2 = 0
             num = num + 1
             for j = 1 to len(list)
                  if i & (1 << j)
                      num2 = num2 + 1
                      if list[j] != 0
                        items[num][num2] = list[j]
                     ok
                  ok
             next
        next
        return items


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.reject {|seq| continuous?(seq)}
  end

  def continuous?(seq)
    seq.each_cons(2) {|a, b| return false if a.succ != 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
p ("a".."d").to_a.non_continuous_subsequences


object NonContinuousSubSequences extends App {

  private def seqR(s: String, c: String, i: Int, added: Int): Unit = {
    if (i == s.length) {
      if (c.trim.length > added) println(c)
    } else {
      seqR(s, c + s(i), i + 1, added + 1)
      seqR(s, c + " ", i + 1, added)
    }
  }

  seqR("1234", "", 0, 0)
}


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


$ include "seed7_05.s7i";

const func array bitset: ncsub (in bitset: seq, in integer: s) is func
  result
    var array bitset: subseq is 0 times {};
  local
    var bitset: x is {};
    var bitset: xs is {};
    var bitset: ys is {};
  begin
    if seq <> {} then
      x := {min(seq)};
      xs := seq - x;
      for ys range ncsub(xs, s + 1 - s rem 2) do
        subseq &:= x | ys;
      end for;
      subseq &:= ncsub(xs, s + s rem 2);
    elsif s >= 3 then
      subseq &:= {};
    end if;
  end func;

const proc: main is func
  local
    var bitset: seq is {};
  begin
    for seq range ncsub({1, 2, 3, 4}, 0) do
      writeln(seq);
    end for;
  end func;


func non_continuous(min, max, subseq=[], has_gap=false) {

    static current = [];

    range(min, max).each { |i|
        current.push(i);
        has_gap && subseq.append([current...]);
        i < max && non_continuous(i.inc, max, subseq, has_gap);
        current.pop;
        has_gap = current.len;
    }

    subseq;
}

say non_continuous(1, 3);
say non_continuous(1, 4);
say non_continuous("a", "d");


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


 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}


#import std

noncontinuous = num; ^rlK3ZK17rSS/~& powerset

#show+

examples = noncontinuous 'abcde'


'Non-continuous subsequences - VBScript - 03/02/2021

Function noncontsubseq(l)
    Dim  i, j, g, n, r, s, w, m
    Dim  a, b, c
    n = Ubound(l)
    For s = 0 To n-2
        For g = s+1 To n-1
            a = "["
            For i = s To g-1
                a = a & l(i) & ", "
            Next 'i
            For w = 1 To n-g
                r = n+1-g-w
                For i = 1 To 2^r-1 Step 2
                    b = a
                    For j = 0 To r-1
                        If i And 2^j Then b=b & l(g+w+j) & ", "
                    Next 'j
                    c = (Left(b, Len(b)-1))
                    WScript.Echo Left(c, Len(c)-1) & "]"
					m = m+1
                Next 'i
            Next 'w
        Next 'g
    Next 's
    noncontsubseq = m
End Function 'noncontsubseq

list = Array("1", "2", "3", "4")
WScript.Echo "List: [" & Join(list, ", ") & "]"
nn = noncontsubseq(list)
WScript.Echo nn & " non-continuous subsequences"


import "/fmt" for Fmt

var ncs = Fn.new { |a|
    var f = "$d "
    if (a[0] is String) {
        for (i in 0...a.count) a[i] = a[i].bytes[0]
        f = "$c "
    }
    var generate // recursive
    generate = Fn.new { |m, k, c|
        if (k == m) {
            if (c[m - 1] != c[0] + m - 1) {
                for (i in 0...m) Fmt.write(f, a[c[i]])
                System.print()
            }
        } else {
            for (j in 0...a.count) {
                if (k == 0 || j > c[k - 1]) {
                    c[k] = j
                    generate.call(m, k + 1, c)
                }
            }
        }
    }

    for (m in 2...a.count) {
        var c = List.filled(m, 0)
        generate.call(m, 0, c)
    }
}

var a = [1, 2, 3, 4]
ncs.call(a)
System.print()
var ca = ["a", "b", "c", "d", "e"]
ncs.call(ca)


fcn non_continuous_subsequences(ary){
   pwerSet(ary).filter(fcn(list){(not isContinuous(list)) })
}
fcn isContinuous(ary){
   if(ary.len()<2) return(True);
   foreach n in (ary.len()-1){ if(1+ary[n]!=ary[n+1]) return(False); }
   return(True);
}
non_continuous_subsequences(T(1,2,3,4)).println();


F closest_more_than(n, lst)
   V large = max(lst) + 1
   R lst.index(min(lst, key' x -> (I x <= @n {@large} E x)))

F nexthigh(n)
   V this = reversed(Array(n.map(digit -> Int(digit))))
   V mx = this[0]
   L(digit) this[1..]
      V i = L.index + 1
      I digit < mx
         V mx_index = closest_more_than(digit, this[0 .< i + 1])
         swap(&this[mx_index], &this[i])
         this.sort_range(0 .< i, reverse' 1B)
         R reversed(this).map(d -> String(d)).join(‘’)
      E I digit > mx
         mx = digit
   R ‘0’

L(x) [‘0’, ‘9’, ‘12’, ‘21’, ‘12453’, ‘738440’, ‘45072010’, ‘95322020’,
      ‘9589776899767587796600’]
   print(‘#12 -> #12’.format(x, nexthigh(x)))


Next_highest_int(num){
	Arr := []
	for i, v in permute(num)
		Arr[v] := true
	for n, v in Arr
		if found
			return n
		else if (n = num)
			found := true
	return 0
}
permute(str, k:=0, l:=1){
	static res:=[]
	r := StrLen(str)
	k := k ? k : r
	if (l = r)
		return SubStr(str, 1, k)
	i := l
	while (i <= r){
		str := swap(str, l, i)
		x := permute(str, k, l+1)
		if (x<>"")
			res.push(x)
		str := swap(str, l, i++)
	}
	if (l=1)
		return x:=res, res := []
}
swap(str, l, i){
	x := StrSplit(str), var := x[l], x[l] := x[i], x[i] := var
	Loop, % x.count()
		res .= x[A_Index]
	return res
}


#include <stdbool.h>
#include <stdio.h>
#include <stdint.h>
#include <stdlib.h>
#include <string.h>

void swap(char* str, int i, int j) {
    char c = str[i];
    str[i] = str[j];
    str[j] = c;
}

void reverse(char* str, int i, int j) {
    for (; i < j; ++i, --j)
        swap(str, i, j);
}

bool next_permutation(char* str) {
    int len = strlen(str);
    if (len < 2)
        return false;
    for (int i = len - 1; i > 0; ) {
        int j = i, k;
        if (str[--i] < str[j]) {
            k = len;
            while (str[i] >= str[--k]) {}
            swap(str, i, k);
            reverse(str, j, len - 1);
            return true;
        }
    }
    return false;
}

uint32_t next_highest_int(uint32_t n) {
    char str[16];
    snprintf(str, sizeof(str), "%u", n);
    if (!next_permutation(str))
        return 0;
    return strtoul(str, 0, 10);
}

int main() {
    uint32_t numbers[] = {0, 9, 12, 21, 12453, 738440, 45072010, 95322020};
    const int count = sizeof(numbers)/sizeof(int);
    for (int i = 0; i < count; ++i)
        printf("%d -> %d\n", numbers[i], next_highest_int(numbers[i]));
    // Last one is too large to convert to an integer
    const char big[] = "9589776899767587796600";
    char next[sizeof(big)];
    memcpy(next, big, sizeof(big));
    next_permutation(next);
    printf("%s -> %s\n", big, next);
    return 0;
}


#include <algorithm>
#include <iostream>
#include <sstream>

#include <gmpxx.h>

using integer = mpz_class;

std::string to_string(const integer& n) {
    std::ostringstream out;
    out << n;
    return out.str();
}

integer next_highest(const integer& n) {
    std::string str(to_string(n));
    if (!std::next_permutation(str.begin(), str.end()))
        return 0;
    return integer(str);
}

int main() {
    for (integer n : {0, 9, 12, 21, 12453, 738440, 45072010, 95322020})
        std::cout << n << " -> " << next_highest(n) << '\n';
    integer big("9589776899767587796600");
    std::cout << big << " -> " << next_highest(big) << '\n';
    return 0;
}


import std.algorithm;
import std.array;
import std.conv;
import std.stdio;

string next(string s) {
    auto sb = appender!string;
    auto index = s.length - 1;

    //  Scan right-to-left through the digits of the number until you find a digit with a larger digit somewhere to the right of it.
    while (index > 0 && s[index - 1] >= s[index]) {
        index--;
    }
    //  Reached beginning.  No next number.
    if (index == 0) {
        return "0";
    }

    //  Find digit on the right that is both more than it, and closest to it.
    auto index2 = index;
    foreach (i; index + 1 .. s.length) {
        if (s[i] < s[index2] && s[i] > s[index - 1]) {
            index2 = i;
        }
    }

    //  Found data, now build string
    //  Beginning of String
    if (index > 1) {
        sb ~= s[0 .. index - 1];
    }

    //  Append found, place next
    sb ~= s[index2];

    //  Get remaining characters
    auto chars = [cast(dchar) s[index - 1]];
    foreach (i; index .. s.length) {
        if (i != index2) {
            chars ~= s[i];
        }
    }

    //  Order the digits to the right of this position, after the swap; lowest-to-highest, left-to-right.
    chars.sort;
    sb ~= chars;

    return sb.data;
}

long factorial(long n) {
    long fact = 1;
    foreach (num; 2 .. n + 1) {
        fact *= num;
    }
    return fact;
}

void testAll(string s) {
    writeln("Test all permutations of: ", s);
    string sOrig = s;
    string sPrev = s;
    int count = 1;

    //  Check permutation order.  Each is greater than the last
    bool orderOk = true;
    int[string] uniqueMap = [s: 1];
    while (true) {
        s = next(s);
        if (s == "0") {
            break;
        }

        count++;
        if (s.to!long < sPrev.to!long) {
            orderOk = false;
        }
        uniqueMap.update(s, {
            return 1;
        }, (int a) {
            return a + 1;
        });
        sPrev = s;
    }
    writeln("    Order:  OK =  ", orderOk);

    //  Test last permutation
    auto reverse = sOrig.dup.to!(dchar[]).reverse.to!string;
    writefln("    Last permutation:  Actual = %s, Expected = %s, OK = %s", sPrev, reverse, sPrev == reverse);

    //  Check permutations unique
    bool unique = true;
    foreach (k, v; uniqueMap) {
        if (v > 1) {
            unique = false;
            break;
        }
    }
    writeln("    Permutations unique:  OK =  ", unique);

    //  Check expected count.
    int[char] charMap;
    foreach (c; sOrig) {
        charMap.update(c, {
            return 1;
        }, (int v) {
            return v + 1;
        });
    }
    long permCount = factorial(sOrig.length);
    foreach (k, v; charMap) {
        permCount /= factorial(v);
    }
    writefln("    Permutation count:  Actual = %d, Expected = %d, OK = %s", count, permCount, count == permCount);
}

void main() {
    foreach (s; ["0", "9", "12", "21", "12453", "738440", "45072010", "95322020", "9589776899767587796600", "3345333"]) {
        writeln(s, " -> ", next(s));
    }

    testAll("12345");
    testAll("11122");
}


program Next_highest_int_from_digits;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  System.Generics.Collections;

function StrToBytes(str: AnsiString): TArray<byte>;
begin
  SetLength(result, Length(str));
  Move(Pointer(str)^, Pointer(result)^, Length(str));
end;

function BytesToStr(bytes: TArray<byte>): AnsiString;
begin
  SetLength(Result, Length(bytes));
  Move(Pointer(bytes)^, Pointer(Result)^, Length(bytes));
end;

function Commatize(s: string): string;
begin
  var le := length(s);
  var i := le - 3;
  while i >= 1 do
  begin
    s := s.Substring(0, i) + ',' + s.Substring(i);
    inc(i, -3);
  end;
  Result := s;
end;

function Permute(s: string): TArray<string>;
var
  res: TArray<string>;
  b: string;

  procedure rc(np: Integer);
  begin
    if np = 1 then
    begin
      SetLength(res, Length(res) + 1);
      res[High(res)] := b;
      exit;
    end;

    var np1 := np - 1;
    var pp := length(b) - np1;
    rc(np1);
    for var i := pp downto 1 do
    begin
      var tmp := b[i + 1];
      b[i + 1] := b[i];
      b[i] := tmp;
      rc(np1);
    end;

    var w := b[1];
    delete(b, 1, 1);
    Insert(w, b, pp + 1);
  end;

begin
  if s.Length = 0 then
    exit;

  res := [];
  b := s;
  rc(length(b));
  result := res;
end;

procedure Algorithm1(nums: TArray<string>);
begin
  writeln('Algorithm 1');
  writeln('-----------');
  for var num in nums do
  begin
    var perms := permute(num);
    var le := length(perms);
    if le = 0 then
      Continue;

    TArray.Sort<string>(perms);
    var ix := 0;
    TArray.BinarySearch<string>(perms, num, ix);

    var next := '';
    if ix < le - 1 then
      for var i := ix + 1 to le - 1 do
        if perms[i] > num then
        begin
          next := perms[i];
          Break;
        end;
    if length(next) > 0 then
      writeln(format('%29s -> %s', [Commatize(num), Commatize(next)]))
    else
      writeln(format('%29s -> 0', [Commatize(num)]));
  end;
  writeln;
end;

procedure Algorithm2(nums: TArray<string>);
var
  ContinueMainFor: boolean;
begin

  writeln('Algorithm 2');
  writeln('-----------');

  for var num in nums do
  begin
    ContinueMainFor := false;
    var le := num.Length;
    if le = 0 then
      Continue;

    var b := StrToBytes(num);

    var max := b[le - 1];
    var mi := le - 1;
    for var i := le - 2 downto 0 do
    begin
      if b[i] < max then
      begin
        var min := max - b[i];
        for var j := mi + 1 to le - 1 do
        begin
          var min2 := b[j] - b[i];
          if (min2 > 0) and (min2 < min) then
          begin
            min := min2;
            mi := j;
          end;
        end;
        var tmp := b[i];
        b[i] := b[mi];
        b[mi] := tmp;
        var c := copy(b, i + 1, le);
        TArray.Sort<byte>(c);

        var next: string := BytesToStr(copy(b, 0, i + 1));
        next := next + BytesToStr(c);
        writeln(format('%29s -> %s', [Commatize(num), Commatize(next)]));
        ContinueMainFor := true;
        Break;
      end
      else if b[i] > max then
      begin
        max := b[i];
        mi := i;
      end;
    end;
    if ContinueMainFor then
      Continue;
    writeln(format('%29s -> 0', [Commatize(num)]));
  end;
end;

begin
  var nums: TArray<string> := ['0', '9', '12', '21', '12453', '738440',
    '45072010', '95322020'];
  algorithm1(nums); // exclude the last one

  SetLength(nums, Length(nums) + 1);
  nums[High(nums)] := '9589776899767587796600';

  algorithm2(nums); // include the last one
  {$IFNDEF UNIX}
  readln; {$ENDIF}
end.


USING: formatting grouping kernel math math.combinatorics
math.parser sequences ;

: next-highest ( m -- n )
    number>string dup [ >= ] monotonic?
    [ drop 0 ] [ next-permutation string>number ] if ;

{
    0 9 12 21 12453 738440 45072010 95322020
    9589776899767587796600
}
[ dup next-highest "%d -> %d\n" printf ] each


package main

import (
    "fmt"
    "sort"
)

func permute(s string) []string {
    var res []string
    if len(s) == 0 {
        return res
    }
    b := []byte(s)
    var rc func(int) // recursive closure
    rc = func(np int) {
        if np == 1 {
            res = append(res, string(b))
            return
        }
        np1 := np - 1
        pp := len(b) - np1
        rc(np1)
        for i := pp; i > 0; i-- {
            b[i], b[i-1] = b[i-1], b[i]
            rc(np1)
        }
        w := b[0]
        copy(b, b[1:pp+1])
        b[pp] = w
    }
    rc(len(b))
    return res
}

func algorithm1(nums []string) {
    fmt.Println("Algorithm 1")
    fmt.Println("-----------")
    for _, num := range nums {
        perms := permute(num)
        le := len(perms)
        if le == 0 { // ignore blanks
            continue
        }
        sort.Strings(perms)
        ix := sort.SearchStrings(perms, num)
        next := ""
        if ix < le-1 {
            for i := ix + 1; i < le; i++ {
                if perms[i] > num {
                    next = perms[i]
                    break
                }
            }
        }
        if len(next) > 0 {
            fmt.Printf("%29s -> %s\n", commatize(num), commatize(next))
        } else {
            fmt.Printf("%29s -> 0\n", commatize(num))
        }
    }
    fmt.Println()
}

func algorithm2(nums []string) {
    fmt.Println("Algorithm 2")
    fmt.Println("-----------")
outer:
    for _, num := range nums {
        b := []byte(num)
        le := len(b)
        if le == 0 { // ignore blanks
            continue
        }
        max := num[le-1]
        mi := le - 1
        for i := le - 2; i >= 0; i-- {
            if b[i] < max {
                min := max - b[i]
                for j := mi + 1; j < le; j++ {
                    min2 := b[j] - b[i]
                    if min2 > 0 && min2 < min {
                        min = min2
                        mi = j
                    }
                }
                b[i], b[mi] = b[mi], b[i]
                c := (b[i+1:])
                sort.Slice(c, func(i, j int) bool {
                    return c[i] < c[j]
                })
                next := string(b[0:i+1]) + string(c)
                fmt.Printf("%29s -> %s\n", commatize(num), commatize(next))
                continue outer
            } else if b[i] > max {
                max = num[i]
                mi = i
            }
        }
        fmt.Printf("%29s -> 0\n", commatize(num))
    }
}

func commatize(s string) string {
    le := len(s)
    for i := le - 3; i >= 1; i -= 3 {
        s = s[0:i] + "," + s[i:]
    }
    return s
}

func main() {
    nums := []string{"0", "9", "12", "21", "12453", "738440", "45072010", "95322020", "9589776899767587796600"}
    algorithm1(nums[:len(nums)-1]) // exclude the last one
    algorithm2(nums)               // include the last one
}


import Data.List (nub, permutations, sort)

digitShuffleSuccessors :: Integer -> [Integer]
digitShuffleSuccessors n =
  (fmap . (+) <*> (nub . sort . concatMap go . permutations . show)) n
  where
    go ds
      | 0 >= delta = []
      | otherwise = [delta]
      where
        delta = (read ds :: Integer) - n

--------------------------- TEST ---------------------------
main :: IO ()
main =
  putStrLn $
  fTable
    "Taking up to 5 digit-shuffle successors of a positive integer:\n"
    show
    (\xs ->
        let harvest = take 5 xs
        in rjust
             12
             ' '
             (show (length harvest) <> " of " <> show (length xs) <> ": ") <>
           show harvest)
    digitShuffleSuccessors
    [0, 9, 12, 21, 12453, 738440, 45072010, 95322020]

------------------------- DISPLAY --------------------------
fTable :: String -> (a -> String) -> (b -> String) -> (a -> b) -> [a] -> String
fTable s xShow fxShow f xs =
  unlines $
  s : fmap (((<>) . rjust w ' ' . xShow) <*> ((" -> " <>) . fxShow . f)) xs
  where
    w = maximum (length . xShow <$> xs)

rjust :: Int -> Char -> String -> String
rjust n c = drop . length <*> (replicate n c <>)


import java.math.BigInteger;
import java.text.NumberFormat;
import java.util.ArrayList;
import java.util.Collections;
import java.util.HashMap;
import java.util.List;
import java.util.Map;

public class NextHighestIntFromDigits {

    public static void main(String[] args) {
        for ( String s : new String[] {"0", "9", "12", "21", "12453", "738440", "45072010", "95322020", "9589776899767587796600", "3345333"} ) {
            System.out.printf("%s -> %s%n", format(s), format(next(s)));
        }
        testAll("12345");
        testAll("11122");
    }

    private static NumberFormat FORMAT = NumberFormat.getNumberInstance();

    private static String format(String s) {
        return FORMAT.format(new BigInteger(s));
    }

    private static void testAll(String s) {
        System.out.printf("Test all permutations of:  %s%n", s);
        String sOrig = s;
        String sPrev = s;
        int count = 1;

        //  Check permutation order.  Each is greater than the last
        boolean orderOk = true;
        Map <String,Integer> uniqueMap = new HashMap<>();
        uniqueMap.put(s, 1);
        while ( (s = next(s)).compareTo("0") != 0 ) {
            count++;
            if ( Long.parseLong(s) < Long.parseLong(sPrev) ) {
                orderOk = false;
            }
            uniqueMap.merge(s, 1, (v1, v2) -> v1 + v2);
            sPrev = s;
        }
        System.out.printf("    Order:  OK =  %b%n", orderOk);

        //  Test last permutation
        String reverse = new StringBuilder(sOrig).reverse().toString();
        System.out.printf("    Last permutation:  Actual = %s, Expected = %s, OK = %b%n", sPrev, reverse, sPrev.compareTo(reverse) == 0);

        //  Check permutations unique
        boolean unique = true;
        for ( String key : uniqueMap.keySet() ) {
            if ( uniqueMap.get(key) > 1 ) {
                unique = false;
            }
        }
        System.out.printf("    Permutations unique:  OK =  %b%n", unique);

        //  Check expected count.
        Map<Character,Integer> charMap = new HashMap<>();
        for ( char c : sOrig.toCharArray() ) {
            charMap.merge(c, 1, (v1, v2) -> v1 + v2);
        }
        long permCount = factorial(sOrig.length());
        for ( char c : charMap.keySet() ) {
            permCount /= factorial(charMap.get(c));
        }
        System.out.printf("    Permutation count:  Actual = %d, Expected = %d, OK = %b%n", count, permCount, count == permCount);

    }

    private static long factorial(long n) {
        long fact = 1;
        for (long num = 2 ; num <= n ; num++ ) {
            fact *= num;
        }
        return fact;
    }

    private static String next(String s) {
        StringBuilder sb = new StringBuilder();
        int index = s.length()-1;
        //  Scan right-to-left through the digits of the number until you find a digit with a larger digit somewhere to the right of it.
        while ( index > 0 && s.charAt(index-1) >= s.charAt(index)) {
            index--;
        }
        //  Reached beginning.  No next number.
        if ( index == 0 ) {
            return "0";
        }

        //  Find digit on the right that is both more than it, and closest to it.
        int index2 = index;
        for ( int i = index + 1 ; i < s.length() ; i++ ) {
            if ( s.charAt(i) < s.charAt(index2) && s.charAt(i) > s.charAt(index-1) ) {
                index2 = i;
            }
        }

        //  Found data, now build string
        //  Beginning of String
        if ( index > 1 ) {
            sb.append(s.subSequence(0, index-1));
        }

        //  Append found, place next
        sb.append(s.charAt(index2));

        //  Get remaining characters
        List<Character> chars = new ArrayList<>();
        chars.add(s.charAt(index-1));
        for ( int i = index ; i < s.length() ; i++ ) {
            if ( i != index2 ) {
                chars.add(s.charAt(i));
            }
        }

        //  Order the digits to the right of this position, after the swap; lowest-to-highest, left-to-right.
        Collections.sort(chars);
        for ( char c : chars ) {
            sb.append(c);
        }
        return sb.toString();
    }
}


const compose = (...fn) => (...x) => fn.reduce((a, b) => c => a(b(c)))(...x);
const toString = x => x + '';
const reverse = x => Array.from(x).reduce((p, c) => [c, ...p], []);
const minBiggerThanN = (arr, n) => arr.filter(e => e > n).sort()[0];
const remEl = (arr, e) => {
  const r = arr.indexOf(e);
  return arr.filter((e,i) => i !== r);
}

const nextHighest = itr => {
  const seen = [];
  let result = 0;
  for (const [i,v] of itr.entries()) {
    const n = +v;
    if (Math.max(n, ...seen) !== n) {
      const right = itr.slice(i + 1);
      const swap = minBiggerThanN(seen, n);
      const rem = remEl(seen, swap);
      const rest = [n, ...rem].sort();
      result = [...reverse(right), swap, ...rest].join('');
      break;
    } else {
      seen.push(n);
    }
  }
  return result;
};

const check = compose(nextHighest, reverse, toString);

const test = v => {
  console.log(v, '=>', check(v));
}

test(0);
test(9);
test(12);
test(21);
test(12453);
test(738440);
test(45072010);
test(95322020);
test('9589776899767587796600');


# Generate a stream of all the permutations of the input array
def permutations:
  # Given an array as input, generate a stream by inserting $x at different positions
  def insert($x):
     range (0; length + 1) as $pos
     | .[0:$pos] + [$x] + .[$pos:];

  if length <= 1 then .
  else
    .[0] as $first
    | .[1:] | permutations | insert($first)
  end;

def next_highest:
  (tostring | explode) as $digits
  | ([$digits | permutations] | unique) as $permutations
  | ($permutations | bsearch($digits)) as $i
  | if $i == (($permutations|length) - 1) then 0
    else $permutations[$i+1] | implode
    end;

def task:
  0,
  9,
  12,
  21,
  12453,
  738440,
  45072010,
  95322020;

task | "\(.) => \(next_highest)"


using Combinatorics, BenchmarkTools

asint(dig) = foldl((i, j) -> 10i + Int128(j), dig)

"""
Algorithm 1(A)
Generate all the permutations of the digits and sort into numeric order.
Find the number in the list.
Return the next highest number from the list.
"""
function nexthighest_1A(N)
    n = Int128(abs(N))
    dig = digits(n)
    perms = unique(sort([asint(arr) for arr in permutations(digits(n))]))
    length(perms) < 2 && return 0
    ((N > 0 && perms[end] == n) || (N < 0 && perms[1] == n)) && return 0
    pos = findfirst(x -> x == n, perms)
    ret = N > 0 ? perms[pos + 1] : -perms[pos - 1]
    return ret == N ? 0 : ret
end

"""
Algorithm 1(B)
Iterate through the permutations of the digits of a number and get the permutation that
represents the integer having a minimum distance above the given number.
Return the number plus the minimum distance. Does not store all the permutations.
This saves memory versus algorithm 1A, but we still go through all permutations (slow).
"""
function nexthighest_1B(N)
    n = Int128(abs(N))
    dig = reverse(digits(n))
    length(dig) < 2 && return 0
    mindelta = n
    for perm in permutations(dig)
        if (perm[1] != 0) && ((N > 0 && perm > dig) || (N < 0 && perm < dig))
            delta = abs(asint(perm) - n)
            if delta < mindelta
                mindelta = delta
            end
        end
    end
    return mindelta < n ? N + mindelta : 0
end

"""
Algorithm 2
Scan right-to-left through the digits of the number until you find a digit with a larger digit somewhere to the right of it.
Exchange that digit with the digit on the right that is both more than it, and closest to it.
Order the digits to the right of this position, after the swap; lowest-to-highest, left-to-right.
Very fast, as it does not need to run through all the permutations of digits.
"""
function nexthighest_2(N)
    n = Int128(abs(N))
    dig, ret = digits(n), N
    length(dig) < 2 && return 0
    for (i, d) in enumerate(dig)
        if N > 0 && i > 1
            rdig = dig[1:i-1]
            if (j = findfirst(x -> x > d, rdig)) != nothing
                dig[i], dig[j] = dig[j], dig[i]
                arr = (i == 2) ? dig : [sort(dig[1:i-1], rev=true); dig[i:end]]
                ret = asint(reverse(arr))
                break
            end
        elseif N < 0 && i > 1
            rdig = dig[1:i-1]
            if (j = findfirst(x -> x < d, rdig)) != nothing
                dig[i], dig[j] = dig[j], dig[i]
                arr = (i == 2) ? dig : [sort(dig[1:i-1]); dig[i:end]]
                ret = -asint(reverse(arr))
                break
            end
        end
    end
    return ret == N ? 0 : ret
end

println(" N                       1A                       1B                       2\n", "="^98)
for n in [0, 9, 12, 21, -453, -8888, 12453, 738440, 45072010, 95322020, -592491602, 9589776899767587796600]
        println(rpad(n, 25), abs(n) > typemax(Int) ? " "^50 : rpad(nexthighest_1A(n), 25) *
            rpad(nexthighest_1B(n), 25), nexthighest_2(n))
end

const n = 7384440
@btime nexthighest_1A(n)
println(" for method 1A and n $n.")
@btime nexthighest_1B(n)
println(" for method 1B and n $n.")
@btime nexthighest_2(n)
println(" for method 2 and n $n.")


import java.math.BigInteger
import java.text.NumberFormat

fun main() {
    for (s in arrayOf(
        "0",
        "9",
        "12",
        "21",
        "12453",
        "738440",
        "45072010",
        "95322020",
        "9589776899767587796600",
        "3345333"
    )) {
        println("${format(s)} -> ${format(next(s))}")
    }
    testAll("12345")
    testAll("11122")
}

private val FORMAT = NumberFormat.getNumberInstance()
private fun format(s: String): String {
    return FORMAT.format(BigInteger(s))
}

private fun testAll(str: String) {
    var s = str
    println("Test all permutations of:  $s")
    val sOrig = s
    var sPrev = s
    var count = 1

    //  Check permutation order.  Each is greater than the last
    var orderOk = true
    val uniqueMap: MutableMap<String, Int> = HashMap()
    uniqueMap[s] = 1
    while (next(s).also { s = it }.compareTo("0") != 0) {
        count++
        if (s.toLong() < sPrev.toLong()) {
            orderOk = false
        }
        uniqueMap.merge(s, 1) { a: Int?, b: Int? -> Integer.sum(a!!, b!!) }
        sPrev = s
    }
    println("    Order:  OK =  $orderOk")

    //  Test last permutation
    val reverse = StringBuilder(sOrig).reverse().toString()
    println("    Last permutation:  Actual = $sPrev, Expected = $reverse, OK = ${sPrev.compareTo(reverse) == 0}")

    //  Check permutations unique
    var unique = true
    for (key in uniqueMap.keys) {
        if (uniqueMap[key]!! > 1) {
            unique = false
        }
    }
    println("    Permutations unique:  OK =  $unique")

    //  Check expected count.
    val charMap: MutableMap<Char, Int> = HashMap()
    for (c in sOrig.toCharArray()) {
        charMap.merge(c, 1) { a: Int?, b: Int? -> Integer.sum(a!!, b!!) }
    }
    var permCount = factorial(sOrig.length.toLong())
    for (c in charMap.keys) {
        permCount /= factorial(charMap[c]!!.toLong())
    }
    println("    Permutation count:  Actual = $count, Expected = $permCount, OK = ${count.toLong() == permCount}")
}

private fun factorial(n: Long): Long {
    var fact: Long = 1
    for (num in 2..n) {
        fact *= num
    }
    return fact
}

private fun next(s: String): String {
    val sb = StringBuilder()
    var index = s.length - 1
    //  Scan right-to-left through the digits of the number until you find a digit with a larger digit somewhere to the right of it.
    while (index > 0 && s[index - 1] >= s[index]) {
        index--
    }
    //  Reached beginning.  No next number.
    if (index == 0) {
        return "0"
    }

    //  Find digit on the right that is both more than it, and closest to it.
    var index2 = index
    for (i in index + 1 until s.length) {
        if (s[i] < s[index2] && s[i] > s[index - 1]) {
            index2 = i
        }
    }

    //  Found data, now build string
    //  Beginning of String
    if (index > 1) {
        sb.append(s.subSequence(0, index - 1))
    }

    //  Append found, place next
    sb.append(s[index2])

    //  Get remaining characters
    val chars: MutableList<Char> = ArrayList()
    chars.add(s[index - 1])
    for (i in index until s.length) {
        if (i != index2) {
            chars.add(s[i])
        }
    }

    //  Order the digits to the right of this position, after the swap; lowest-to-highest, left-to-right.
    chars.sort()
    for (c in chars) {
        sb.append(c)
    }
    return sb.toString()
}


ClearAll[NextHighestIntFromDigits]
NextHighestIntFromDigits[n_Integer?NonNegative]:=Module[{digs},
 digs=IntegerDigits[n];
 digs=FromDigits/@Permutations[digs];
 digs=Select[digs,GreaterEqualThan[n]];
 If[Length[digs]==1,First[digs],RankedMin[digs,2]]
]
NextHighestIntFromDigits/@{0,9,12,21,12453,738440,45072010,95322020}


import algorithm

type Digit = range[0..9]

func digits(n: Natural): seq[Digit] =
  ## Return the list of digits of "n" in reverse order.
  if n == 0: return @[Digit 0]
  var n = n
  while n != 0:
    result.add n mod 10
    n = n div 10

func nextHighest(n: Natural): Natural =
  ## Find the next highest integer of "n".
  ## If none is found, "n" is returned.
  var d = digits(n) # Warning: in reverse order.
  var m = d[0]
  for i in 1..d.high:
    if d[i] < m:
      # Find the digit greater then d[i] and closest to it.
      var delta = m - d[i] + 1
      var best: int
      for j in 0..<i:
        let diff = d[j] - d[i]
        if diff > 0 and diff < delta:
          # Greater and closest.
          delta = diff
          best = j
      # Exchange digits.
      swap d[i], d[best]
      # Sort previous digits.
      d[0..<i] = sorted(d.toOpenArray(0, i - 1), Descending)
      break
    else:
      m = d[i]
  # Compute the value from the digits.
  for val in reversed(d):
    result = 10 * result + val

when isMainModule:
  for n in [0, 9, 12, 21, 12453, 738440, 45072010, 95322020]:
    echo n, " → ", nextHighest(n)


use strict;
use warnings;
use feature 'say';
use bigint;
use List::Util 'first';

sub comma { reverse ((reverse shift) =~ s/(.{3})/$1,/gr) =~ s/^,//r }

sub next_greatest_index {
    my($str) = @_;
    my @i = reverse split //, $str;
    @i-1 - (1 + first { $i[$_] > $i[$_+1] } 0 .. @i-1);
}

sub next_greatest_integer {
    my($num) = @_;
    my $numr;
    return 0 if length $num < 2;
    return ($numr = 0 + reverse $num) > $num ? $numr : 0 if length $num == 2;
    return 0 unless my $i = next_greatest_index( $num ) // 0;
    my $digit = substr($num, $i, 1);
    my @rest  = sort split '', substr($num, $i);
    my $next  = first { $rest[$_] > $digit } 1..@rest;
    join '', substr($num, 0, $i), (splice(@rest, $next, 1)), @rest;
}

say 'Next largest integer able to be made from these digits, or zero if no larger exists:';

for (0, 9, 12, 21, 12453, 738440, 45072010, 95322020, 9589776899767587796600, 3345333) {
    printf "%30s  ->  %s\n", comma($_), comma next_greatest_integer $_;
}


function nigh(string n)
    sequence p = repeat("",factorial(length(n)))
    for i=1 to length(p) do
        p[i] = permute(i,n)
    end for
    p = sort(p)
    integer k = rfind(n,p)
    return iff(k=length(p)?"0",p[k+1])
end function

constant tests = {"0","9","12","21","12453",
                  "738440","45072010","95322020"}
--   (crashes on) "9589776899767587796600"}
atom t0 = time()
for i=1 to length(tests) do
    string t = tests[i]
    printf(1,"%22s => %s\n",{t,nigh(t)})
end for
?elapsed(time()-t0)


def closest_more_than(n, lst):
    "(index of) closest int from lst, to n that is also > n"
    large = max(lst) + 1
    return lst.index(min(lst, key=lambda x: (large if x <= n else x)))

def nexthigh(n):
    "Return nxt highest number from n's digits using scan & re-order"
    assert n == int(abs(n)), "n >= 0"
    this = list(int(digit) for digit in str(int(n)))[::-1]
    mx = this[0]
    for i, digit in enumerate(this[1:], 1):
        if digit < mx:
            mx_index = closest_more_than(digit, this[:i + 1])
            this[mx_index], this[i] = this[i], this[mx_index]
            this[:i] = sorted(this[:i], reverse=True)
            return int(''.join(str(d) for d in this[::-1]))
        elif digit > mx:
            mx, mx_index = digit, i
    return 0

if __name__ == '__main__':
    for x in [0, 9, 12, 21, 12453, 738440, 45072010, 95322020,
              9589776899767587796600]:
        print(f"{x:>12_d} -> {nexthigh(x):>12_d}")


use Lingua::EN::Numbers;

sub next-greatest-index ($str, &op = &infix:«<» ) {
    my @i = $str.comb;
    (1..^@i).first: { &op(@i[$_ - 1], @i[$_]) }, :end, :k;
}

multi next-greatest-integer (Int $num where * >= 0) {
    return 0 if $num.chars < 2;
    return $num.flip > $num ?? $num.flip !! 0 if $num.chars == 2;
    return 0 unless my $i = next-greatest-index( $num ) // 0;
    my $digit = $num.substr($i, 1);
    my @rest  = (flat $num.substr($i).comb).sort(+*);
    my $next  = @rest.first: * > $digit, :k;
    $digit    = @rest.splice($next,1);
    join '', flat $num.substr(0,$i), $digit, @rest;
}

multi next-greatest-integer (Int $num where * < 0) {
    return 0 if $num.chars < 3;
    return $num.abs.flip < -$num ?? -$num.abs.flip !! 0 if $num.chars == 3;
    return 0 unless my $i = next-greatest-index( $num, &CORE::infix:«>» ) // 0;
    my $digit = $num.substr($i, 1);
    my @rest  = (flat $num.substr($i).comb).sort(-*);
    my $next  = @rest.first: * < $digit, :k;
    $digit    = @rest.splice($next,1);
    join '', flat $num.substr(0,$i), $digit, @rest;
}

say "Next largest integer able to be made from these digits, or zero if no larger exists:";
printf "%30s  -> %s%s\n", .&comma, .&next-greatest-integer < 0 ?? '' !! ' ', .&next-greatest-integer.&comma for
    flat 0, (9, 12, 21, 12453, 738440, 45072010, 95322020, 9589776899767587796600, 3345333,
    95897768997675877966000000000000000000000000000000000000000000000000000000000000000000).map: { $_, -$_ };


/*REXX program finds the  next highest positive integer  from a list of decimal digits. */
parse arg n                                      /*obtain optional arguments from the CL*/
if n='' | n=","  then n= 0 9 12 21 12453 738440 45072010 95322020    /*use the defaults?*/
w= length( commas( word(n, words(n) ) ) )        /*maximum width number  (with commas). */

     do j=1  for words(n);        y= word(n, j)  /*process each of the supplied numbers.*/
     masky= mask(y)                              /*build a digit mask for a supplied int*/
     lim= copies(9, length(y) )                  /*construct a  LIMIT  for the DO loop. */

          do #=y+1  to lim  until mask(#)==masky /*search for a number that might work. */
          if verify(y, #) \== 0  then iterate    /*does # have all the necessary digits?*/
          end   /*#*/

     if #>lim  then #= 0                         /*if # > lim,  then there is no valid #*/
     say 'for ' right(commas(y),w) " ─── the next highest integer is: " right(commas(#),w)
     end   /*j*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
commas: parse arg _;  do ?=length(_)-3  to 1  by -3;  _= insert(',', _, ?); end;  return _
/*──────────────────────────────────────────────────────────────────────────────────────*/
mask: parse arg z, $;   @.= 0                    /* [↓]  build an  unsorted digit mask. */
                          do k=1  for length(z);    parse var z _ +1 z;     @._= @._ + 1
                          end   /*k*/
        do m=0  for 10;         if @.m==0  then iterate;            $= $ || copies(m, @.m)
        end   /*m*/;      return $               /* [↑]  build  a    sorted  digit mask.*/


load "stdlib.ring"

nhi = [0,9,12,21,12453,738440,45072010,95322020]

for p2 = 1 to len(nhi)
    permut = []
    num2 = nhi[p2]
    nextHighestInt(num2)
next

func nextHighestInt(num)

list = []
numStr = string(num)
lenNum = len(numStr)

if lenNum = 1
   see "" + num + " => " + "0" + nl
   return
ok

for n = 1 to len(numStr)
    p = number(substr(numStr,n,1))
    add(list,p)
next

lenList = len(list)
calmo = []

permut(list)

for n = 1 to len(permut)/lenList
    str = ""
    for m = (n-1)*lenList+1 to n*lenList
        str = str + string(permut[m])
    next
    if str != ""
       strNum = number(str)
       add(calmo,strNum)
    ok
next

for n = len(calmo) to 1 step -1
    lenCalmo = len(string(calmo[n]))
    if lenCalmo < lenNum
       del(calmo,n)
    ok
next

calmo = sort(calmo)

for n = len(calmo) to 2 step -1
    if calmo[n] = calmo[n-1]
       del(calmo,n)
    ok
next

ind = find(calmo,num)
if ind = len(calmo)
   see "" + num + " => " + "0" + nl
else
   see "" + num + " => " + calmo[ind+1] + nl
ok

func permut(list)
     for perm = 1 to factorial(len(list))
         for i = 1 to len(list)
             add(permut,list[i])
         next
         perm(list)
     next

func perm(a)
     elementcount = len(a)
     if elementcount < 1 then return ok
     pos = elementcount-1
     while a[pos] >= a[pos+1]
           pos -= 1
           if pos <= 0 permutationReverse(a, 1, elementcount)
              return ok
     end
     last = elementcount
     while a[last] <= a[pos]
           last -= 1
     end
     temp = a[pos]
     a[pos] = a[last]
     a[last] = temp
     permReverse(a, pos+1, elementcount)

 func permReverse(a,first,last)
      while first < last
            temp = a[first]
            a[first] = a[last]
            a[last] = temp
            first += 1
            last -= 1
      end


fn next_permutation<T: PartialOrd>(array: &mut [T]) -> bool {
    let len = array.len();
    if len < 2 {
        return false;
    }
    let mut i = len - 1;
    while i > 0 {
        let j = i;
        i -= 1;
        if array[i] < array[j] {
            let mut k = len - 1;
            while array[i] >= array[k] {
                k -= 1;
            }
            array.swap(i, k);
            array[j..len].reverse();
            return true;
        }
    }
    false
}

fn next_highest_int(n: u128) -> u128 {
    use std::iter::FromIterator;
    let mut chars: Vec<char> = n.to_string().chars().collect();
    if !next_permutation(&mut chars) {
        return 0;
    }
    String::from_iter(chars).parse::<u128>().unwrap()
}

fn main() {
    for n in &[0, 9, 12, 21, 12453, 738440, 45072010, 95322020, 9589776899767587796600] {
        println!("{} -> {}", n, next_highest_int(*n));
    }
}


func next_from_digits(n, b = 10) {

    var a = n.digits(b).flip

    while (a.next_permutation) {
        with (a.flip.digits2num(b)) { |t|
            return t if (t > n)
        }
    }

    return 0
}

say 'Next largest integer able to be made from these digits, or zero if no larger exists:'

for n in (
    0, 9, 12, 21, 12453, 738440, 3345333, 45072010,
    95322020, 982765431, 9589776899767587796600,
) {
    printf("%30s  ->  %s\n", n, next_from_digits(n))
}


import "/sort" for Sort, Find
import "/fmt" for Fmt
import "/str" for Str

var permute = Fn.new { |s|
    var res = []
    if (s.count == 0) return res
    var bytes = s.bytes.toList
    var rc // recursive closure
    rc = Fn.new { |np|
        if (np == 1) {
            res.add(bytes.map { |b| String.fromByte(b) }.join())
            return
        }
        var np1 = np - 1
        var pp = bytes.count - np1
        rc.call(np1)
        var i = pp
        while (i > 0) {
            var t = bytes[i]
            bytes[i] = bytes[i-1]
            bytes[i-1] = t
            rc.call(np1)
            i = i - 1
        }
        var w = bytes[0]
        for (i in 1...pp+1) bytes[i-1] = bytes[i]
        bytes[pp] = w
    }
    rc.call(bytes.count)
    return res
}

var algorithm1 = Fn.new { |nums|
    System.print("Algorithm 1")
    System.print("-----------")
    for (num in nums) {
        var perms = permute.call(num)
        var le = perms.count
        if (le > 0) { // ignore blanks
            Sort.quick(perms)
            var ix = Find.all(perms, num)[2].from
            var next = ""
            if (ix < le-1) {
                for (i in ix + 1...le) {
                    if (Str.gt(perms[i], num)) {
                        next = perms[i]
                        break
                    }
                }
            }
            if (next.count > 0) {
                Fmt.print("$,29s -> $,s", num, next)
            } else {
                Fmt.print("$,29s -> 0", num)
            }
        }
    }
    System.print()
}

var algorithm2 = Fn.new { |nums|
    System.print("Algorithm 2")
    System.print("-----------")
    for (num in nums) {
        var bytes = num.bytes.toList
        var le = bytes.count
        var outer = false
        if (le > 0) { // ignore blanks
            var max = num[-1].bytes[0]
            var mi = le - 1
            var i = le - 2
            while (i >= 0) {
                if (bytes[i] < max) {
                    var min = max - bytes[i]
                    var j = mi + 1
                    while (j < le) {
                        var min2 = bytes[j] - bytes[i]
                        if (min2 > 0 && min2 < min) {
                            min = min2
                            mi = j
                        }
                        j = j + 1
                    }
                    var t = bytes[i]
                    bytes[i] = bytes[mi]
                    bytes[mi] = t
                    var c = bytes[i+1..-1]
                    Sort.quick(c)
                    var next = bytes[0...i+1].map { |b| String.fromByte(b) }.join()
                    next = next + c.map { |b| String.fromByte(b) }.join()
                    Fmt.print("$,29s -> $,s", num, next)
                    outer = true
                    break
                } else if (bytes[i] > max) {
                    max = num[i].bytes[0]
                    mi = i
                }
                i = i - 1
            }
        }
        if (!outer) Fmt.print("$29s -> 0", num)
    }
}

var nums = ["0", "9", "12", "21", "12453", "738440", "45072010", "95322020", "9589776899767587796600"]
algorithm1.call(nums[0...-1]) // exclude the last one
algorithm2.call(nums)         // include the last one


fcn nextHightest(N){	// N is int, BigInt or string -->String.  Algorithm 2
//   ds:=N.split().copy();	// mutable, int
   ds:=N.toString().split("").apply("toInt").copy(); // handle "234" or BigInt
   if(ds.len()<2) return(0);
   m:=ds[-1];
   foreach i in ([ds.len()-1 .. 0,-1]){
      d:=ds[i];
      if(d<m){
         dz,j,z := ds[i,*], dz.sort().filter1n('>(d)), dz[j];
	 dz.del(j);
//	 return( ds[0,i].extend( z, dz.sort() ).concat().toInt() );
	 return( ds[0,i].extend( z, dz.sort() ).concat() );
      }
      m=m.max(d);
   }
   "0"
}


repeat
	set {hours:h, minutes:m} to (current date)
	if {0, 30} contains m then
		set bells to (h mod 4) * 2 + (m div 30)
                if bells is 0 then set bells to 4
                set pairs to bells div 2
		repeat pairs times
			say "ding dong" using "Bells"
		end repeat
		if (bells mod 2) is 1 then
			say "dong" using "Bells"
		end if
	end if
	delay 60
end repeat


NauticalBell(hh, mm){
	Hr := 0, min := 30, Bells := [], pattern := []
	Loop 8											; genrate 8 patterns
	{
		num := A_Index	, code := ""
		while (num/2 >=1)
			code .= "**  ", num := num-2
		code .= mod(A_Index, 2) ? "*" : ""
		pattern[A_Index] := code
	}
	loop, 48										; 24 hours * 2 for every half an hour
	{
		numBells := !mod(A_Index, 8) ? 8 : mod(A_Index, 8)	, min := 30
		if !Mod(A_Index, 2)
			hr++ , min := 00
		Bells[SubStr("0" hr, -1) ":" min] := numBells
	}
	Bells[00 ":" 00] := Bells[24 ":" 00]	, numBells := Bells[hh ":" mm]
	return {"bells": numBells, "pattern": Pattern[numBells]}
}


# syntax: GAWK -f NAUTICAL_BELL.AWK
BEGIN {
#   sleep_cmd = "sleep 55s" # Unix
    sleep_cmd = "TIMEOUT /T 55 >NUL" # MS-Windows
    split("Middle,Morning,Forenoon,Afternoon,Dog,First",watch_arr,",")
    split("One,Two,Three,Four,Five,Six,Seven,Eight",bells_arr,",")
    simulate1day()
    while (1) {
      t = systime()
      h = strftime("%H",t) + 0
      m = strftime("%M",t) + 0
      if (m == 0 || m == 30) {
        nb(h,m)
        while (systime() < t + 5) {}
      }
      system(sleep_cmd)
    }
    exit(0)
}
function nb(h,m,  bells,hhmm,plural,sounds,watch) {
#   hhmm = sprintf("%02d:%02d",h,m)
#   if (hhmm == "00:00") { watch = 6 }
#   else if (hhmm <= "04:00") { watch = 1 }
#   else if (hhmm <= "08:00") { watch = 2 }
#   else if (hhmm <= "12:00") { watch = 3 }
#   else if (hhmm <= "16:00") { watch = 4 }
#   else if (hhmm <= "20:00") { watch = 5 }
#   else { watch = 6}
# determining watch: verbose & readable (above) vs. terse & cryptic (below)
    watch = 60 * h + m
    watch = (watch < 1 ) ? 6 : int((watch - 1) / 240 + 1)
    bells = (h % 4) * 2 + int(m / 30)
    if (bells == 0) { bells = 8 }
    plural = (bells == 1) ? " " : "s"
    sounds = strdup("\x07",bells)
    printf("%02d:%02d %9s watch %5s bell%s  %s\n",h,m,watch_arr[watch],bells_arr[bells],plural,sounds)
}
function simulate1day(   h,m) {
    for (h=0; h<=23; h++) {
      for (m=0; m<=59; m+=30) {
        nb(h,m)
      }
    }
}
function strdup(str,n,  i,new_str) {
    for (i=1; i<=n; i++) {
      new_str = new_str str
    }
    gsub(str str,"& ",new_str)
    return(new_str)
}


#include<unistd.h>
#include<stdio.h>
#include<time.h>

#define SHORTLAG 1000
#define LONGLAG  2000

int main(){
	int i,times,hour,min,sec,min1,min2;

	time_t t;
	struct tm* currentTime;

	while(1){
		time(&t);
		currentTime = localtime(&t);

		hour = currentTime->tm_hour;
		min = currentTime->tm_min;
		sec = currentTime->tm_sec;

		hour = 12;
		min = 0;
		sec = 0;

		if((min==0 || min==30) && sec==0)
			times = ((hour*60 + min)%240)%8;
		if(times==0){
			times = 8;
		}

		if(min==0){
			min1 = 0;
			min2 = 0;
		}

		else{
			min1 = 3;
			min2 = 0;
		}

		if((min==0 || min==30) && sec==0){
			printf("\nIt is now %d:%d%d %s. Sounding the bell %d times.",hour,min1,min2,(hour>11)?"PM":"AM",times);

			for(i=1;i<=times;i++){
				printf("\a");

				(i%2==0)?sleep(LONGLAG):sleep(SHORTLAG);
			}
		}
	}
	return 0;
}


import std.stdio, core.thread, std.datetime;

class NauticalBell : Thread {
    private shared bool stopped;

    this() {
        super(&run);
    }

    void run() {
        uint numBells;
        auto time = cast(TimeOfDay)Clock.currTime();
        auto next = TimeOfDay();

        void setNextBellTime() {
            next += minutes(30);
            numBells = 1 + (numBells % 8);
        }

        while (next < time)
            setNextBellTime();

        while (!this.stopped) {
            time = cast(TimeOfDay)Clock.currTime();
            if (next.minute == time.minute &&
                    next.hour == time.hour) {
                immutable bells = numBells == 1 ? "bell" : "bells";
                writefln("%s : %d %s", time, numBells, bells);
                setNextBellTime();
            }
            sleep(dur!"msecs"(100));
            yield();
         }
     }

     void stop() {
        this.stopped = true;
     }
}

void main() {
    auto bells = new NauticalBell();
    bells.isDaemon(true);
    bells.start();
    try {
        bells.join();
    } catch (ThreadException e) {
        writeln(e.msg);
    }
}