def executed( prisonerCount:Int, step:Int ) = {

  val prisoners = ((0 until prisonerCount) map (_.toString)).toList

  def behead( dead:Seq[String], alive:Seq[String] )(countOff:Int) : (Seq[String], Seq[String]) = {
    val group = if( alive.size < countOff ) countOff - alive.size else countOff

    (dead ++ alive.take(group).drop(group-1), alive.drop(group) ++ alive.take(group-1))
  }

  def beheadN( dead:Seq[String], alive:Seq[String] ) : (Seq[String], Seq[String]) =
    behead(dead,alive)(step)

  def execute( t:(Seq[String], Seq[String]) ) : (Seq[String], Seq[String]) = t._2 match {
    case x :: Nil => (t._1, Seq(x))
    case x :: xs => execute(beheadN(t._1,t._2))
  }

  execute((List(),prisoners))
}

val (dead,alive) = executed(41,3)

println( "Prisoners executed in order:" )
print( dead.mkString(" ") )

println( "\n\nJosephus is prisoner " + alive(0) )


with javascript_semantics
function jacobi(integer a, n)
    atom result = 1
    a = remainder(a,n)
    while a!=0 do
        while remainder(a,2)==0 do
            a /= 2
            if find(remainder(n,8),{3,5}) then result *= -1 end if
        end while
        {a, n} = {n, a}
        if remainder(a,4)==3 and remainder(n,4)==3 then result *= -1 end if
        a = remainder(a,n)
    end while
    return iff(n==1 ? result : 0)
end function

printf(1,"n\\a   0   1   2   3   4   5   6   7   8   9  10  11\n")
printf(1,"   ________________________________________________\n")
for n=1 to 31 by 2 do
    printf(1,"%3d", n)
    for a=0 to 11 do
        printf(1,"%4d",jacobi(a, n))
    end for
    printf(1,"\n")
end for


def jacobi(a, n):
    if n <= 0:
        raise ValueError("'n' must be a positive integer.")
    if n % 2 == 0:
        raise ValueError("'n' must be odd.")
    a %= n
    result = 1
    while a != 0:
        while a % 2 == 0:
            a /= 2
            n_mod_8 = n % 8
            if n_mod_8 in (3, 5):
                result = -result
        a, n = n, a
        if a % 4 == 3 and n % 4 == 3:
            result = -result
        a %= n
    if n == 1:
        return result
    else:
        return 0


# Jacobi function
sub infix:<J> (Int $k is copy, Int $n is copy where * % 2) {
    $k %= $n;
    my $jacobi = 1;
    while $k {
        while $k %% 2 {
            $k div= 2;
            $jacobi *= -1 if $n % 8 == 3 | 5;
        }
        ($k, $n) = $n, $k;
        $jacobi *= -1 if 3 == $n%4 & $k%4;
        $k %= $n;
    }
    $n == 1 ?? $jacobi !! 0
}

# Testing

my $maxa = 30;
my $maxn = 29;

say 'n\k ', (1..$maxa).fmt: '%3d';
say '   ', '-' x 4 * $maxa;
for 1,*+2 … $maxn -> $n {
    print $n.fmt: '%3d';
    for 1..$maxa -> $k {
        print ($k J $n).fmt: '%4d';
    }
    print "\n";
}


$ include "seed7_05.s7i";

const func array integer: executeAllButM (in integer: n, in integer: k, in integer: m) is func
  result
    var array integer: prisoners is [0 .. -1] times 0;
  local
    var integer: killIdx is 0;
    var integer: prisonerNum is 0;
  begin
    for prisonerNum range 0 to pred(n) do
      prisoners &:= prisonerNum;
    end for;
    writeln("Prisoners executed in order:");
    while length(prisoners) > m do
      killIdx := (killIdx + k - 1) rem length(prisoners);
      write(prisoners[killIdx] <& " ");
      ignore(remove(prisoners, killIdx));
    end while;
    writeln;
  end func;

const func string: str (in array integer: intArr) is func
  result
    var string: stri is "";
  local
    var integer: index is 0;
  begin
    for key index range intArr do
      if index <> minIdx(intArr) then
        stri &:= ", ";
      end if;
      stri &:= str(intArr[index]);
    end for;
  end func;

enable_output(array integer);

const proc: main is func
  begin
    writeln("Survivor: " <& executeAllButM(41, 3, 1));
    writeln("Survivors: " <& executeAllButM(41, 3, 3));
  end func;


main := josephus(41, 3);

josephus(n, k) := josephusHelper(n, k, 1, 0);

josephusHelper(n, k, i, r) :=
        r when i > n
    else
        josephusHelper(n, k, i + 1, (r + k) mod i);


func josephus(n, k) {
    var prisoners = @^n
    while (prisoners.len > 1) {
        prisoners.rotate!(k - 1).shift
    }
    return prisoners[0]
}


/*REXX pgm computes/displays the Jacobi symbol, the # of rows & columns can be specified*/
parse arg rows cols .                            /*obtain optional arguments from the CL*/
if rows='' | rows==","  then rows= 17            /*Not specified?  Then use the default.*/
if cols='' | cols==","  then cols= 16            /* "      "         "   "   "      "   */
call hdrs                                        /*display the (two) headers to the term*/
      do r=1  by 2  to rows;     _= right(r, 3)  /*build odd (numbered) rows of a table.*/
                         do c=0  to cols         /* [↓]  build a column for a table row.*/
                         _= _ ! right(jacobi(c, r), 2);   != '│'  /*reset grid end char.*/
                         end   /*c*/
      say _ '║';  != '║'                         /*display a table row; reset grid glyph*/
      end   /*r*/
say translate(@.2, '╩╧╝', "╬╤╗")                 /*display the bottom of the grid border*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
hdrs: @.1= 'n/a ║';      do c=0  to cols;    @.1= @.1 || right(c, 3)"  ";   end
      L= length(@.1);                        @.1= left(@.1,   L - 1)    ;          say @.1
      @.2= '════╬';      do c=0  to cols;    @.2= @.2 || "════╤"        ;   end
      L= length(@.2);                        @.2= left(@.2,   L - 1)"╗" ;          say @.2
      != '║'        ;    return                  /*define an external grid border glyph.*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
jacobi: procedure; parse arg a,n;  er= '***error***';        $ = 1      /*define result.*/
        if n//2==0  then do;   say er    n   " must be a positive odd integer.";   exit 13
                         end
        a= a // n                                      /*obtain  A  modulus  N          */
          do while a\==0                               /*perform while  A  isn't zero.  */
                         do while a//2==0;  a= a % 2   /*divide  A  (as a integer) by 2 */
                         if n//8==3 | n//8==5  then $= -$               /*use  N mod  8 */
                         end   /*while a//2==0*/
          parse value  a  n     with     n  a          /*swap values of variables:  A N */
          if a//4==3 & n//4==3  then $= -$             /* A mod 4, N mod 4.   Both ≡ 3 ?*/
          a= a // n                                    /*obtain  A  modulus  N          */
          end   /*while a\==0*/
        if n==1  then return $
                      return 0


def jacobi(a, n)
  raise ArgumentError.new "n must b positive and odd" if n < 1 || n.even?
  res = 1
  until (a %= n) == 0
    while a.even?
      a >>= 1
      res = -res if [3, 5].include? n % 8
    end
    a, n = n, a
    res = -res if [a % 4, n % 4] == [3, 3]
  end
  n == 1 ? res : 0
end

puts "Jacobian symbols for jacobi(a, n)"
puts "n\\a  0  1  2  3  4  5  6  7  8  9 10"
puts "------------------------------------"
1.step(to: 17, by: 2) do |n|
   printf("%2d ", n)
   (0..10).each { |a| printf(" % 2d", jacobi(a, n)) }
   puts
end


class Josephus {

    class func lineUp(#numberOfPeople:Int) -> [Int] {
        var people = [Int]()
        for (var i = 0; i < numberOfPeople; i++) {
            people.append(i)
        }
        return people
    }

    class func execute(#numberOfPeople:Int, spacing:Int) -> Int {
        var killIndex = 0
        var people = self.lineUp(numberOfPeople: numberOfPeople)

        println("Prisoners executed in order:")
        while (people.count > 1) {
            killIndex = (killIndex + spacing - 1) % people.count
            executeAndRemove(&people, killIndex: killIndex)
        }
        println()
        return people[0]
    }

    class func executeAndRemove(inout people:[Int], killIndex:Int) {
        print("\(people[killIndex]) ")
        people.removeAtIndex(killIndex)
    }

    class func execucteAllButM(#numberOfPeople:Int, spacing:Int, save:Int) -> [Int] {
        var killIndex = 0
        var people = self.lineUp(numberOfPeople: numberOfPeople)

        println("Prisoners executed in order:")
        while (people.count > save) {
            killIndex = (killIndex + spacing - 1) % people.count
            executeAndRemove(&people, killIndex: killIndex)
        }
        println()
        return people
    }
}

println("Josephus is number: \(Josephus.execute(numberOfPeople: 41, spacing: 3))")
println()
println("Survivors: \(Josephus.execucteAllButM(numberOfPeople: 41, spacing: 3, save: 3))")


function josephus(n: number, k: number): number {
  if (!n) {
    return 1;
  }

  return ((josephus(n - 1, k) + k - 1) % n) + 1;
}


proc josephus {number step {survivors 1}} {
    for {set i 0} {$i<$number} {incr i} {lappend l $i}
    for {set i 1} {[llength $l]} {incr i} {
	# If the element is to be killed, append to the kill sequence
	if {$i%$step == 0} {
	    lappend killseq [lindex $l 0]
	    set l [lrange $l 1 end]
	} else {
	    # Roll the list
	    set l [concat [lrange $l 1 end] [list [lindex $l 0]]]
	}
    }
    return [lrange $killseq end-[expr {$survivors-1}] end]
}


fn jacobi(mut n: i32, mut k: i32) -> i32 {
    assert!(k > 0 && k % 2 == 1);
    n %= k;
    let mut t = 1;
    while n != 0 {
        while n % 2 == 0 {
            n /= 2;
            let r = k % 8;
            if r == 3 || r == 5 {
                t = -t;
            }
        }
        std::mem::swap(&mut n, &mut k);
        if n % 4 == 3 && k % 4 == 3 {
            t = -t;
        }
        n %= k;
    }
    if k == 1 {
        t
    } else {
        0
    }
}

fn print_table(kmax: i32, nmax: i32) {
    print!("n\\k|");
    for k in 0..=kmax {
        print!(" {:2}", k);
    }
    print!("\n----");
    for _ in 0..=kmax {
        print!("---");
    }
    println!();
    for n in (1..=nmax).step_by(2) {
        print!("{:2} |", n);
        for k in 0..=kmax {
            print!(" {:2}", jacobi(k, n));
        }
        println!();
    }
}

fn main() {
    print_table(20, 21);
}


def jacobi(a_p: Int, n_p: Int): Int =
{
    var a = a_p
    var n = n_p
    if (n <= 0) return -1
    if (n % 2 == 0) return -1

    a %= n
    var result = 1
    while (a != 0) {
      while (a % 2 == 0) {
        a /= 2
        if (n % 8 == 3 || n % 8 == 5) result = -result
      }
      val t = a
      a = n
      n = t
      if (a % 4 == 3 && n % 4 == 3) result = -result
      a %= n
    }
    if (n != 1) result = 0

    result
}

def main(args: Array[String]): Unit =
{
    for {
      a <- 0 until 11
      n <- 1 until 31 by 2
    } yield println("n = " + n + ", a = " + a + ": " + jacobi(a, n))
}


(define jacobi (lambda (a n)
		 (let ((a-mod-n (modulo a n)))
		   (if (zero? a-mod-n)
		       (if (= n 1)
			   1
			   0)
		       (if (even? a-mod-n)
			   (case (modulo n 8)
			     ((3 5) (- (jacobi (/ a-mod-n 2) n)))
			     ((1 7) (jacobi (/ a-mod-n 2) n)))
			   (if (and (= (modulo a-mod-n 4) 3) (= (modulo n 4) 3))
			       (- (jacobi n a-mod-n))
			       (jacobi n a-mod-n)))))))


Function josephus(n,k,s)
	Set prisoner = CreateObject("System.Collections.ArrayList")
	For i = 0 To n - 1
		prisoner.Add(i)
	Next
	index = -1
	Do Until prisoner.Count = s
		step_count = 0
		Do Until step_count = k
			If index+1 <= prisoner.Count-1 Then
				index = index+1
			Else
				index = (index+1)-(prisoner.Count)
			End If
			step_count = step_count+1
		Loop
		prisoner.RemoveAt(index)
		index = index-1
	Loop
	For j = 0 To prisoner.Count-1
		If j < prisoner.Count-1 Then
			josephus = josephus & prisoner(j) & ","
		Else
			josephus = josephus & prisoner(j)
		End If
	Next
End Function

'testing the function
WScript.StdOut.WriteLine josephus(5,2,1)
WScript.StdOut.WriteLine josephus(41,3,1)
WScript.StdOut.WriteLine josephus(41,3,3)


#1 = 41		// number of prisoners
#2 = 3		// step size
#3 = 1		// number of survivors

Buf_Switch(Buf_Free)
for (#5=0; #5<#1; #5++) {
    Ins_Text("prisoner ") Num_Ins(#5, LEFT)
}

BOF
#4=1
while (#1 > #3) {
    if (#4++ % #2 == 0) {
	Del_Line(1)
        #1--
    } else {
	Line(1)
    }
    if (At_EOF) { BOF }
}


Module Module1

    'Determines the killing order numbering prisoners 1 to n
    Sub Josephus(n As Integer, k As Integer, m As Integer)
        Dim p = Enumerable.Range(1, n).ToList()
        Dim i = 0

        Console.Write("Prisoner killing order:")
        While p.Count > 1
            i = (i + k - 1) Mod p.Count
            Console.Write(" {0}", p(i))
            p.RemoveAt(i)
        End While
        Console.WriteLine()

        Console.WriteLine("Survivor: {0}", p(0))
    End Sub

    Sub Main()
        Josephus(5, 2, 1)
        Console.WriteLine()
        Josephus(41, 3, 1)
    End Sub

End Module


func jacobi(n, k) {

    assert(k > 0,    "#{k} must be positive")
    assert(k.is_odd, "#{k} must be odd")

    var t = 1
    while (n %= k) {
        var v = n.valuation(2)
        t *= (-1)**v if (k%8 ~~ [3,5])
        n >>= v
        (n,k) = (k,n)
        t = -t if ([n%4, k%4] == [3,3])
    }

    k==1 ? t : 0
}

for n in (0..50), k in (0..50) {
    assert_eq(jacobi(n, 2*k + 1), kronecker(n, 2*k + 1))
}


import Foundation

func jacobi(a: Int, n: Int) -> Int {
  var a = a % n
  var n = n
  var res = 1

  while a != 0 {
    while a & 1 == 0 {
      a >>= 1

      if n % 8 == 3 || n % 8 == 5 {
        res = -res
      }
    }

    (a, n) = (n, a)

    if a % 4 == 3 && n % 4 == 3 {
      res = -res
    }

    a %= n
  }

  return n == 1 ? res : 0
}

print("n/a  0  1  2  3  4  5  6  7  8  9")
print("---------------------------------")

for n in stride(from: 1, through: 17, by: 2) {
  print(String(format: "%2d", n), terminator: "")

  for a in 0..<10 {
    print(String(format: " % d", jacobi(a: a, n: n)), terminator: "")
  }

  print()
}


fn jacobi(aa u64, na u64) ?int {
    mut a := aa
    mut n := na
    if n%2 == 0 {
        return error("'n' must be a positive odd integer")
    }
    a %= n
    mut result := 1
    for a != 0 {
        for a%2 == 0 {
            a /= 2
            nn := n % 8
            if nn == 3 || nn == 5 {
                result = -result
            }
        }
        a, n = n, a
        if a%4 == 3 && n%4 == 3 {
            result = -result
        }
        a %= n
    }
    if n == 1 {
        return result
    }
    return 0
}

fn main() {
    println("Using hand-coded version:")
    println("n/a  0  1  2  3  4  5  6  7  8  9")
    println("---------------------------------")
    for n := u64(1); n <= 17; n += 2 {
        print("${n:2} ")
        for a := u64(0); a <= 9; a++ {
            t := jacobi(a, n)?
            print(" ${t:2}")
        }
        println('')
    }
}


import "/fmt" for Fmt

var jacobi = Fn.new { |a, n|
    if (!n.isInteger || n <= 0 || n%2 == 0) {
        Fiber.abort("The 'n' parameter must be an odd positive integer.")
    }
    a = a % n
    var result = 1
    while (a != 0) {
        while (a%2  == 0) {
            a = a / 2
            var nm8 = n % 8
            if ([3, 5].contains(nm8)) result = -result
        }
        var t = a
        a = n
        n = t
        if (a%4 == 3 && n%4 == 3) result = -result
        a = a % n
    }
    return (n == 1) ? result : 0
}

System.print("Table of jacobi(a, n):")
System.print("n/a   1   2   3   4   5   6   7   8   9  10  11  12  13  14  15")
System.print("---------------------------------------------------------------")
var n = 1
while (n < 31) {
    System.write(Fmt.d(3, n))
    for (a in 1..15) System.write(Fmt.d(4, jacobi.call(a, n)))
    System.print()
    n = n + 2
}


// basic task fntion
fn final_survivor(n int, kk int) int {
    // argument validation omitted
    mut circle := []int{len: n, init: it}
    k := kk-1
    mut ex_pos := 0
    for circle.len > 1 {
        ex_pos = (ex_pos + k) % circle.len
		circle.delete(ex_pos)
    }
    return circle[0]
}

// extra
fn position(n int, kk int, p int) int {
    // argument validation omitted
    mut circle := []int{len: n, init: it}
    k := kk-1
	mut pos := p
    mut ex_pos := 0
    for circle.len > 1 {
        ex_pos = (ex_pos + k) % circle.len
        if pos == 0 {
            return circle[ex_pos]
        }
        pos--
		circle.delete(ex_pos)
    }
    return circle[0]
}

fn main() {
    // show basic task fntion on given test case
    println(final_survivor(41, 3))
    // show extra fntion on all positions of given test case
    println("Position  Prisoner")
    for i in 0..41 {
        println("${i:5}${position(41, 3, i):10}")
	}
}


var josephus = Fn.new { |n, k, m|
    if (k <= 0 || m <= 0 || n <= k || n <= m) Fiber.abort("One or more parameters are invalid.")
    var killed = []
    var survived = List.filled(n, 0)
    for (i in 0...n) survived[i] = i
    var start = k - 1
    while (true) {
        var end = survived.count - 1
        var i = start
        var deleted = 0
        while (i <= end) {
            killed.add(survived.removeAt(i-deleted))
            if (survived.count == m) return [survived, killed]
            deleted = deleted + 1
            i = i + k
        }
        start = i - end - 1
    }
    return [survived, killed]
}

var triples = [ [5, 2, 1], [41, 3, 1], [41, 3, 3] ]
for (triple in triples) {
    var n = triple[0]
    var k = triple[1]
    var m = triple[2]
    System.print("Prisoners = %(n), Step = %(m), Survivors = %(m)")
    var sk = josephus.call(n, k, m)
    System.print("Survived   : %(sk[0])")
    System.print("Kill order : %(sk[1])")
    System.print()
}


fcn jacobi(a,n){
   if(n.isEven or n<1)
      throw(Exception.ValueError("'n' must be a positive odd integer"));
   a=a%n;   result,t := 1,0;
   while(a!=0){
      while(a.isEven){
	 a/=2;   n_mod_8:=n%8;
	 if(n_mod_8==3 or n_mod_8==5) result=-result;
      }
      t,a,n = a,n,t;
      if(a%4==3 and n%4==3) result=-result;
      a=a%n;
   }
   if(n==1) result else 0
}


include c:\cxpl\codes;

func Prisoner(N, K);            \Return final surviving prisoner
int  N, K;                      \number of prisoners, number to skip
int  I, J;
char A;
[A:= Reserve(N);
for I:= 0 to N-1 do A(I):= I;
I:= 0;
repeat  I:= I+K-1;                              \skip to next prisoner
        I:= rem(I/N);                           \wrap to start if necessary
        IntOut(0, A(I)); ChOut(0, ^ );          \show killed prisoner
        for J:= I to N-2 do A(J):= A(J+1);      \shift survivors down
        N:= N-1;                                \one less prisoner
until   N=1;
return A(0);
];

[IntOut(0, Prisoner(5, 2));  CrLf(0);
 IntOut(0, Prisoner(41, 3));  CrLf(0);
]


fcn j(n,k){
   reg p=[0..n-1].walk().copy(), i=0, seq=L();
   while(p){
      i=(i+k-1)%p.len();
      seq.append(p.pop(i));
   }
   "Prisoner killing order: %s.\nSurvivor: %d"
   .fmt(seq[0,-1].concat(","),seq[-1]);
}


10 LET n=41: LET k=3: LET m=0
20 GO SUB 100
30 PRINT "n= ";n;TAB (7);"k= ";k;TAB (13);"final survivor= ";lm
40 STOP
100 REM Josephus
110 REM Return m-th on the reversed kill list; m=0 is final survivor.
120 LET lm=m: REM Local copy of m
130 FOR a=m+1 TO n
140 LET lm=FN m(lm+k,a)
150 NEXT a
160 RETURN
200 DEF FN m(x,y)=x-INT (x/y)*y: REM MOD function


loop_MySubroutine:
; more than 127 bytes of code

dex
bne loop_MySubroutine ;assembler will display an error message that the branch is too far away.
; rest of program


Foo := 1;
loop
   exit when Foo = 10;
   Foo := Foo + 1;
end loop;


# Inverted assignment                                                                       #
# Assignment in Algol 68 is via ":=" which is automaically provided for all modes (types)   #
# However we could define e.g. "=:" as an inverted assignment operator but we would need to #
# define a separate operator for each mode, e.g. for integers and strings:                  #
PRIO =: = 1;
OP   =: = ( INT a,    REF INT    b )REF INT:    b := a;
OP   =: = ( STRING a, REF STRING b )REF STRING: b := a;
OP   =: = ( CHAR   a, REF STRING b )REF STRING: b := a;
INT a, b; STRING s;
    1 =: a;
a + 1 =: b;
  "?" =: s;
print( ( a, b, s, newline ) );

# There is one standard inverted assignment operator: +=: or PLUSTO which prepends a string #
# to another:                                                                               #
"bc"  =: s;
"b"  +=: s;
print( ( s, newline ) );

# Inverted Conditional Expressions                                                          #
# We could define an operator called WHEN perhaps, that would execute its left operand if   #
# the right operand was TRUE. However the left operand would need to be a PROC VOID so the  #
# syntax would not be as convientent as the standard IF-THEN-FI construct. E.g.:            #
PRIO WHEN = 1;
OP   WHEN = ( PROC VOID code, BOOL test )VOID: IF test THEN code FI;

( VOID: print( ( "NO",  newline ) ) ) WHEN a = b;  # the anonymous PROC VOID is not called  #
( VOID: print( ( "yes", newline ) ) ) WHEN a /= b  # the anonymous PROC VOID is called      #


MOV R0,R3    ;copy R3 to R0
ADD R2,R1,R5 ;add R1 to R5 and store the result in R2.


ifStatement: function [block, condition][
    if condition -> do block
]
alias.infix {??} 'ifStatement

do [
    variable: true
    [print "Variable is true!"] ?? variable
]


double=.!arg+!arg;

(=.!arg+!arg):(=?double); { inverted assignment syntax, same result as above. }


#include <stdio.h>
#include <stdlib.h>
#define otherwise       do { register int _o = 2; do { switch (_o) {  case 1:
#define given(Mc)       ;case 0: break; case 2: _o = !!(Mc); continue; } break; } while (1); } while (0)

int foo() { return 1; }

main()
{
        int a = 0;

        otherwise  a = 4 given (foo());
        printf("%d\n", a);
        exit(0);
}


class invertedAssign {
  int data;
public:
  invertedAssign(int data):data(data){}
  int getData(){return data;}
  void operator=(invertedAssign& other) const {
    other.data = this->data;
  }
};

#include <iostream>

int main(){
  invertedAssign a = 0;
  invertedAssign b = 42;
  std::cout << a.getData() << ' ' << b.getData() << '\n';

  b = a;

  std::cout << a.getData() << ' ' << b.getData() << '\n';
}


; normal
(if (= 1 1)
  (print "Math works."))

; inverted
(->> (print "Math still works.")
     (if (= 1 1)))

; a la Haskell
(->> (print a " is " b)
     (let [a 'homoiconicity
           b 'awesome]))


alert "hello" if true
alert "hello again" unless false # the same as the above; unless is a negated if.

idx = 0
arr = (++idx while idx < 10) # arr is [1,2,3,4,5,6,7,8,9,10]

idx = 0
arr = (++idx until idx is 10) # same as above; until is an inverted while.


(eval-when (:compile-toplevel :load-toplevel :execute)
  (defun unrev-syntax (form)
    (cond
      ((atom form) form)
      ((null (cddr form)) form)
      (t (destructuring-bind (oper &rest args) (reverse form)
           `(,oper ,@(mapcar #'unrev-syntax args)))))))

(defmacro rprogn (&body forms)
  `(progn ,@(mapcar #'unrev-syntax forms)))


#!/usr/bin/rdmd

import std.algorithm;

void main() {
    assert("Hello, World".length == 12);
    assert("Cleanliness".startsWith("Clean"));

    auto r = [1, 4, 2, 8, 5, 7]
        .filter!(n => n > 2)
        .map!(n => n * 2);

    assert(r.equal([8, 16, 10, 14]));
}


;; use reader macros to transform (a OP b) into (OP b a)

(lib 'match)
(define-macro invert-= (a <- b) (set! b a))
(define-macro invert-IF (a 'IF b) (when b a))

(define raining #f)

(#t <- raining)
raining
    → #t
('umbrella-need IF raining)
    → umbrella-need

(#f <- raining)
('umbrella-need IF raining)
    → #f

;; debug mode
(debug 3)
('umbrella-need IF raining)
💡 [0]     invert-IF → ('umbrella-need IF raining)
compiled :: (#when raining 'umbrella-need)


INQUIRE(FILE = FILENAME(1:L), EXIST = MAYBE, ERR = 666, IOSTAT = RESULT)


' FB 1.05.0 Win64

#Define ThenIf(a, b) If b Then a
#Define InvertAssign(a, b) b = a

Dim As Boolean needUmbrella = False, raining = True
ThenIf(needUmbrella = True, raining = True)
Print "needUmbrella = "; needUmbrella

Dim As Integer b = 0, a = 3
InvertAssign(a, b)
Print "b is"; b
Sleep


package main

import "fmt"

type ibool bool

const itrue ibool = true

func (ib ibool) iif(cond bool) bool {
    if cond {
        return bool(ib)
    }
    return bool(!ib)
}

func main() {
    var needUmbrella bool
    raining := true

    // normal syntax
    if raining {
        needUmbrella = true
    }
    fmt.Printf("Is it raining? %t. Do I need an umbrella? %t\n", raining, needUmbrella)

    // inverted syntax
    raining = false
    needUmbrella = itrue.iif(raining)
    fmt.Printf("Is it raining? %t. Do I need an umbrella? %t\n", raining, needUmbrella)
}


when :: Monad m => m () -> Bool -> m ()
action `when` condition = if condition then action else return ()


procedure main()
raining := TRUE := 1                         # there is no true/false null/non-null will do
if \raining then needumbrella := TRUE        # normal
needumbrella := 1(TRUE, \raining)            # inverted (choose sub-expression 1)
end


macro inv(expr, cond)
    cond isa Expr && cond.head == :if || throw(ArgumentError("$cond is not an if expression"))
    cond.args[2] = expr
    return cond
end

@inv println("Wow! Lucky Guess!") if true else println("Not!") end


// version 1.0.6

infix fun Boolean.iif(cond: Boolean) = if (cond) this else !this

fun main(args: Array<String>) {
    val raining = true
    val needUmbrella = true iif (raining)
    println("Do I need an umbrella?  ${if(needUmbrella) "Yes" else "No"}")
}


local 'raining = True.
local 'needUmbrella = False.

if (raining) then {
  needUmbrella = True.
} else {}.

{ raining. } ifTrue {
  needUmbrella = True.
}.


expr=lambda ->{
      Print "ok"
}
ifrev=lambda (dothis, cond) ->{
      if cond then call dothis()
}
a=1
call ifrev(expr, a=1)

\\ on module call
Module Subtract (a, b) {
      Push a-b
}
Module PrintTop {
      Print Number
}
Subtract 10, 3 : PrintTop
\\ pushing before calling in reverse order
Push 3, 10 : Subtract : PrintTop
\\ Before call PrintTop any parameter send to stack
\\ So this works ok
PrintTop 1000
\\ on assignment
Dim A(5)=1
Global n=2
Function AddOne (x) {
      n++
      =x
}
\\ Execution of left expression, then right expression
A(n)=AddOne(5)
Print A(n-1)=5, n=3
\\ Execution of right expression, then left expression
Let A(n)=AddOne(15)
Print A(n)=15, n=4
\\ This statement..
Let X=1, Y=2
\\ executed like these
Push 2, 1 : Read X, Y

\\ This is the CallBack way
Module ExecCond {
      Read &callback(), cond
      if cond then call callback()
}
x=1
\\ this aa() is a function but when we call it after transforming from Lazy$()
\\ act as part of module so we see x, and alter it
Function aa {
      x++
}
a=1
ExecCond Lazy$(&aa()), A=1
Print x=2


define(`thenif', `ifelse($2, $3, `$1')')dnl
dnl
ifelse(eval(23 > 5), 1, 23 is greater than 5)
ifelse(eval(23 > 5), 0, math is broken)
thenif(23 is greater than 5, eval(23 > 5), 1)
thenif(math is broken, eval(23 > 5), 0)


a = 4
->4

b = 5
->5

If[1<2,
Print["This was expected"]
]
->This was expected


:- pred progress(int::in, int::in, int::out, int::out) is det.
progress(Past, Future, At, Total) :-
	At = Past + 1,
	Total = Past + Future.

progress(Past, Future, At, Total) :-
        Past + Future = Total,
        Past + 1 = At.


#--
# if statements
#--

template `?`(expression, condition) =
  if condition:
    expression

let raining = true
var needUmbrella: bool

# Normal syntax
if raining: needUmbrella = true

# Inverted syntax
(needUmbrella = true) ? (raining == true)

#--
# Assignments
#--

template `~=`(right, left) =
  left = right

var a = 3

# Normal syntax
a = 6

# Inverted syntax
6 ~= a


  6 -> a : Push 6 on the stack and set the top of the stack as value of local variable a (top of the stack is consumed)
  6 := a : Push 6 on the stack and set the top of the satck as value of  attribute a (top of the stack is consumed).
  raining ifTrue: [ true ->needumbrella ]


macro cond(a,c)  {c then a}

macro store(b,a) {a=b}

sys a,c=10

if c>4 then a=4

'INVERTED SYNTAX FORMS:

cond a=40, if c>4

store 4,a

'COMBINED:

cond store(5,a), if c>4


fi(f, condition)=if(condition,f());

if(raining, print("Umbrella needed"))
fi(->print("Umbrella needed"), raining)


if ($guess == 6) { print "Wow! Lucky Guess!"; };    # Traditional syntax
print 'Wow! Lucky Guess!' if $guess == 6;           # Inverted syntax (note missing braces and parens)
unless ($guess == 6) { print "Sorry, your guess was wrong!"; }   # Traditional syntax
print 'Huh! You Guessed Wrong!' unless $guess == 6;              # Inverted syntax


if end
(&"test.exw"[1]cl)system
then >2(cl)length if
(&"\n"(pgm)mung,"test.exw")write_file = {}
write_file.e include
([$]cl)get_text = pgm string
()command_line = cl sequence
function end
("\n",lines)join return
for end (nup,rip,((([i]lines)split)reverse)join)substitute_all = [i]lines do (lines)length to 1=i for
(("\r\n",(rip,pun,pgm)substitute_all)split)reverse=lines sequence
(pgm string)mung function

(true,"*",("*","",3,7,"       -<>{}@!       ")join_by)split = rip constant
(true,"*",("*","",1,7,"-,=][)(")join_by)split = nup constant
(true,"*",("*","",1,7,"-,=[]()")join_by)split = pun constant
js without
demo\rosetta\inverted_syntax.exw --


(de rv Prg
   (append (last Prg) (head -1 Prg)) )


if ((Get-Date 5/27/2016).DayOfWeek -eq "Friday") {"Thank God it's Friday!"}


% Dracula is a vampire.
% Also, you become a vampire if someone who is a vampire bites you.
vampire(dracula).
vampire(You) :- bites(Someone, You), vampire(Someone).

% Oh no! Dracula just bit Bob...
bites(dracula, bob).


x = truevalue if condition else falsevalue


(define set-needumbrella
  Raining -> (set needumbrella true) where (= true Raining)
  Raining -> (set needumbrella false) where (= false Raining))

(define set-needumbrella
  Raining -> (if (= true Raining)
                 (set needumbrella true)
                 (set needumbrella false)))

Alternatives:

(define set-needumbrella
  Raining -> (set needumbrella true) where Raining
  Raining -> (set needumbrella false))

(define set-needumbrella
  Raining -> (if Raining
                 (set needumbrella true)
                 (set needumbrella false)))

(define set-needumbrella
  true  -> (set needumbrella true)
  false -> (set needumbrella false))

(define set-needumbrella
  A -> (set needumbrella A))


do.if <- function(expr, cond) if(cond) expr


#lang racket
(when #t (displayln "true"))
((displayln "true") . when . #t)

(define a 6)
(set! a 5)
(a . set! . 6)


if $guess == 6 { say "Wow! Lucky Guess!" }          # Traditional
say 'Wow! Lucky Guess!' if $guess == 6;             # Inverted
unless $guess == 6 { say "Huh! You Guessed Rong!" } # Traditional
say 'Huh! You Guessed Rong!' unless $guess == 6;    # Inverted


SIGNAL   {ON|OFF}   someCondition   {name}


# Raise ArgumentError if n is negative.
if n < 0 then raise ArgumentError, "negative n" end
raise ArgumentError, "negative n" if n < 0

# Exit 1 unless we can call Process.fork.
unless Process.respond_to? :fork then exit 1 end
exit 1 unless Process.respond_to? :fork

# Empty an array, printing each element.
while ary.length > 0 do puts ary.shift end
puts ary.shift while ary.length > 0

# Another way to empty an array, printing each element.
until ary.empty? do puts ary.shift end
puts ary.shift until ary.empty?


object Main extends App {

  val raining = true
  val needUmbrella = raining
  println(s"Do I need an umbrella?  ${if (needUmbrella) "Yes" else "No"}")
}


# Inverted syntax with assignment
var raining = true;
[false]»(\var needumbrella);

# Inverted syntax with conditional expressions
if (raining==true) {needumbrella=true};
{needumbrella=true} -> if (raining==true);
(needumbrella=true) if (raining==true);


infix operator ~= {}
infix operator ! {}

func ~=(lhs:Int, inout rhs:Int) {
    rhs = lhs
}

func !(lhs:(() -> Void), rhs:Bool) {
    if (rhs) {
        lhs()
    }
}

// Traditional assignment
var a = 0

// Inverted using a custom operator
20 ~= a

let raining = true
let tornado = true
var needUmbrella = false
var stayInside = false

// Traditional conditional expression
if raining {needUmbrella = true}

// Inverted using a custom operator
_ = {stayInside = true} ! tornado


# do.tcl --
#
#        Tcl implementation of a "do ... while|until" loop.
#
# Originally written for the "Texas Tcl Shootout" programming contest
# at the 2000 Tcl Conference in Austin/Texas.
#
# Copyright (c) 2001 by Reinhard Max <[email protected]>
#
# See the file "license.terms" for information on usage and redistribution
# of this file, and for a DISCLAIMER OF ALL WARRANTIES.
#
# RCS: @(#) $Id: do.tcl,v 1.6 2004/01/15 06:36:12 andreas_kupries Exp $
#
namespace eval ::control {

    proc do {body args} {

	#
	# Implements a "do body while|until test" loop
	#
	# It is almost as fast as builtin "while" command for loops with
	# more than just a few iterations.
	#

	set len [llength $args]
	if {$len !=2 && $len != 0} {
	    set proc [namespace current]::[lindex [info level 0] 0]
	    return -code error "wrong # args: should be \"$proc body\" or \"$proc body \[until|while\] test\""
	}
	set test 0
	foreach {whileOrUntil test} $args {
	    switch -exact -- $whileOrUntil {
		"while" {}
		"until" { set test !($test) }
		default {
		    return -code error \
			"bad option \"$whileOrUntil\": must be until, or while"
		}
	    }
	    break
	}

	# the first invocation of the body
	set code [catch { uplevel 1 $body } result]

	# decide what to do upon the return code:
	#
	#               0 - the body executed successfully
	#               1 - the body raised an error
	#               2 - the body invoked [return]
	#               3 - the body invoked [break]
	#               4 - the body invoked [continue]
	# everything else - return and pass on the results
	#
	switch -exact -- $code {
	    0 {}
	    1 {
		return -errorinfo [ErrorInfoAsCaller uplevel do]  \
		    -errorcode $::errorCode -code error $result
	    }
	    3 {
		# FRINK: nocheck
		return
	    }
	    4 {}
	    default {
		return -code $code $result
	    }
	}
	# the rest of the loop
	set code [catch {uplevel 1 [list while $test $body]} result]
	if {$code == 1} {
	    return -errorinfo [ErrorInfoAsCaller while do] \
		-errorcode $::errorCode -code error $result
	}
	return -code $code $result

    }
}

#usage:
package require control
control::do {set i 0; puts "hello world"; incr i} until {$i > 0}


; a = expr
:a expr
; expr = a
~:expr a
; if cond expr
@if cond expr
; if expr cond
[email protected] expr cond


class IBool {
    construct new(b) {
        if (!(b is Bool)) Fiber.abort("B must be a boolean")
        _b = b
    }

    iff(cond) { cond ? _b : !_b }
}

var itrue = IBool.new(true)

var needUmbrella
var raining = true

// normal syntax
if (raining) needUmbrella = true
System.print("Is it raining? %(raining). Do I need an umbrella? %(needUmbrella)")

// inverted syntax
raining = false
needUmbrella = itrue.iff(raining)
System.print("Is it raining? %(raining). Do I need an umbrella? %(needUmbrella)")


if (raining==True) needumbrella:=True;
(raining==True) : if (_) needumbrella:=True;


BEGIN # find some Jacobsthal and related Numbers                             #
    INT max jacobsthal = 29;        # highest Jacobsthal number we will find #
    INT max oblong     = 20; # highest Jacobsthal oblong number we will find #
    INT max j prime    = 20;     # number of Jacobsthal prinmes we will find #
    PR precision 200 PR                 # set the precision of LONG LONG INT #
    PR read "primes.incl.a68" PR                   # include prime utilities #
    [ 0 : max jacobsthal ]LONG INT j;         # will hold Jacobsthal numbers #
    [ 0 : max jacobsthal ]LONG INT jl;  # will hold Jacobsthal-Lucas numbers #
    [ 1 : max oblong     ]LONG INT jo; # will hold Jacobsthal oblong numbers #
    # calculate the Jacobsthal Numbers and related numbers                   #
    # Jacobsthal      : J0  = 0, J1  = 1, Jn  = Jn-1  + 2 × Jn-2             #
    # Jacobsthal-Lucas: JL0 = 2, JL1 = 1, JLn = JLn-1 + 2 × JLn-2            #
    # Jacobsthal oblong: JOn = Jn x Jn-1                                     #
    j[ 0 ] := 0; j[ 1 ] := 1; jl[ 0 ] := 2; jl[ 1 ] := 1; jo[ 1 ] := 0;
    FOR n FROM 2 TO UPB j DO
        j[  n ] := j[  n - 1 ] + ( 2 * j[  n - 2 ] );
        jl[ n ] := jl[ n - 1 ] + ( 2 * jl[ n - 2 ] )
    OD;
    FOR n TO UPB jo DO
        jo[ n ] := j[ n ] * j[ n - 1 ]
    OD;
    # prints an array of numbers with the specified legend                   #
    PROC show numbers = ( STRING legend, []LONG INT numbers )VOID:
         BEGIN
            INT n count := 0;
            print( ( "First ", whole( ( UPB numbers - LWB numbers ) + 1, 0 ), " ", legend, newline ) );
            FOR n FROM LWB numbers TO UPB numbers DO
                print( ( " ", whole( numbers[ n ], -11 ) ) );
                IF ( n count +:= 1 ) MOD 5 = 0 THEN print( ( newline ) ) FI
            OD
         END # show numbers # ;
    # show the various numbers numbers                                       #
    show numbers( "Jacobsthal Numbers:",        j  );
    show numbers( "Jacobsthal-Lucas Numbers:",  jl );
    show numbers( "Jacobsthal oblong Numbers:", jo );
    # find some prime Jacobsthal numbers                                     #
    LONG LONG INT  jn1 := j[ 1 ], jn2 := j[ 0 ];
    INT  p count := 0;
    print( ( "First ", whole( max j prime, 0 ), " Jacobstal primes:", newline ) );
    print( ( "   n  Jn", newline ) );
    FOR n FROM 2 WHILE p count < max j prime DO
        LONG LONG INT jn = jn1 + ( 2 * jn2 );
        jn2        := jn1;
        jn1        := jn;
        IF is probably prime( jn ) THEN
            # have a probably prime Jacobsthal number                        #
            p count +:= 1;
            print( ( whole( n, -4 ), ": ", whole( jn, 0 ), newline ) )
        FI
    OD
END


on jacobsthalNumbers(variant, n)
    -- variant: text containing "Lucas", "oblong", or "prime" — or none of these.
    -- n: length of output sequence required.

    -- The two Jacobsthal numbers preceding the current 'j'. Initially the first two in the sequence.
    set {anteprev, prev} to {0, 1}
    -- Default plug-in script. Its handler simply appends the current 'j' to the output.
    script o
        property output : {anteprev, prev}
        on append(dummy, j)
            set end of output to j
        end append
    end script

    -- If a variant sequence is specified, change the first value or substitute
    -- a script whose handler decides the values to append to the output.
    ignoring case
        if (variant contains "Lucas") then
            set anteprev to 2
            set o's output's first item to anteprev
        else if (variant contains "oblong") then
            script
                property output : {0}
                on append(prev, j)
                    set end of output to prev * j
                end append
            end script
            set o to result
        else if (variant contains "prime") then
            script
                property output : {}
                on append(dummy, j)
                    if (isPrime(j)) then set end of output to j
                end append
            end script
            set o to result
        end if
    end ignoring

    -- Work through the Jacobsthal process until the required output length is obtained.
    repeat until ((count o's output) = n)
        set j to anteprev + anteprev + prev
        tell o to append(prev, j)
        set anteprev to prev
        set prev to j
    end repeat

    return o's output
end jacobsthalNumbers

on isPrime(n)
    if (n < 3) then return (n is 2)
    if (n mod 2 is 0) then return false
    repeat with i from 3 to (n ^ 0.5) div 1 by 2
        if (n mod i is 0) then return false
    end repeat
    return true
end isPrime

-- Task and presentation of results!:
on intToText(n)
    set txt to ""
    repeat until (n < 100000000)
        set txt to text 2 thru 9 of (100000000 + (n mod 100000000) div 1 as text) & txt
        set n to n div 100000000
    end repeat
    return (n as integer as text) & txt
end intToText

on chopList(theList, sublistLen)
    script o
        property lst : theList
        property output : {}
    end script

    set listLen to (count o's lst)
    repeat with i from 1 to listLen by sublistLen
        set j to i + sublistLen - 1
        if (j > listLen) then set j to listLen
        set end of o's output to items i thru j of o's lst
    end repeat
    return o's output
end chopList

on matrixToText(matrix, w)
    script o
        property matrix : missing value
        property row : missing value
    end script

    set o's matrix to matrix
    set padding to "                   "
    repeat with r from 1 to (count o's matrix)
        set o's row to o's matrix's item r
        repeat with i from 1 to (count o's row)
            set o's row's item i to text -w thru end of (padding & o's row's item i)
        end repeat
        set o's matrix's item r to join(o's row, "")
    end repeat

    return join(o's matrix, linefeed)
end matrixToText

on join(lst, delim)
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to delim
    set txt to lst as text
    set AppleScript's text item delimiters to astid
    return txt
end join

on task()
    set output to {"First 30 Jacobsthal Numbers:", "First 30 Jacobsthal-Lucas Numbers:", ¬
        "First 20 Jacobsthal oblong Numbers:", "First 11 Jacobsthal Primes:"}
    set results to {jacobsthalNumbers("", 30), jacobsthalNumbers("Lucas", 30), ¬
        jacobsthalNumbers("oblong", 20), jacobsthalNumbers("prime", 11)}
    repeat with i from 1 to 4
        set thisSequence to item i of results
        repeat with j in thisSequence
            set j's contents to intToText(j)
        end repeat
        if (i < 4) then
            set theLines to chopList(thisSequence, 10)
        else
            set theLines to chopList(thisSequence, 6)
        end if
        set item i of output to item i of output & linefeed & matrixToText(theLines, (count end of thisSequence) + 1)
    end repeat

    return join(output, linefeed & linefeed)
end task

task()


J:  function [n]-> ((2^n) - (neg 1)^n)/3
JL: function [n]-> (2^n) + (neg 1)^n
JO: function [n]-> (J n) * (J n+1)

printFirst: function [label, what, predicate, count][
    print ["First" count label++":"]
    result: new []
    i: 0
    while [count > size result][
        num: do ~"|what| i"
        if do predicate -> 'result ++ num
        i: i + 1
    ]

    (predicate=[true])? [
        loop split.every: 5 result 'row [
            print map to [:string] row 'item -> pad item 12
        ]
    ][
        loop result 'row -> print row
    ]
    print ""
]

printFirst "Jacobsthal numbers" 'J [true] 30
printFirst "Jacobsthal-Lucas numbers" 'JL [true] 30
printFirst "Jacobsthal oblong numbers" 'JO [true] 20
printFirst "Jacobsthal primes" 'J [prime? num] 20


#include <stdio.h>
#include <gmp.h>

void jacobsthal(mpz_t r, unsigned long n) {
    mpz_t s;
    mpz_init(s);
    mpz_set_ui(r, 1);
    mpz_mul_2exp(r, r, n);
    mpz_set_ui(s, 1);
    if (n % 2) mpz_neg(s, s);
    mpz_sub(r, r, s);
    mpz_div_ui(r, r, 3);
}

void jacobsthal_lucas(mpz_t r, unsigned long n) {
    mpz_t a;
    mpz_init(a);
    mpz_set_ui(r, 1);
    mpz_mul_2exp(r, r, n);
    mpz_set_ui(a, 1);
    if (n % 2) mpz_neg(a, a);
    mpz_add(r, r, a);
}

int main() {
    int i, count;
    mpz_t jac[30], j;
    printf("First 30 Jacobsthal numbers:\n");
    for (i = 0; i < 30; ++i) {
        mpz_init(jac[i]);
        jacobsthal(jac[i], i);
        gmp_printf("%9Zd ", jac[i]);
        if (!((i+1)%5)) printf("\n");
    }

    printf("\nFirst 30 Jacobsthal-Lucas numbers:\n");
    mpz_init(j);
    for (i = 0; i < 30; ++i) {
        jacobsthal_lucas(j, i);
        gmp_printf("%9Zd ", j);
        if (!((i+1)%5)) printf("\n");
    }

    printf("\nFirst 20 Jacobsthal oblong numbers:\n");
    for (i = 0; i < 20; ++i) {
        mpz_mul(j, jac[i], jac[i+1]);
        gmp_printf("%11Zd ", j);
        if (!((i+1)%5)) printf("\n");
    }

    printf("\nFirst 20 Jacobsthal primes:\n");
    for (i = 0, count = 0; count < 20; ++i) {
        jacobsthal(j, i);
        if (mpz_probab_prime_p(j, 15) > 0) {
            gmp_printf("%Zd\n", j);
            ++count;
        }
    }

    return 0;
}


#include <gmpxx.h>

#include <iomanip>
#include <iostream>

using big_int = mpz_class;

bool is_probably_prime(const big_int& n) {
    return mpz_probab_prime_p(n.get_mpz_t(), 30) != 0;
}

big_int jacobsthal_number(unsigned int n) {
    return ((big_int(1) << n) - (n % 2 == 0 ? 1 : -1)) / 3;
}

big_int jacobsthal_lucas_number(unsigned int n) {
    return (big_int(1) << n) + (n % 2 == 0 ? 1 : -1);
}

big_int jacobsthal_oblong_number(unsigned int n) {
    return jacobsthal_number(n) * jacobsthal_number(n + 1);
}

int main() {
    std::cout << "First 30 Jacobsthal Numbers:\n";
    for (unsigned int n = 0; n < 30; ++n) {
        std::cout << std::setw(9) << jacobsthal_number(n)
                  << ((n + 1) % 5 == 0 ? '\n' : ' ');
    }
    std::cout << "\nFirst 30 Jacobsthal-Lucas Numbers:\n";
    for (unsigned int n = 0; n < 30; ++n) {
        std::cout << std::setw(9) << jacobsthal_lucas_number(n)
                  << ((n + 1) % 5 == 0 ? '\n' : ' ');
    }
    std::cout << "\nFirst 20 Jacobsthal oblong Numbers:\n";
    for (unsigned int n = 0; n < 20; ++n) {
        std::cout << std::setw(11) << jacobsthal_oblong_number(n)
                  << ((n + 1) % 5 == 0 ? '\n' : ' ');
    }
    std::cout << "\nFirst 20 Jacobsthal primes:\n";
    for (unsigned int n = 0, count = 0; count < 20; ++n) {
        auto jn = jacobsthal_number(n);
        if (is_probably_prime(jn)) {
            ++count;
            std::cout << jn << '\n';
        }
    }
}


USING: grouping io kernel lists lists.lazy math math.functions
math.primes prettyprint sequences ;

: 2^-1^ ( n -- 2^n -1^n ) dup 2^ -1 rot ^ ;
: jacobsthal ( m -- n ) 2^-1^ - 3 / ;
: jacobsthal-lucas ( m -- n ) 2^-1^ + ;
: as-list ( quot -- list ) 0 lfrom swap lmap-lazy ; inline
: jacobsthals ( -- list ) [ jacobsthal ] as-list ;
: lucas-jacobthals ( -- list ) [ jacobsthal-lucas ] as-list ;
: prime-jacobsthals ( -- list ) jacobsthals [ prime? ] lfilter ;
: show ( n list -- ) ltake list>array 5 group simple-table. nl ;

: oblong ( -- list )
    jacobsthals dup cdr lzip [ product ] lmap-lazy ;

"First 30 Jacobsthal numbers:" print
30 jacobsthals show

"First 30 Jacobsthal-Lucas numbers:" print
30 lucas-jacobthals show

"First 20 Jacobsthal oblong numbers:" print
20 oblong show

"First 20 Jacobsthal primes:" print
20 prime-jacobsthals ltake [ . ] leach


Function isPrime(n As Ulongint) As Boolean
    If n < 2 Then Return False
    If n Mod 2 = 0 Then Return false
    For i As Uinteger = 3 To Int(Sqr(n))+1 Step 2
        If n Mod i = 0 Then Return false
    Next i
    Return true
End Function

Dim Shared As Uinteger n(1)
Dim Shared As Uinteger i0 = 0, i1 = 1
Dim Shared As Integer j, c, P = 1, Q = -2

Print "First 30 Jacobsthal numbers:"
c = 0 : n(i0) = 0: n(i1) = 1
For j = 0 To 29
    c += 1
    Print Using " #########"; n(i0);
    Print Iif (c Mod 5, "", !"\n");
    n(i0) = P * n(i1) - Q * n(i0)
    Swap i0, i1
Next j

Print !"\n\nFirst 30 Jacobsthal-Lucas numbers: "
c = 0 : n(i0) = 2: n(i1) = 1
For j = 0 To 29
    c += 1
    Print Using " #########"; n(i0);
    Print Iif (c Mod 5, "", !"\n");
    n(i0) = P * n(i1) - Q * n(i0)
    Swap i0, i1
Next j

Print !"\n\nFirst 20 Jacobsthal oblong numbers: "
c = 0 : n(i0) = 0: n(i1) = 1
For j = 0 To 19
    c += 1
    Print Using " ###########"; n(i0)*n(i1);
    Print Iif (c Mod 5, "", !"\n");
    n(i0) = P * n(i1) - Q * n(i0)
    Swap i0, i1
Next j

Print !"\n\nFirst 10 Jacobsthal primes: "
c = 0 : n(i0) = 0: n(i1) = 1
Do
    If isPrime(n(i0)) Then c += 1 : Print n(i0)
    n(i0) = P * n(i1) - Q * n(i0)
    Swap i0, i1
Loop Until c = 10
Sleep


package main

import (
    "fmt"
    "math/big"
)

func jacobsthal(n uint) *big.Int {
    t := big.NewInt(1)
    t.Lsh(t, n)
    s := big.NewInt(1)
    if n%2 != 0 {
        s.Neg(s)
    }
    t.Sub(t, s)
    return t.Div(t, big.NewInt(3))
}

func jacobsthalLucas(n uint) *big.Int {
    t := big.NewInt(1)
    t.Lsh(t, n)
    a := big.NewInt(1)
    if n%2 != 0 {
        a.Neg(a)
    }
    return t.Add(t, a)
}

func main() {
    jac := make([]*big.Int, 30)
    fmt.Println("First 30 Jacobsthal numbers:")
    for i := uint(0); i < 30; i++ {
        jac[i] = jacobsthal(i)
        fmt.Printf("%9d ", jac[i])
        if (i+1)%5 == 0 {
            fmt.Println()
        }
    }

    fmt.Println("\nFirst 30 Jacobsthal-Lucas numbers:")
    for i := uint(0); i < 30; i++ {
        fmt.Printf("%9d ", jacobsthalLucas(i))
        if (i+1)%5 == 0 {
            fmt.Println()
        }
    }

    fmt.Println("\nFirst 20 Jacobsthal oblong numbers:")
    for i := uint(0); i < 20; i++ {
        t := big.NewInt(0)
        fmt.Printf("%11d ", t.Mul(jac[i], jac[i+1]))
        if (i+1)%5 == 0 {
            fmt.Println()
        }
    }

    fmt.Println("\nFirst 20 Jacobsthal primes:")
    for n, count := uint(0), 0; count < 20; n++ {
        j := jacobsthal(n)
        if j.ProbablyPrime(10) {
            fmt.Println(j)
            count++
        }
    }
}


jacobsthal :: [Integer]
jacobsthal = 0 : 1 : zipWith (\x y -> 2 * x + y) jacobsthal (tail jacobsthal)

jacobsthalLucas :: [Integer]
jacobsthalLucas = 2 : 1 : zipWith (\x y -> 2 * x + y) jacobsthalLucas (tail jacobsthalLucas)

jacobsthalOblong :: [Integer]
jacobsthalOblong = zipWith (*) jacobsthal (tail jacobsthal)

isPrime :: Integer -> Bool
isPrime n = n > 1 && not (or [n `mod` i == 0 | i <- [2 .. floor (sqrt (fromInteger n))]])

main :: IO ()
main = do
  putStrLn "First 30 Jacobsthal numbers:"
  print $ take 30 jacobsthal
  putStrLn ""
  putStrLn "First 30 Jacobsthal-Lucas numbers:"
  print $ take 30 jacobsthalLucas
  putStrLn ""
  putStrLn "First 20 Jacobsthal oblong numbers:"
  print $ take 20 jacobsthalOblong
  putStrLn ""
  putStrLn "First 10 Jacobsthal primes:"
  print $ take 10 $ filter isPrime jacobsthal


ja=: 3 %~ 2x&^ - _1x&^ NB. Jacobsthal
jl=:      2x&^ + _1x&^ NB.Jacobsthal-Lucas


# Split the input array into a stream of arrays
def chunks(n):
  def c: .[0:n], (if length > n then .[n:]|c else empty end);
  c;

def lpad($len): tostring | ($len - length) as $l | (" " * $l)[:$l] + .;

# If $j is 0, then an error condition is raised;
# otherwise, assuming infinite-precision integer arithmetic,
# if the input and $j are integers, then the result will be a pair of integers.
def divmod($j):
  . as $i
  | ($i % $j) as $mod
  | [($i - $mod) / $j, $mod] ;

# To take advantage of gojq's arbitrary-precision integer arithmetic:
def power($b): . as $in | reduce range(0;$b) as $i (1; . * $in);


using Lazy
using Primes

J(n) = (2^n - (-1)^n) ÷ 3
L(n) =  2^n + (-1)^n

Jacobsthal = @>> Lazy.range(0) map(J)
JLucas = @>> Lazy.range(0) map(L)
Joblong = @>> Lazy.range(big"0") map(n -> J(n) * J(n + 1))
Jprimes = @>> Lazy.range(big"0") map(J) filter(isprime)

function printrows(title, vec, columnsize = 15, columns = 5, rjust=true)
    println(title)
    for (i, n) in enumerate(vec)
        print((rjust ? lpad : rpad)(n, columnsize), i % columns == 0 ? "\n" : "")
    end
    println()
end

printrows("Thirty Jacobsthal numbers:", collect(take(30, Jacobsthal)))
printrows("Thirty Jacobsthal-Lucas numbers:", collect(take(30, JLucas)))
printrows("Twenty oblong Jacobsthal numbers:", collect(take(20, Joblong)))
printrows("Fifteen Jacabsthal prime numbers:", collect(take(15, Jprimes)), 40, 1, false)


ClearAll[Jacobsthal, JacobsthalLucas, JacobsthalOblong]
Jacobsthal[n_]:=(2^n-(-1)^n)/3
JacobsthalLucas[n_]:=2^n+(-1)^n
JacobsthalOblong[n_]:=Jacobsthal[n]Jacobsthal[n+1]
Jacobsthal[Range[0, 29]]
JacobsthalLucas[Range[0, 29]]
JacobsthalOblong[Range[0, 19]]
n=0;
i=0;
Reap[While[n<20,
 If[
  PrimeQ[Jacobsthal[i]]
 ,
  Sow[{i,Jacobsthal[i]}];
  n++;
 ];
 i++;
]][[2,1]]//Grid


use strict;
use warnings;
use feature <say state>;
use bigint;
use List::Util 'max';
use ntheory 'is_prime';

sub table { my $t = 5 * (my $c = 1 + length max @_); ( sprintf( ('%'.$c.'d')x@_, @_) ) =~ s/.{1,$t}\K/\n/gr }

sub jacobsthal       { my($n) = @_; state  @J = (0, 1); do { push  @J,  $J[-1] + 2 *  $J[-2]} until  @J > $n;  $J[$n] }
sub jacobsthal_lucas { my($n) = @_; state @JL = (2, 1); do { push @JL, $JL[-1] + 2 * $JL[-2]} until @JL > $n; $JL[$n] }

my(@j,@jp,$c,$n);
push @j, jacobsthal $_ for 0..29;
do { is_prime($n = ( 2**++$c - -1**$c ) / 3) and push @jp, $n } until @jp == 20;

say "First 30 Jacobsthal numbers:\n",        table @j;
say "First 30 Jacobsthal-Lucas numbers:\n",  table map { jacobsthal_lucas $_-1 } 1..30;
say "First 20 Jacobsthal oblong numbers:\n", table map { $j[$_-1] * $j[$_]     } 1..20;
say "First 20 Jacobsthal primes:\n",         join "\n", @jp;


with javascript_semantics
function jacobsthal(integer n)
    return floor((power(2,n)+odd(n))/3)
end function

function jacobsthal_lucas(integer n)
    return power(2,n)+power(-1,n)
end function

function jacobsthal_oblong(integer n)
    return jacobsthal(n)*jacobsthal(n+1)
end function

printf(1,"First 30 Jacobsthal numbers:\n%s\n",       {join_by(apply(true,sprintf,{{"%9d" },apply(tagset(29,0),jacobsthal)}),1,5," ")})
printf(1,"First 30 Jacobsthal-Lucas numbers:\n%s\n", {join_by(apply(true,sprintf,{{"%9d" },apply(tagset(29,0),jacobsthal_lucas)}),1,5," ")})
printf(1,"First 20 Jacobsthal oblong numbers:\n%s\n",{join_by(apply(true,sprintf,{{"%11d"},apply(tagset(19,0),jacobsthal_oblong)}),1,5," ")})
--printf(1,"First 10 Jacobsthal primes:\n%s\n",    {join(apply(true,sprintf,{{"%d"},filter(apply(tagset(31,0),jacobsthal),is_prime)}),"\n")})
--hmm(""), fine, but to go further roll out gmp:
include mpfr.e
mpz z = mpz_init()
integer n = 1, found = 0
printf(1,"First 20 jacobsthal primes:\n")
while found<20 do
    mpz_ui_pow_ui(z,2,n)
    mpz_add_ui(z,z,odd(n))
    {} = mpz_fdiv_q_ui(z,z,3)
    if mpz_prime(z) then
        found += 1
        printf(1,"%s\n",{mpz_get_str(z)})
    end if
    n += 1
end while


#!/usr/bin/python
from math import floor, pow

def isPrime(n):
    for i in range(2, int(n**0.5) + 1):
        if n % i == 0:
            return False
    return True

def odd(n):
    return n and 1 != 0

def jacobsthal(n):
    return floor((pow(2,n)+odd(n))/3)

def jacobsthal_lucas(n):
    return int(pow(2,n)+pow(-1,n))

def jacobsthal_oblong(n):
    return jacobsthal(n)*jacobsthal(n+1)

if __name__ == '__main__':
    print("First 30 Jacobsthal numbers:")
    for j in range(0, 30):
        print(jacobsthal(j), end="  ")

    print("\n\nFirst 30 Jacobsthal-Lucas numbers: ")
    for j in range(0, 30):
        print(jacobsthal_lucas(j), end = '\t')

    print("\n\nFirst 20 Jacobsthal oblong numbers: ")
    for j in range(0, 20):
        print(jacobsthal_oblong(j), end="  ")

    print("\n\nFirst 10 Jacobsthal primes: ")
    for j in range(3, 33):
        if isPrime(jacobsthal(j)):
            print(jacobsthal(j))


my $jacobsthal = cache lazy 0, 1, * × 2 + * … *;
my $jacobsthal-lucas = lazy 2, 1, * × 2 + * … *;

say "First 30 Jacobsthal numbers:";
say $jacobsthal[^30].batch(5)».fmt("%9d").join: "\n";

say "\nFirst 30 Jacobsthal-Lucas numbers:";
say $jacobsthal-lucas[^30].batch(5)».fmt("%9d").join: "\n";

say "\nFirst 20 Jacobsthal oblong numbers:";
say (^∞).map( { $jacobsthal[$_] × $jacobsthal[$_+1] } )[^20].batch(5)».fmt("%11d").join: "\n";

say "\nFirst 20 Jacobsthal primes:";
say $jacobsthal.grep( &is-prime )[^20].join: "\n";


Red ["Jacobsthal numbers"]

jacobsthal: function [n] [to-integer (2 ** n - (-1 ** n) / 3)]

lucas: function [n] [2 ** n + (-1 ** n)]

oblong: function [n] [
    first split mold multiply to-float jacobsthal n to-float jacobsthal n + 1 #"."   ; work around integer overflow
]

prime?: function [
    "Returns true if the input is a prime number"
    n [number!] "An integer to check for primality"
][
    if 2 = n [return true]
    if any [1 = n even? n] [return false]
    limit: sqrt n
    candidate: 3
    while [candidate < limit][
        if n % candidate = 0 [return false]
        candidate: candidate + 2
    ]
    true
]

show: function [n fn][
    cols: length? mold fn n
    repeat i n [
        prin [pad fn subtract i 1 cols]
        if i % 5 = 0 [prin newline]
    ]
    prin newline
]

print "First 30 Jacobsthal numbers:"
show 30 :jacobsthal

print "First 30 Jacobsthal-Lucas numbers:"
show 30 :lucas

print "First 20 Jacobsthal oblong numbers:"
show 20 :oblong

print "First 10 Jacobsthal primes:"
primes: n: 0
while [primes < 10][
    if prime? jacobsthal n [
        print jacobsthal n
        primes: primes + 1
    ]
    n: n + 1
]


// [dependencies]
// rug = "0.3"

use rug::integer::IsPrime;
use rug::Integer;

fn jacobsthal_numbers() -> impl std::iter::Iterator<Item = Integer> {
    (0..).map(|x| ((Integer::from(1) << x) - if x % 2 == 0 { 1 } else { -1 }) / 3)
}

fn jacobsthal_lucas_numbers() -> impl std::iter::Iterator<Item = Integer> {
    (0..).map(|x| (Integer::from(1) << x) + if x % 2 == 0 { 1 } else { -1 })
}

fn jacobsthal_oblong_numbers() -> impl std::iter::Iterator<Item = Integer> {
    let mut jn = jacobsthal_numbers();
    let mut n0 = jn.next().unwrap();
    std::iter::from_fn(move || {
        let n1 = jn.next().unwrap();
        let result = Integer::from(&n0 * &n1);
        n0 = n1;
        Some(result)
    })
}

fn jacobsthal_primes() -> impl std::iter::Iterator<Item = Integer> {
    jacobsthal_numbers().filter(|x| x.is_probably_prime(30) != IsPrime::No)
}

fn main() {
    println!("First 30 Jacobsthal Numbers:");
    for (i, n) in jacobsthal_numbers().take(30).enumerate() {
        print!("{:9}{}", n, if (i + 1) % 5 == 0 { "\n" } else { " " });
    }
    println!("\nFirst 30 Jacobsthal-Lucas Numbers:");
    for (i, n) in jacobsthal_lucas_numbers().take(30).enumerate() {
        print!("{:9}{}", n, if (i + 1) % 5 == 0 { "\n" } else { " " });
    }
    println!("\nFirst 20 Jacobsthal oblong Numbers:");
    for (i, n) in jacobsthal_oblong_numbers().take(20).enumerate() {
        print!("{:11}{}", n, if (i + 1) % 5 == 0 { "\n" } else { " " });
    }
    println!("\nFirst 20 Jacobsthal primes:");
    for n in jacobsthal_primes().take(20) {
        println!("{}", n);
    }
}


func jacobsthal(n) {
    lucasU(1, -2, n)
}

func lucas_jacobsthal(n) {
    lucasV(1, -2, n)
}

say "First 30 Jacobsthal numbers:"
say 30.of(jacobsthal)

say "\nFirst 30 Jacobsthal-Lucas numbers:"
say 30.of(lucas_jacobsthal)

say "\nFirst 20 Jacobsthal oblong numbers:"
say 21.of(jacobsthal).cons(2, {|a,b| a * b })

say "\nFirst 20 Jacobsthal primes:";
say (1..Inf -> lazy.map(jacobsthal).grep{.is_prime}.first(20))


import math.big

fn jacobsthal(n u32) big.Integer {
    mut t := big.one_int
    t=t.lshift(n)
    mut s := big.one_int
    if n%2 != 0 {
        s=s.neg()
    }
    t -= s
    return t/big.integer_from_int(3)
}

fn jacobsthal_lucas(n u32) big.Integer {
    mut t := big.one_int
    t=t.lshift(n)
    mut a := big.one_int
    if n%2 != 0 {
        a=a.neg()
    }
    return t+a
}

fn main() {
    mut jac := []big.Integer{len: 30}
    println("First 30 Jacobsthal numbers:")
    for i := u32(0); i < 30; i++ {
        jac[i] = jacobsthal(i)
        print("${jac[i]:9} ")
        if (i+1)%5 == 0 {
            println('')
        }
    }

    println("\nFirst 30 Jacobsthal-Lucas numbers:")
    for i := u32(0); i < 30; i++ {
        print("${jacobsthal_lucas(i):9} ")
        if (i+1)%5 == 0 {
            println('')
        }
    }

    println("\nFirst 20 Jacobsthal oblong numbers:")
    for i := u32(0); i < 20; i++ {
        print("${jac[i]*jac[i+1]:11} ")
        if (i+1)%5 == 0 {
            println('')
        }
    }

    /*println("\nFirst 20 Jacobsthal primes:")
    for n, count := u32(0), 0; count < 20; n++ {
        j := jacobsthal(n)
        if j.probably_prime(10) {
            println(j)
            count++
        }
    }*/
}


import "./big" for BigInt
import "./seq" for Lst
import "./fmt" for Fmt

var jacobsthal = Fn.new { |n| ((BigInt.one << n) - ((n%2 == 0) ? 1 : -1)) / 3 }

var jacobsthalLucas = Fn.new { |n| (BigInt.one << n) + ((n%2 == 0) ? 1 : -1) }

System.print("First 30 Jacobsthal numbers:")
var js = (0..29).map { |i| jacobsthal.call(i) }.toList
for (chunk in Lst.chunks(js, 5)) Fmt.print("$,12i", chunk)

System.print("\nFirst 30 Jacobsthal-Lucas numbers:")
var jsl = (0..29).map { |i| jacobsthalLucas.call(i) }.toList
for (chunk in Lst.chunks(jsl, 5)) Fmt.print("$,12i", chunk)

System.print("\nFirst 20 Jacobsthal oblong numbers:")
var oblongs = (0..19).map { |i| js[i] * js[i+1] }.toList
for (chunk in Lst.chunks(oblongs, 5)) Fmt.print("$,14i", chunk)

var primes = js.where { |j| j.isProbablePrime(10) }.toList
var count = primes.count
var i = 31
while (count < 20) {
    var j = jacobsthal.call(i)
    if (j.isProbablePrime(10)) {
        primes.add(j)
        count = count + 1
    }
    i = i + 1
}
System.print("\nFirst 20 Jacobsthal primes:")
for (i in 0..19) Fmt.print("$i", primes[i])


func IsPrime(N);        \Return 'true' if N is prime
int  N, I;
[if N <= 2 then return N = 2;
if (N&1) = 0 then \even >2\ return false;
for I:= 3 to sqrt(N) do
    [if rem(N/I) = 0 then return false;
    I:= I+1;
    ];
return true;
];

proc Jaco(J2);          \Display 30 Jacobsthal (or -Lucas) numbers
real J2, J1, J;
int  N;
[RlOut(0, J2);
J1:= 1.0;
RlOut(0, J1);
for N:= 2 to 30-1 do
        [J:= J1 + 2.0*J2;
        RlOut(0, J);
        if rem((N+1)/5) = 0 then CrLf(0);
        J2:= J1;  J1:= J;
        ];
CrLf(0);
];

real J, J1, J2, JO;
int  N;
[Format(14, 0);
Jaco(0.0);
Jaco(2.0);
J2:= 1.0;
RlOut(0, 0.0);
J1:= 1.0;
RlOut(0, J1);
for N:= 2 to 20-1 do
        [J:= (J1 + 2.0*J2);
        JO:= J*J1;
        RlOut(0, JO);
        if rem((N+1)/5) = 0 then CrLf(0);
        J2:= J1;  J1:= J;
        ];
CrLf(0);
J2:= 0.0;  J1:= 1.0;  N:= 0;
loop    [J:= J1 + 2.0*J2;
        if IsPrime(fix(J)) then
            [RlOut(0, J);
            N:= N+1;
            if rem(N/5) = 0 then CrLf(0);
            if N >= 10 then quit;
            ];
        J2:= J1;  J1:= J;
        ];
]


	org	100h
	jmp	demo
	;;;	---------------------------------------------------------------
	;;;	Check if the string at BC is a valid ISBN-13 code.
	;;;	Carry set if true, clear if not.
isbn13:	lxi	h,0	; HL = accumulator
	mov	d,h	; D = 0 (such that if E=A, DE=A).
	call	isbngc	; Get first character
	rnc		; Carry clear = invalid
	dad	d	; Add to running total once
	call	isbngc	; Get second character
	rnc		; Carry clear = invalid
	dad	d	; Add to running total thrice
	dad	d
	dad	d
	call	isbngc	; Get third character
	rnc		; Carry clear = invalid
	dad	d	; Add to running total once
	ldax	b	; Fourth character should be a dash '-'
	inx	b
	cpi	'-'
	stc		; Clear carry w/o touching other flags
	cmc
	rnz		; If not equal, invalid.
	push	h	; Keep loop counter on stack
	mvi	l,5	; 5 times 2 characters
isbnlp:	xthl		; Accumulator in HL
	call	isbngc	; Get even character
	jnc	isbnex	; If invalid, stop
	dad	d	; Add to running total thrice
	dad	d
	dad 	d
	call	isbngc	; Get odd character
	jnc	isbnex	; If invalid, stop
	dad	d	; Add to running total once
	xthl		; Loop counter in (H)L
	dcr	l	; Done yet?
	jnz	isbnlp	; If not, do next two characters
	pop	h	; Get accumulator
	lxi	d,-10	; Trial division by ten
isbndv:	dad	d	; Subtract 10
	jc	isbndv 	; Until zero passed
	mov	a,l	; Move low byte to A
	adi	10 	; Add ten back (the mod loop went one step too far)
	rz		; If zero, return (carry will have been set)
	ana	a	; Otherwise, make sure carry is clear
	ret		; And then return
isbnex:	pop	h	; Test failed - throw away accumulator and return
	ret
isbngc:	ldax	b	; Get character from [BC]
	inx	b	; Increment BC
	sui	'0'	; Subtract ASCII '0' to get digit value
	cpi	10	; If 10 or higher (unsigned), invalid digit.
	mov	e,a	; Set (D)E = value
	ret
	;;;	---------------------------------------------------------------
	;;;	Demo: see if the CP/M command line contains a valid ISBN13
	;;; 	code.
demo:	lxi	b,82h	; Start of command line argument, skipping first space
	call	isbn13	; Is it valid?
	mvi	c,9	; CP/M print string
	lxi	d,good	; If carry is set, then yes
	jc	5
	lxi	d,bad	; Otherwise, no.
	jmp	5
good:	db	'good$'
bad:	db	'bad$'


	cpu	8086
	bits	16
	org	100h
section	.text
	jmp	demo
isbn13:	;;;	---------------------------------------------------------------
	;;;	Check if the string at DS:SI is a valid ISBN-13 code.
	;;;	Carry set if true, clear if false.
	xor	dx,dx		; DX = running total
	xor	ah,ah		; Set AH=0 so that AX=AL
	call	.digit		; Get first digit and add to DX
	call	.digit		; Get second digit and add to DX
	add	dx,ax		; Add to DX twice more
	add	dx,ax
	call	.digit		; Get third digit and add to DX
	lodsb			; Fourth character should be a '-'
	cmp	al,'-'
	jne	.fail 		; If not equal, fail
	mov	cx,5 		; Then loop 5 times for the next 10 digits
.loop:	call	.digit		; Get even digit and add to DX
	add	dx,ax		; Add to running total twice more
	add	dx,ax
	call	.digit		; Get odd digit and add to DX
	loop	.loop		; Do this 5 times
	mov	ax,dx		; Divide running total by 10
	mov	dl,10
	div	dl
	test	ah,ah		; Is the remainder zero?
	jnz	.out		; If not, stop (TEST clears carry)
	stc			; Otherwise, set carry and return
	ret
.digit:	lodsb			; Get first character
	sub	al,'0'		; Subtract ASCII 0 to get digit value
	cmp	al,9
	ja	.dfail
	add	dx,ax		; Add to ASCII
	ret
.dfail:	pop	dx		; Remove return pointer for .digit from stack
.fail:	clc			; Failure - clear carry
.out:	ret
	;;;	---------------------------------------------------------------
	;;;	Demo: see if the MS-DOS command line contains a valid ISBN13
	;;;	code.
demo:	mov	si,82h		; Start of command line argument skipping space
	call	isbn13		; Is it valid?
	mov	ah,9		; MS-DOS print string
	mov	dx,good		; If carry is set, it is good
	jc	.print
	mov	dx,bad		; Otherwise, it is bad
.print:	int	21h
	ret
section	.data
good:	db	'good$'
bad: 	db	'bad$'


INCLUDE "D2:CHARTEST.ACT" ;from the Action! Tool Kit

BYTE FUNC CheckISBN13(CHAR ARRAY t)
  BYTE i,index,sum,v

  sum=0 index=0
  FOR i=1 TO t(0)
  DO
    v=t(i)
    IF IsDigit(v) THEN
      v==-'0
      IF index MOD 2=1 THEN
        v==*3
      FI
      sum==+v
      index==+1
    ELSEIF v#'  AND v#'- THEN
      RETURN (0)
    FI
  OD
  IF index#13 OR sum MOD 10#0 THEN
    RETURN (0)
  FI
RETURN (1)

PROC Test(CHAR ARRAY t)
  BYTE correct

  correct=CheckISBN13(t)
  Print(t) Print(" is ")
  IF correct THEN
    PrintE("correct")
  ELSE
    PrintE("incorrect")
  FI
RETURN

PROC Main()
  Put(125) PutE() ;clear screen

  Test("978-1734314502")
  Test("978-1734314509")
  Test("978-1788399081")
  Test("978-1788399083")
RETURN


with Ada.Text_IO;

procedure ISBN_Check is

   function Is_Valid (ISBN : String) return Boolean is
      Odd       : Boolean := True;
      Sum       : Integer := 0;
      Value     : Integer;
   begin
      for I in ISBN'Range loop
         if ISBN (I) in '0' .. '9' then
            Value := Character'Pos (ISBN (I)) - Character'Pos ('0');
            if Odd then
               Sum := Sum + Value;
            else
               Sum := Sum + 3 * Value;
            end if;
            Odd := not Odd;
         end if;
      end loop;
      return Sum mod 10 = 0;
   end Is_Valid;

   procedure Show (ISBN : String) is
      use Ada.Text_IO;
      Valid : constant Boolean := Is_Valid (ISBN);
   begin
      Put (ISBN); Put ("  ");
      Put ((if Valid then "Good" else "Bad"));
      New_Line;
   end Show;
begin
   Show ("978-1734314502");
   Show ("978-1734314509");
   Show ("978-1788399081");
   Show ("978-1788399083");
end ISBN_Check;


BEGIN # Check some IsBN13 check digits                                         #
    # returns TRUE if the alledged isbn13 has the correct check sum,           #
    #         FALSE otherwise                                                  #
    #         non-digit characters are ignored and there must be 13 digits     #
    PROC check isbn13 = ( STRING isbn13 )BOOL:
         BEGIN
            INT sum          := 0;
            INT digits       := 0;
            BOOL other digit := FALSE;
            FOR pos FROM LWB isbn13 TO UPB isbn13 DO
                IF CHAR c = isbn13[ pos ];
                   c >= "0" AND c <= "9"
                THEN
                    # have another digit                                       #
                    digits +:= 1;
                    sum    +:= ( ABS c - ABS "0" ) * IF other digit THEN 3 ELSE 1 FI;
                    other digit := NOT other digit
                FI
            OD;
            digits = 13 AND sum MOD 10 = 0
         END; # check isbn13 #
    # task test cases #
    []STRING tests    = ( "978-1734314502", "978-1734314509", "978-1788399081", "978-1788399083" );
    []BOOL   expected = (             TRUE,            FALSE,             TRUE,            FALSE );
    FOR pos FROM LWB tests TO UPB tests DO
        BOOL result = check isbn13( tests[ pos ] );
        print( ( tests[ pos ]
               , ": "
               , IF result THEN "good" ELSE "bad" FI
               , IF result = expected[ pos ] THEN "" ELSE " NOT AS EXPECTED" FI
               , newline
               )
             )
    OD
END


-------------------- ISBN13 CHECK DIGIT --------------------

-- isISBN13 :: String -> Bool
on isISBN13(s)
    script digitValue
        on |λ|(c)
            if isDigit(c) then
                {c as integer}
            else
                {}
            end if
        end |λ|
    end script

    set digits to concatMap(digitValue, characters of s)

    13 = length of digits ¬
        and 0 = sum(zipWith(my mul, digits, cycle({1, 3}))) mod 10
end isISBN13

--------------------------- TEST ---------------------------
on run
    script test
        on |λ|(s)
            {s, isISBN13(s)}
        end |λ|
    end script

    map(test, {"978-1734314502", "978-1734314509", ¬
        "978-1788399081", "978-1788399083"})
end run

-------------------- GENERIC FUNCTIONS ---------------------

-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    set lng to length of xs
    set acc to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set acc to acc & (|λ|(item i of xs, i, xs))
        end repeat
    end tell
    return acc
end concatMap

-- cycle :: [a] -> Generator [a]
on cycle(xs)
    script
        property lng : 1 + (length of xs)
        property i : missing value
        on |λ|()
            if missing value is i then
                set i to 1
            else
                set nxt to (1 + i) mod lng
                if 0 = ((1 + i) mod lng) then
                    set i to 1
                else
                    set i to nxt
                end if
            end if
            return item i of xs
        end |λ|
    end script
end cycle

-- foldl :: (a -> b -> a) -> a -> [b] -> a
on foldl(f, startValue, xs)
    tell mReturn(f)
        set v to startValue
        set lng to length of xs
        repeat with i from 1 to lng
            set v to |λ|(v, item i of xs, i, xs)
        end repeat
        return v
    end tell
end foldl

-- isDigit :: Char -> Bool
on isDigit(c)
    set n to (id of c)
    48 ≤ n and 57 ≥ n
end isDigit

-- length :: [a] -> Int
on |length|(xs)
    set c to class of xs
    if list is c or string is c then
        length of xs
    else
        (2 ^ 29 - 1) -- (maxInt - simple proxy for non-finite)
    end if
end |length|

-- map :: (a -> b) -> [a] -> [b]
on map(f, xs)
    -- The list obtained by applying f
    -- to each element of xs.
    tell mReturn(f)
        set lng to length of xs
        set lst to {}
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs, i, xs)
        end repeat
        return lst
    end tell
end map

-- min :: Ord a => a -> a -> a
on min(x, y)
    if y < x then
        y
    else
        x
    end if
end min

-- mReturn :: First-class m => (a -> b) -> m (a -> b)
on mReturn(f)
    -- 2nd class handler function lifted into 1st class script wrapper.
    if script is class of f then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- mul (*) :: Num a => a -> a -> a
on mul(a, b)
    a * b
end mul

-- sum :: [Num] -> Num
on sum(xs)
    script add
        on |λ|(a, b)
            a + b
        end |λ|
    end script

    foldl(add, 0, xs)
end sum

-- take :: Int -> [a] -> [a]
-- take :: Int -> String -> String
on take(n, xs)
    set c to class of xs
    if list is c then
        if 0 < n then
            items 1 thru min(n, length of xs) of xs
        else
            {}
        end if
    else if string is c then
        if 0 < n then
            text 1 thru min(n, length of xs) of xs
        else
            ""
        end if
    else if script is c then
        set ys to {}
        repeat with i from 1 to n
            set v to |λ|() of xs
            if missing value is v then
                return ys
            else
                set end of ys to v
            end if
        end repeat
        return ys
    else
        missing value
    end if
end take

-- zipWith :: (a -> b -> c) -> [a] -> [b] -> [c]
on zipWith(f, xs, ys)
    set lng to min(|length|(xs), |length|(ys))
    if 1 > lng then return {}
    set xs_ to take(lng, xs) -- Allow for non-finite
    set ys_ to take(lng, ys) -- generators like cycle etc
    set lst to {}
    tell mReturn(f)
        repeat with i from 1 to lng
            set end of lst to |λ|(item i of xs_, item i of ys_)
        end repeat
        return lst
    end tell
end zipWith


validISBN?: function [isbn][
    currentCheck: to :integer to :string last isbn
    isbn: map split chop replace isbn "-" "" => [to :integer]

    s: 0
    loop.with:'i isbn 'n [
        if? even? i -> s: s + n
        else -> s: s + 3*n
    ]
    checkDigit: 10 - s % 10
    return currentCheck = checkDigit
]

tests: [
    "978-1734314502" "978-1734314509"
    "978-1788399081" "978-1788399083"
]

loop tests 'test [
    print [test "=>" validISBN? test]
]


ISBN13_check_digit(n){
	for i, v in StrSplit(RegExReplace(n, "[^0-9]"))
		sum += !Mod(i, 2) ? v*3 : v
	return n "`t" (Mod(sum, 10) ? "(bad)" : "(good)")
}


get "libhdr"

let checkISBN(s) = valof
$(  let tally = 0
    unless s%0 = 14 resultis false
    unless s%4 = '-' resultis false

    for i=1 to 3
    $(  let digit = s%i-'0'
        test i rem 2 = 0
            do tally := tally + 3 * digit
            or tally := tally + digit
    $)

    for i=5 to 14
    $(  let digit = s%i-'0'
        test i rem 2 = 0
            do tally := tally + digit
            or tally := tally + 3 * digit
    $)

    resultis tally rem 10 = 0
$)

let show(s) be
    writef("%S: %S*N", s, checkISBN(s) -> "good", "bad")

let start() be
$(  show("978-1734314502")
    show("978-1734314509")
    show("978-1788399081")
    show("978-1788399083")
$)


#include <stdio.h>

int check_isbn13(const char *isbn) {
    int ch = *isbn, count = 0, sum = 0;
    /* check isbn contains 13 digits and calculate weighted sum */
    for ( ; ch != 0; ch = *++isbn, ++count) {
        /* skip hyphens or spaces */
        if (ch == ' ' || ch == '-') {
            --count;
            continue;
        }
        if (ch < '0' || ch > '9') {
            return 0;
        }
        if (count & 1) {
            sum += 3 * (ch - '0');
        } else {
            sum += ch - '0';
        }
    }
    if (count != 13) return 0;
    return !(sum%10);
}

int main() {
    int i;
    const char* isbns[] = {"978-1734314502", "978-1734314509", "978-1788399081", "978-1788399083"};
    for (i = 0; i < 4; ++i) {
        printf("%s: %s\n", isbns[i], check_isbn13(isbns[i]) ? "good" : "bad");
    }
    return 0;
}


#include <iostream>

bool check_isbn13(std::string isbn) {
    int count = 0;
    int sum = 0;

    for (auto ch : isbn) {
        /* skip hyphens or spaces */
        if (ch == ' ' || ch == '-') {
            continue;
        }
        if (ch < '0' || ch > '9') {
            return false;
        }
        if (count & 1) {
            sum += 3 * (ch - '0');
        } else {
            sum += ch - '0';
        }
        count++;
    }

    if (count != 13) {
        return false;
    }
    return sum % 10 == 0;
}

int main() {
    auto isbns = { "978-1734314502", "978-1734314509", "978-1788399081", "978-1788399083" };
    for (auto isbn : isbns) {
        std::cout << isbn << ": " << (check_isbn13(isbn) ? "good" : "bad") << '\n';
    }

    return 0;
}


using System;
using System.Linq;

public class Program
{
    public static void Main() {
        Console.WriteLine(CheckISBN13("978-1734314502"));
        Console.WriteLine(CheckISBN13("978-1734314509"));
        Console.WriteLine(CheckISBN13("978-1788399081"));
        Console.WriteLine(CheckISBN13("978-1788399083"));

        static bool CheckISBN13(string code) {
            code = code.Replace("-", "").Replace(" ", "");
            if (code.Length != 13) return false;
            int sum = 0;
            foreach (var (index, digit) in code.Select((digit, index) => (index, digit))) {
                if (char.IsDigit(digit)) sum += (digit - '0') * (index % 2 == 0 ? 1 : 3);
                else return false;
            }
            return sum % 10 == 0;
        }
    }
}


isbn13_check = proc (s: string) returns (bool)
    if string$size(s) ~= 14 then return(false) end
    if s[4] ~= '-' then return(false) end
    begin
        check: int := 0
        for i: int in int$from_to(1, 14) do
            if i=4 then continue end
            d: int := int$parse(string$c2s(s[i]))
            if i=2 cor (i>4 cand i//2=1) then d := d*3 end
            check := check + d
        end
        return(check//10 = 0)
    end except when bad_format:
        return(false)
    end
end isbn13_check

start_up = proc ()
    po: stream := stream$primary_output()
    tests: array[string] := array[string]$
       ["978-1734314502",
        "978-1734314509",
        "978-1788399081",
        "978-1788399083"]

    for test: string in array[string]$elements(tests) do
        stream$puts(po, test)
        stream$puts(po, ": ")
        if isbn13_check(test)
            then stream$putl(po, "good")
            else stream$putl(po, "bad")
        end
    end
end start_up


      ******************************************************************
      * Author: Jay Moseley
      * Date: November 10, 2019
      * Purpose: Testing various subprograms/ functions.
      * Tectonics: cobc -xj testSubs.cbl
      ******************************************************************
       IDENTIFICATION DIVISION.

       PROGRAM-ID. testSubs.
       ENVIRONMENT DIVISION.

       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC
           FUNCTION validISBN13.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

       DATA DIVISION.

       FILE SECTION.

       WORKING-STORAGE SECTION.

       01  IX                          PIC S9(4) COMP.
       01  TEST-ISBNS.
           02  FILLER                  PIC X(14) VALUE '978-1734314502'.
           02  FILLER                  PIC X(14) VALUE '978-1734314509'.
           02  FILLER                  PIC X(14) VALUE '978-1788399081'.
           02  FILLER                  PIC X(14) VALUE '978-1788399083'.
       01  TEST-ISBN                   REDEFINES TEST-ISBNS
                                       OCCURS 4 TIMES
                                       PIC X(14).

       PROCEDURE DIVISION.

       MAIN-PROCEDURE.

           PERFORM
             VARYING IX
             FROM 1
             BY 1
             UNTIL IX > 4

             DISPLAY TEST-ISBN (IX) '   ' WITH NO ADVANCING
             END-DISPLAY
             IF validISBN13(TEST-ISBN (IX)) = -1
               DISPLAY '(bad)'
             ELSE
               DISPLAY '(good)'
             END-IF

           END-PERFORM.

           GOBACK.

       END PROGRAM testSubs.

      ******************************************************************
      * Author: Jay Moseley
      * Date: May 19, 2016
      * Purpose: validate ISBN-13 (International Standard
      *          Book Number).
      ******************************************************************
       IDENTIFICATION DIVISION.

       FUNCTION-ID. validISBN13.
       ENVIRONMENT DIVISION.

       CONFIGURATION SECTION.
       REPOSITORY.
           FUNCTION ALL INTRINSIC.

       INPUT-OUTPUT SECTION.
       FILE-CONTROL.

       DATA DIVISION.

       FILE SECTION.

       WORKING-STORAGE SECTION.

       01  PASSED-SIZE                 PIC S9(6) COMP-5.
       01  IX                          PIC S9(4) COMP.

       01  WORK-FIELDS.
           02  WF-DIGIT                PIC X.
           02  WF-COUNT                PIC 9(2).
               88  WEIGHT-1  VALUE 1, 3, 5, 7, 9, 11, 13.
               88  WEIGHT-3  VALUE 2, 4, 6, 8, 10, 12.
           02  WF-SUM                  PIC S9(8) COMP.

       LINKAGE SECTION.

       01  PASSED-ISBN                 PIC X ANY LENGTH.
       01  RETURN-VALUE                PIC S9.

       PROCEDURE DIVISION USING PASSED-ISBN
                          RETURNING RETURN-VALUE.

           CALL 'C$PARAMSIZE'
             USING 1
             GIVING PASSED-SIZE
           END-CALL.

       COMPUTE-CKDIGIT.

           INITIALIZE WORK-FIELDS.
           PERFORM
             VARYING IX
             FROM 1
             BY 1
             UNTIL IX GREATER THAN PASSED-SIZE

               MOVE PASSED-ISBN (IX:1) TO WF-DIGIT
               IF WF-DIGIT IS NUMERIC
                 ADD 1 TO WF-COUNT
                 IF WEIGHT-1
                   ADD NUMVAL(WF-DIGIT) TO WF-SUM
                 ELSE
                   COMPUTE WF-SUM = WF-SUM +
                     (NUMVAL(WF-DIGIT) * 3)
                   END-COMPUTE
                 END-IF
               END-IF

           END-PERFORM.

           IF MOD(WF-SUM, 10) = 0
             MOVE +0 TO RETURN-VALUE
           ELSE
             MOVE -1 TO RETURN-VALUE
           END-IF.

           GOBACK.
      * - - - - - - - - - - - - - - - - - - - - - - PROGRAM EXIT POINT

       END FUNCTION validISBN13.


include "cowgol.coh";

sub check_isbn13(isbn: [uint8]): (r: uint8) is
    var n: uint8 := 0;
    r := 0;
    loop
        var c := [isbn];
        isbn := @next isbn;
        if c == 0 then break; end if;
        c := c - '0';
        if c <= 9 then
            r := r + c;
            n := n + 1;
            if (n & 1) == 0 then
                r := r + c * 2;
            end if;
        end if;
    end loop;
    if n == 13 and r%10 == 0 then
        r := 1;
    else
        r := 0;
    end if;
end sub;

var isbns: [uint8][] := {
    "978-1734314502", "978-1734314509", "978-1788399081", "978-1788399083"
};

var result: [uint8][] := {": bad\n", ": good\n"};

var n: uint8 := 0;
while n < @sizeof isbns loop
    print(isbns[n]);
    print(result[check_isbn13(isbns[n])]);
    n := n + 1;
end loop;


import std.stdio;

bool isValidISBN13(string text) {
    int sum, i;
    foreach (c; text) {
        if ('0' <= c && c <= '9') {
            int value = c - '0';
            if (i % 2 == 0) {
                sum += value;
            } else {
                sum += 3 * value;
            }

            i++;
        }
    }
    return i == 13 && 0 == sum % 10;
}

unittest {
    assert(isValidISBN13("978-1734314502"));
    assert(!isValidISBN13("978-1734314509"));
    assert(isValidISBN13("978-1788399081"));
    assert(!isValidISBN13("978-1788399083"));
}


proc nonrec isbn13_check(*char isbn) bool:
    byte n, check, d;
    char cur;
    bool ok;
    n := 0;
    check := 0;
    ok := true;
    while
        cur := isbn*;
        isbn := isbn + 1;
        ok and cur ~= '\e'
    do
        if n=3 then
            if cur ~= '-' then ok := false fi
        elif cur<'0' or cur>'9' then
            ok := false
        else
            d := cur - '0';
            if n=1 or (n>3 and n&1 = 0) then
                d := d * 3;
            fi;
            check := check + d
        fi;
        n := n + 1
    od;
    ok and n = 14 and check%10 = 0
corp

proc nonrec test(*char isbn) void:
    writeln(isbn, ": ",
            if isbn13_check(isbn) then "good" else "bad" fi)
corp

proc nonrec main() void:
    test("978-1734314502");
    test("978-1734314509");
    test("978-1788399081");
    test("978-1788399083")
corp


ISBN13Check
=LAMBDA(s,
    LET(
        ns, FILTERP(
            LAMBDA(v,
                NOT(ISERROR(v))
            )
        )(
            VALUE(CHARSROW(s))
        ),
        ixs, SEQUENCE(
            1, COLUMNS(ns),
            1, 1
        ),

        0 = MOD(
            SUM(
                IF(0 <> MOD(ixs, 2),
                    INDEX(ns, ixs),
                    3 * INDEX(ns, ixs)
                )
            ),
            10
        )
    )
)


USING: combinators.short-circuit formatting kernel math
math.functions math.parser math.vectors qw sequences
sequences.extras sets unicode ;

: (isbn13?) ( str -- ? )
    string>digits
    [ <evens> sum ] [ <odds> 3 v*n sum + ] bi 10 divisor? ;

: isbn13? ( str -- ? )
    "- " without
    { [ length 13 = ] [ [ digit? ] all? ] [ (isbn13?) ] } 1&& ;

qw{ 978-1734314502 978-1734314509 978-1788399081 978-1788399083 }
[ dup isbn13? "good" "bad" ? "%s: %s\n" printf ] each


: is-digit [char] 0 - 10 u< ;

: isbn?                                ( a n -- f)
  1- chars over + 2>r 0 1 2r> ?do
    dup i [email protected] dup is-digit              \ get length and factor, setup loop
    if [char] 0 - * rot + swap 3 * 8 mod else drop drop then
  -1 chars +loop drop 10 mod 0=        \ now calculate checksum
;


program isbn13
    implicit none

    character(len=14), dimension(4), parameter  :: isbns=["978-1734314502", "978-1734314509", "978-1788399081", "978-1788399083"]
    integer                                     :: i

    do i = 1, ubound(isbns, 1)
        if (check_isbn13(isbns(i))) then
            print*, isbns(i), " : ", "good"
        else
            print*, isbns(i), " : ", "bad"
        end if
    end do
contains
    pure function check_isbn13(isbn)
        character(len=*), intent(in)    :: isbn
        logical                         :: check_isbn13
        integer                         :: summ, counter, i, digit

        check_isbn13 = .false.
        counter = 0
        summ = 0

        do i = 1, len(isbn)
            if (isbn(i:i) == ' ' .or. isbn(i:i) == '-') cycle
            counter = counter + 1
            read(isbn(i:i), '(I1)') digit
            if (modulo(counter, 2) == 0) then
                summ = summ + 3*digit
            else
                summ = summ + digit
            end if
        end do
        if (counter == 13 .and. modulo(summ, 10) == 0) check_isbn13 = .true.
    end function check_isbn13
end program isbn13


#define ZEROC asc("0")

function is_num( byval c as string ) as boolean
    if asc(c) >= ZEROC andalso asc(c)<ZEROC+10 then return true
    return false
end function

function is_good_isbn( isbn as string ) as boolean
    dim as uinteger charno = 0, digitno = 0, sum = 0
    dim as string*1 currchar
    while charno <= len(isbn)
        currchar = mid(isbn,charno,1)
        if is_num(currchar) then
            if digitno mod 2 = 1 then
                sum += 2*(asc(currchar)-ZEROC)
            end if
            sum += asc(currchar)-ZEROC
            digitno += 1
        end if
        charno += 1
    wend
    if sum mod 10 = 0 then
        return true
    else
        return false
    end if
end function

dim as string isbns(0 to 3) = { "978-1734314502", "978-1734314509", "978-1788399081", "978-1788399083" }
dim as uinteger i
for i = 0 to 3
    if is_good_isbn( isbns(i) ) then
        print isbns(i)+": good"
    else
        print isbns(i)+": bad"
    end if
next i


// ISBN13 Check Digit
open System

let parseInput (input: string) =
    Seq.map(fun c -> c |> string) input |> Seq.toList |> List.map(fun x -> Int32.Parse x)

[<EntryPoint>]
let main argv =
    let isbnnum = parseInput (String.filter (fun x -> x <> '-') argv.[0])
    // Multiply every other digit by 3
    let everyOther = List.mapi (fun i x -> if i % 2 = 0 then x * 3 else x) isbnnum
    // Sum the *3 list with the original list
    let sum = List.sum everyOther + List.sum isbnnum
    // If the remainder of sum / 10 is 0 then it's a valid ISBN13
    if sum % 10 = 0 then
        printfn "%s Valid ISBN13" argv.[0]
    else
        printfn "%s Invalid ISBN13" argv.[0]
    0


package main

import (
    "fmt"
    "strings"
    "unicode/utf8"
)

func checkIsbn13(isbn string) bool {
    // remove any hyphens or spaces
    isbn = strings.ReplaceAll(strings.ReplaceAll(isbn, "-", ""), " ", "")
    // check length == 13
    le := utf8.RuneCountInString(isbn)
    if le != 13 {
        return false
    }
    // check only contains digits and calculate weighted sum
    sum := int32(0)
    for i, c := range isbn {
        if c < '0' || c > '9' {
            return false
        }
        if i%2 == 0 {
            sum += c - '0'
        } else {
            sum += 3 * (c - '0')
        }
    }
    return sum%10 == 0
}

func main() {
    isbns := []string{"978-1734314502", "978-1734314509", "978-1788399081", "978-1788399083"}
    for _, isbn := range isbns {
        res := "bad"
        if checkIsbn13(isbn) {
            res = "good"
        }
        fmt.Printf("%s: %s\n", isbn, res)
    }
}


import Data.Char (digitToInt, isDigit)
import Text.Printf (printf)

pair :: Num a => [a] -> [(a, a)]
pair [] = []
pair xs = p (take 2 xs) : pair (drop 2 xs)
  where
    p ps = case ps of
      (x : y : zs) -> (x, y)
      (x : zs) -> (x, 0)

validIsbn13 :: String -> Bool
validIsbn13 isbn
  | length (digits isbn) /= 13 = False
  | otherwise = calc isbn `rem` 10 == 0
  where
    digits = map digitToInt . filter isDigit
    calc = sum . map (\(x, y) -> x + y * 3) . pair . digits

main :: IO ()
main =
  mapM_
    (printf "%s: Valid: %s\n" <*> (show . validIsbn13))
    [ "978-1734314502",
      "978-1734314509",
      "978-1788399081",
      "978-1788399083"
    ]


100 PROGRAM "ISBN13.bas"
110 DO
120   PRINT :INPUT PROMPT "ISBN-13 code: ":IS$
130   IF IS$="" THEN EXIT DO
140   IF ISBN(IS$) THEN
150     PRINT "Ok."
160   ELSE
170     PRINT "CRC error."
180   END IF
190 LOOP
200 DEF TRIM$(S$)
210   LET T$=""
220   FOR I=1 TO LEN(S$)
230     IF S$(I)>CHR$(47) AND S$(I)<CHR$(58) THEN LET T$=T$&S$(I)
240   NEXT
250   LET TRIM$=T$
260 END DEF
270 DEF ISBN(S$)
280   LET SUM,ISBN=0:LET ISBN$=TRIM$(IS$)
290   IF LEN(ISBN$)<>13 THEN PRINT "Invalid length.":EXIT DEF
300   FOR I=1 TO 11 STEP 2
310     LET SUM=SUM+VAL(ISBN$(I))+VAL(ISBN$(I+1))*3
320   NEXT
330   LET SUM=SUM+VAL(ISBN$(13))
340   IF MOD(SUM,10)=0 THEN LET ISBN=-1
350 END DEF


public static void main(){
        System.out.println(isISBN13("978-1734314502"));
        System.out.println(isISBN13("978-1734314509"));
        System.out.println(isISBN13("978-1788399081"));
        System.out.println(isISBN13("978-1788399083"));
    }
public static boolean isISBN13(String in){
        int pre = Integer.parseInt(in.substring(0,3));
        if (pre!=978)return false;
        String postStr = in.substring(4);
        if (postStr.length()!=10)return false;
        int post = Integer.parseInt(postStr);
        int sum = 38;
        for(int x = 0; x<10;x+=2)
        sum += (postStr.charAt(x)-48)*3 + ((postStr.charAt(x+1)-48));
        if(sum%10==0) return true;
        return false;
    }


def isbn_check:
  def digits: tostring | explode | map( select(. >= 48 and . <= 57) | [.] | implode | tonumber);
  def sum(s): reduce s as $x (null; . + $x);
  digits
  | . as $digits
  |      sum(range(0;length;2) | $digits[.]) as $one
  | (3 * sum(range(1;length;2) | $digits[.])) as $two
  | (($one+$two) % 10) == 0;

def testingcodes:
 ["978-1734314502", "978-1734314509",
  "978-1788399081", "978-1788399083"];

testingcodes[]
| "\(.): \(if isbn_check then "good" else "bad" end)"


function isbncheck(str)
    return sum(iseven(i) ? 3 * parse(Int, ch) : parse(Int, ch)
        for (i, ch) in enumerate(replace(str, r"\D" => ""))) % 10 == 0
end

const testingcodes = ["978-1734314502", "978-1734314509",
                      "978-1788399081", "978-1788399083"]

for code in testingcodes
    println(code, ": ", isbncheck(code) ? "good" : "bad")
end


fun isValidISBN13(text: String): Boolean {
    val isbn = text.replace(Regex("[- ]"), "")
    return isbn.length == 13 && isbn.map { it - '0' }
        .mapIndexed { index, value -> when (index % 2) { 0 -> value else -> 3 * value } }
        .sum() % 10 == 0
}


val .isbn13checkdigit = f(var .s) {
    .s = replace(.s, RE/[\- ]/)
    matching(re/^[0-9]{13}$/, .s) and
        fold(f{+}, map [_, f{x 3}], s2n .s) div 10
}

val .tests = h{
    "978-1734314502": true,
    "978-1734314509": false,
    "978-1788399081": true,
    "978-1788399083": false,
}

for .key of .tests {
    val .pass = .isbn13checkdigit(.key)
    write .key, ": ", if(.pass: "good"; "bad")
    writeln if(.pass == .tests[.key]: ""; " (ISBN-13 CHECK DIGIT TEST FAILED)")
}


function checkIsbn13(isbn)
    local count = 0
    local sum = 0
    for c in isbn:gmatch"." do
        if c == ' ' or c == '-' then
            -- skip
        elseif c < '0' or '9' < c then
            return false
        else
            local digit = c - '0'
            if (count % 2) > 0 then
                sum = sum + 3 * digit
            else
                sum = sum + digit
            end
            count = count + 1
        end
    end

    if count ~= 13 then
        return false
    end
    return (sum % 10) == 0
end

function test(isbn)
    if checkIsbn13(isbn) then
        print(isbn .. ": good")
    else
        print(isbn .. ": bad")
    end
end

function main()
    test("978-1734314502")
    test("978-1734314509")
    test("978-1788399081")
    test("978-1788399083")
end

main()


ClearAll[ValidISBNQ]
ValidISBNQ[iban_String] := Module[{i},
  i = StringReplace[iban, {" " -> "", "-" -> ""}];
  If[StringMatchQ[i, Repeated[DigitCharacter]],
   i = ToExpression /@ Characters[i];
   i[[2 ;; ;; 2]] *= 3;
   Mod[Total[i], 10] == 0
   ,
   False
   ]
  ]
ValidISBNQ["978-1734314502"]
ValidISBNQ["978-1734314509"]
ValidISBNQ["978-1788399081"]
ValidISBNQ["978-1788399083"]


MODULE ISBN;
FROM InOut IMPORT WriteString, WriteLn;
FROM Strings IMPORT Length;

PROCEDURE validISBN(s: ARRAY OF CHAR): BOOLEAN;
    VAR total, i, length: CARDINAL;
BEGIN
    total := 0;
    length := Length(s);
    IF (length # 14) OR (s[3] # '-') THEN
        RETURN FALSE;
    END;
    FOR i := 0 TO length-1 DO
        IF i # 3 THEN
            IF (s[i] < '0') OR (s[i] > '9') THEN
                RETURN FALSE;
            ELSIF (i < 3) AND (i MOD 2 = 1) OR (i > 3) AND (i MOD 2 = 0) THEN
                total := total + 3 * (ORD(s[i]) - ORD('0'));
            ELSE
                total := total + ORD(s[i]) - ORD('0');
            END;
        END;
    END;
    RETURN total MOD 10 = 0;
END validISBN;

PROCEDURE check(s: ARRAY OF CHAR);
BEGIN
    WriteString(s);
    WriteString(': ');
    IF validISBN(s) THEN
        WriteString('good');
    ELSE
        WriteString('bad');
    END;
    WriteLn;
END check;

BEGIN
    check('978-1734314502');
    check('978-1734314509');
    check('978-1788399081');
    check('978-1788399083');
END ISBN.


def checkIsbn13(isbn)
        // remove any hyphens or spaces
        isbn = str(isbn).replace("-","").replace(" ","")

        // check length = 13
        if len(isbn) != 13
                return false
        end

        // check only contains digits and calculate weighted sum
        sum = 0
        for i in range(0, len(isbn) - 1)
                c = isbn[i]
                if (ord(c) < ord("0")) or (ord(c) > ord("9"))
                        return false
                end

                if (i % 2) = 0
                        sum += ord(c) - ord("0")
                else
                        sum += 3 * (ord(c) - ord("0"))
                end
        end

        return (sum % 10) = 0
end

isbns = {"978-1734314502", "978-1734314509", "978-1788399081", "978-1788399083"}
for isbn in isbns
        res = "bad"
        if checkIsbn13(isbn)
                res = "good"
        end

        print format("%s: %s\n", isbn, res)
end


import strutils, strformat

func is_isbn*(s: string): bool =
  var sum, len: int
  for c in s:
    if is_digit(c):
      sum += (ord(c) - ord('0')) * (if len mod 2 == 0: 1 else: 3)
      len += 1
    elif c != ' ' and c != '-':
      return false
  return (len == 13) and (sum mod 10 == 0)

when is_main_module:
  let isbns = [ "978-1734314502", "978-1734314509",
                "978-1788399081", "978-1788399083" ]
  for isbn in isbns:
    var quality: string = if is_isbn(isbn): "good" else: "bad"
    echo &"{isbn}: {quality}"


program ISBNChecksum(output);

const
	codeIndexMaximum = 17;
	ISBNIndexMinimum = 1;
	ISBNIndexMaximum = 13;
	ISBNIndexRange = ISBNIndexMaximum - ISBNIndexMinimum + 1;

type
	code = string(codeIndexMaximum);
	codeIndex = 1..codeIndexMaximum value 1;
	decimalDigit = '0'..'9';
	decimalValue = 0..9;
	ISBNIndex = ISBNIndexMinimum..ISBNIndexMaximum;
	ISBN = array[ISBNIndex] of decimalDigit;

{ returns the integer value represented by a character }
function numericValue(protected c: decimalDigit): decimalValue;
begin
	{ in Pascal result variable bears the same name as the function }
	numericValue := ord(c) - ord('0')
end;

{ determines whether an ISBN is technically valid (checksum correct) }
function isValidISBN(protected n: ISBN): Boolean;
var
	sum: 0..225 value 0;
	i: ISBNIndex;
begin
	{ NB: in Pascal for-loop-limits are _inclusive_ }
	for i := ISBNIndexMinimum to ISBNIndexMaximum do
	begin
		{ alternating scale factor 3^0, 3^1 based on Boolean }
		sum := sum + numericValue(n[i]) * 3 pow ord(not odd(i))
	end;

	isValidISBN := sum mod 10 = 0
end;

{ transform '978-0-387-97649-5' into '9780387976495' }
function digits(n: code): code;
var
	sourceIndex, destinationIndex: codeIndex;
begin
	for sourceIndex := 1 to length(n) do
	begin
		if n[sourceIndex] in ['0'..'9'] then
		begin
			n[destinationIndex] := n[sourceIndex];
			destinationIndex := destinationIndex + 1
		end
	end;

	{ to alter a string’s length you need overwrite it completely }
	digits := subStr(n, 1, destinationIndex - 1)
end;

{ data type coercion }
function asISBN(protected n: code): ISBN;
var
	result: ISBN;
begin
	unpack(n[1..length(n)], result, 1);
	asISBN := result
end;

{ tells whether a string value contains a proper ISBN representation }
function isValidISBNString(protected hyphenatedForm: code): Boolean;
var
	digitOnlyForm: code;
begin
	digitOnlyForm := digits(hyphenatedForm);
	{ The Extended Pascal `and_then` Boolean operator allows us }
	{ to first check the length before invoking `isValidISBN`. }
	isValidISBNString := (length(digitOnlyForm) = ISBNIndexRange)
		and_then isValidISBN(asISBN(digitOnlyForm))
end;

{ === MAIN ============================================================= }
begin
	writeLn(isValidISBNString('978-1734314502'));
	writeLn(isValidISBNString('978-1734314509'));
	writeLn(isValidISBNString('978-1788399081'));
	writeLn(isValidISBNString('978-1788399083'))
end.