public func convertToUnicodeScalars(
  str: String,
  minChar: UInt32,
  maxChar: UInt32
) -> [UInt32] {
  var scalars = [UInt32]()

  for scalar in str.unicodeScalars {
    let val = scalar.value

    guard val >= minChar && val <= maxChar else {
      continue
    }

    scalars.append(val)
  }

  return scalars
}

public struct Vigenere {
  private let keyScalars: [UInt32]
  private let smallestScalar: UInt32
  private let largestScalar: UInt32
  private let sizeAlphabet: UInt32

  public init?(key: String, smallestCharacter: Character = "A", largestCharacter:  Character = "Z") {
    let smallScalars = smallestCharacter.unicodeScalars
    let largeScalars = largestCharacter.unicodeScalars

    guard smallScalars.count == 1, largeScalars.count == 1 else {
      return nil
    }

    self.smallestScalar = smallScalars.first!.value
    self.largestScalar = largeScalars.first!.value
    self.sizeAlphabet = (largestScalar - smallestScalar) + 1

    let scalars = convertToUnicodeScalars(str: key, minChar: smallestScalar, maxChar: largestScalar)

    guard !scalars.isEmpty else {
      return nil
    }

    self.keyScalars = scalars

  }

  public func decrypt(_ str: String) -> String? {
    let txtBytes = convertToUnicodeScalars(str: str, minChar: smallestScalar, maxChar: largestScalar)

    guard !txtBytes.isEmpty else {
      return nil
    }

    var res = ""

    for (i, c) in txtBytes.enumerated() where c >= smallestScalar && c <= largestScalar {
      guard let char =
        UnicodeScalar((c &+ sizeAlphabet &- keyScalars[i % keyScalars.count]) % sizeAlphabet &+ smallestScalar)
      else {
        return nil
      }

      res += String(char)
    }

    return res
  }

  public func encrypt(_ str: String) -> String? {
    let txtBytes = convertToUnicodeScalars(str: str, minChar: smallestScalar, maxChar: largestScalar)

    guard !txtBytes.isEmpty else {
      return nil
    }

    var res = ""

    for (i, c) in txtBytes.enumerated() where c >= smallestScalar && c <= largestScalar {
      guard let char =
        UnicodeScalar((c &+ keyScalars[i % keyScalars.count] &- 2 &* smallestScalar) % sizeAlphabet &+ smallestScalar)
      else {
        return nil
      }

      res += String(char)
    }

    return res
  }
}

let text = "Beware the Jabberwock, my son! The jaws that bite, the claws that catch!";
let key = "VIGENERECIPHER";
let cipher = Vigenere(key: key)!

print("Key: \(key)")
print("Plain Text: \(text)")

let encoded = cipher.encrypt(text.uppercased())!

print("Cipher Text: \(encoded)")

let decoded = cipher.decrypt(encoded)!

print("Decoded: \(decoded)")

print("\nLarger set:")

let key2 = "Vigenère cipher"
let text2 = "This is a ünicode string 😃"

let cipher2 = Vigenere(key: key2, smallestCharacter: " ", largestCharacter: "🛹")!

print("Key: \(key2)")
print("Plain Text: \(text2)")

let encoded2 = cipher2.encrypt(text2)!

print("Cipher Text: \(encoded2)")

let decoded2 = cipher2.decrypt(encoded2)!

print("Decoded: \(decoded2)")


package require Tcl 8.6

oo::class create Vigenere {
    variable key
    constructor {protoKey} {
	foreach c [split $protoKey ""] {
	    if {[regexp {[A-Za-z]} $c]} {
		lappend key [scan [string toupper $c] %c]
	    }
	}
    }

    method encrypt {text} {
	set out ""
	set j 0
	foreach c [split $text ""] {
	    if {[regexp {[^a-zA-Z]} $c]} continue
	    scan [string toupper $c] %c c
	    append out [format %c [expr {($c+[lindex $key $j]-130)%26+65}]]
	    set j [expr {($j+1) % [llength $key]}]
	}
	return $out
    }

    method decrypt {text} {
	set out ""
	set j 0
	foreach c [split $text ""] {
	    if {[regexp {[^A-Z]} $c]} continue
	    scan $c %c c
	    append out [format %c [expr {($c-[lindex $key $j]+26)%26+65}]]
	    set j [expr {($j+1) % [llength $key]}]
	}
	return $out
    }
}


@(next :args)
@(do
   (defun vig-op (plus-or-minus)
     (op + #\A [mod [plus-or-minus (- @1 #\A) (- @2 #\A)] 26]))

   (defun vig (msg key encrypt)
     (mapcar (vig-op [if encrypt + -]) msg (repeat key))))
@(coll)@{key /[A-Za-z]/}@(end)
@(coll)@{msg /[A-Za-z]/}@(end)
@(cat key "")
@(filter :upcase key)
@(cat msg "")
@(filter :upcase msg)
@(bind encoded @(vig msg key t))
@(bind decoded @(vig msg key nil))
@(bind check @(vig encoded key nil))
@(output)
text:  @msg
key:   @key
enc:   @encoded
dec:   @decoded
check: @check
@(end)


class Vigenere {

    key: string

    /** Create new cipher based on key */
    constructor(key: string) {
        this.key = Vigenere.formatText(key)
    }

    /** Enrypt a given text using key */
    encrypt(plainText: string): string {
        return Array.prototype.map.call(Vigenere.formatText(plainText), (letter: string, index: number): string => {
            return String.fromCharCode((letter.charCodeAt(0) + this.key.charCodeAt(index % this.key.length) - 130) % 26 + 65)
        }).join('')
    }

    /** Decrypt ciphertext based on key */
    decrypt(cipherText: string): string {
        return Array.prototype.map.call(Vigenere.formatText(cipherText), (letter: string, index: number): string => {
            return String.fromCharCode((letter.charCodeAt(0) - this.key.charCodeAt(index % this.key.length) + 26) % 26 + 65)
        }).join('')
    }

    /** Converts to uppercase and removes non characters */
    private static formatText(text: string): string {
        return text.toUpperCase().replace(/[^A-Z]/g, "")
    }

}

/** Example usage */
(() => {
    let original: string = "Lorem Ipsum is simply dummy text of the printing and typesetting industry. Lorem Ipsum has been the industry's standard dummy text ever since the 1500s, when an unknown printer took a galley of type and scrambled it to make a type specimen book."

    console.log(`Original: ${original}`)

    let vig: Vigenere = new Vigenere("vigenere")

    let encoded: string = vig.encrypt(original)

    console.log(`After encryption: ${encoded}`)

    let back: string = vig.decrypt(encoded)

    console.log(`After decryption: ${back}`)

})()


Option Explicit

Sub test()
Dim Encryp As String
   Encryp = Vigenere("Beware the Jabberwock, my son! The jaws that bite, the claws that catch!", "vigenerecipher", True)
   Debug.Print "Encrypt:= """ & Encryp & """"
   Debug.Print "Decrypt:= """ & Vigenere(Encryp, "vigenerecipher", False) & """"
End Sub

Private Function Vigenere(sWord As String, sKey As String, Enc As Boolean) As String
Dim bw() As Byte, bk() As Byte, i As Long, c As Long
Const sW As String = "ÁÂÃÄÅÇÈÉÊËÌÍÎÏÑÒÓÔÕÖÙÚÛÜÝ"
Const sWo As String = "AAAAACEEEEIIIINOOOOOUUUUY"
Const A As Long = 65
Const N As Long = 26

   c = Len(sKey)
   i = Len(sWord)
   sKey = Left(IIf(c < i, StrRept(sKey, (i / c) + 1), sKey), i)
   sKey = StrConv(sKey, vbUpperCase)         'Upper case
   sWord = StrConv(sWord, vbUpperCase)
   sKey = StrReplace(sKey, sW, sWo)          'Replace accented characters
   sWord = StrReplace(sWord, sW, sWo)
   sKey = RemoveChars(sKey)                  'Remove characters (numerics, spaces, comas, ...)
   sWord = RemoveChars(sWord)
   bk = CharToAscii(sKey)                     'To work with Bytes instead of String
   bw = CharToAscii(sWord)
   For i = LBound(bw) To UBound(bw)
      Vigenere = Vigenere & Chr((IIf(Enc, ((bw(i) - A) + (bk(i) - A)), ((bw(i) - A) - (bk(i) - A)) + N) Mod N) + A)
   Next i
End Function

Private Function StrRept(s As String, N As Long) As String
Dim j As Long, c As String
   For j = 1 To N
      c = c & s
   Next
   StrRept = c
End Function

Private Function StrReplace(s As String, What As String, By As String) As String
Dim t() As String, u() As String, i As Long
   t = SplitString(What)
   u = SplitString(By)
   StrReplace = s
   For i = LBound(t) To UBound(t)
      StrReplace = Replace(StrReplace, t(i), u(i))
   Next i
End Function

Private Function SplitString(s As String) As String()
   SplitString = Split(StrConv(s, vbUnicode), Chr(0))
End Function

Private Function RemoveChars(str As String) As String
Dim b() As Byte, i As Long
   b = CharToAscii(str)
   For i = LBound(b) To UBound(b)
      If b(i) >= 65 And b(i) <= 90 Then RemoveChars = RemoveChars & Chr(b(i))
   Next i
End Function

Private Function CharToAscii(s As String) As Byte()
   CharToAscii = StrConv(s, vbFromUnicode)
End Function


Function Encrypt(text,key)
	text = OnlyCaps(text)
	key = OnlyCaps(key)
	j = 1
	For i = 1 To Len(text)
		ms = Mid(text,i,1)
		m = Asc(ms) - Asc("A")
		ks = Mid(key,j,1)
		k = Asc(ks) - Asc("A")
		j = (j Mod Len(key)) + 1
		c = (m + k) Mod 26
		c = Chr(Asc("A")+c)
		Encrypt = Encrypt & c
	Next
End Function

Function Decrypt(text,key)
	key = OnlyCaps(key)
	j = 1
	For i = 1 To Len(text)
		ms = Mid(text,i,1)
		m = Asc(ms) - Asc("A")
		ks = Mid(key,j,1)
		k = Asc(ks) - Asc("A")
		j = (j Mod Len(key)) + 1
		c = (m - k + 26) Mod 26
		c = Chr(Asc("A")+c)
		Decrypt = Decrypt & c
	Next
End Function

Function OnlyCaps(s)
	For i = 1 To Len(s)
		char = UCase(Mid(s,i,1))
		If Asc(char) >= 65 And Asc(char) <= 90 Then
			OnlyCaps = OnlyCaps & char
		End If
	Next
End Function

'testing the functions
orig_text = "Beware the Jabberwock, my son! The jaws that bite, the claws that catch!"
orig_key = "vigenerecipher"
WScript.StdOut.WriteLine "Original: " & orig_text
WScript.StdOut.WriteLine "Key: " & orig_key
WScript.StdOut.WriteLine "Encrypted: " & Encrypt(orig_text,orig_key)
WScript.StdOut.WriteLine "Decrypted: " & Decrypt(Encrypt(orig_text,orig_key),orig_key)


Get_Input(10, "Key: ", STATLINE+NOCR)		// @10 = key
Reg_Copy_Block(11, Cur_Pos, EOL_Pos)		// @11 = copy of original text
EOL Ins_Newline
Ins_Text("Key = ") Reg_Ins(10) Ins_Newline

// Prepare the key into numeric registers #130..:
Buf_Switch(Buf_Free)
Reg_Ins(10)
Case_Upper_Block(0, Cur_Pos)
BOF
#2 = Reg_Size(10)				// #2 = key length
for (#3=130; #3 < 130+#2; #3++) {
    #@3 = Cur_Char
    Char(1)
}
Buf_Quit(OK)

Ins_Text("Encrypted: ")
#4 = Cur_Pos
Reg_Ins(11)					// copy of original text
Replace_Block("|!|A", "", #4, EOL_Pos, BEGIN+ALL+NOERR) // remove non-alpha chars
Case_Upper_Block(#4, EOL_Pos)			// convert to upper case
Goto_Pos(#4)
#1 = 1; Call("ENCRYPT_DECRYPT")			// Encrypt the line
Reg_Copy_Block(11, #4, Cur_Pos)			// Copy encrypted text text to next line
Ins_Newline
Ins_Text("Decrypted: ")
Reg_Ins(11, BEGIN)
#1 = -1; Call("ENCRYPT_DECRYPT")		// Decrypt the line

Return

// Encrypt or decrypt text on current line in-place, starting from cursor position.
//   in: #1 = direction (1=encrypt, -1=decrypt)
//       #2 = key length,  #130...#189 = the key
//
:ENCRYPT_DECRYPT:
    Num_Push(6,9)
    #6 = 0
    While (!At_EOL) {
       #7 = #6+130				// pointer to key array
       #8 = #@7					// get key character
       #9 = (Cur_Char + #8*#1 + 26) % 26 + 'A'	// decrypt/encrypt
       Ins_Char(#9, OVERWRITE)			// write the converted char
       #6 = (#6+1) % #2
    }
    Num_Pop(6,9)
Return


import "/str" for Char, Str

var vigenere = Fn.new { |text, key, encrypt|
    var t = encrypt ? Str.upper(text) : text
    var sb = ""
    var ki = 0
    for (c in t) {
        if (Char.isAsciiUpper(c)) {
            var ci = encrypt ? (c.bytes[0] + key[ki].bytes[0] - 130) % 26 :
                               (c.bytes[0] - key[ki].bytes[0] +  26) % 26
            sb = sb + Char.fromCode(ci + 65)
            ki = (ki + 1) % key.count
        }
    }
    return sb
}

var key = "VIGENERECIPHER"
var text = "Beware the Jabberwock, my son! The jaws that bite, the claws that catch!"
var encoded = vigenere.call(text, key, true)
System.print(encoded)
var decoded = vigenere.call(encoded, key, false)
System.print(decoded)


code ChIn=7, ChOut=8;
int  Neg, C, Len, I, Key;
char KeyWord(80);
[Neg:= false;                                   \skip to KEYWORD
repeat C:= ChIn(8);  if C=^- then Neg:= true;  until C>=^A & C<=^Z;
Len:= 0;                                        \read in KEYWORD
repeat KeyWord(Len):= C-^A;  Len:= Len+1;  C:= ChIn(8);  until C<^A ! C>^Z;
I:= 0;                                          \initialize cycling index
repeat  C:= ChIn(1);
        if C>=^a & C<=^z then C:= C-$20;        \capitalize
        if C>=^A & C<=^Z then                   \discard non-alphas
            [Key:= KeyWord(I);  I:= I+1;  if I>=Len then I:= 0;
            if Neg then Key:= -Key;             \decrypting?
            C:= C+Key;
            if C>^Z then C:= C-26
            else if C<^A then C:= C+26;
            ChOut(0, C);
            ];
until   C=$1A;  \EOF
ChOut(0, $1A);  \encrypted file must end with EOF otherwise the decode will hang
]


fcn encipher(src,key,is_encode){
   upperCase:=["A".."Z"].pump(String);
   src=src.toUpper().inCommon(upperCase);  // only uppercase
   key=key.toUpper().inCommon(upperCase).pump(List,"toAsc");

   const A="A".toAsc();
   klen:=Walker.cycle(key.len());  // 0,1,2,3,..,keyLen-1,0,1,2,3, ...
   src.pump(String,'wrap(c){ i:=klen.next(); c=c.toAsc();
      (A + ( if(is_encode) c - A + key[i] - A;
      	     else	   c - key[i] + 26 ) % 26).toChar()
   });
}


V MULTIPLICATION_TABLE = [[0, 1, 2, 3, 4, 5, 6, 7, 8, 9],
                          [1, 2, 3, 4, 0, 6, 7, 8, 9, 5],
                          [2, 3, 4, 0, 1, 7, 8, 9, 5, 6],
                          [3, 4, 0, 1, 2, 8, 9, 5, 6, 7],
                          [4, 0, 1, 2, 3, 9, 5, 6, 7, 8],
                          [5, 9, 8, 7, 6, 0, 4, 3, 2, 1],
                          [6, 5, 9, 8, 7, 1, 0, 4, 3, 2],
                          [7, 6, 5, 9, 8, 2, 1, 0, 4, 3],
                          [8, 7, 6, 5, 9, 3, 2, 1, 0, 4],
                          [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]]

V INV = [0, 4, 3, 2, 1, 5, 6, 7, 8, 9]

V PERMUTATION_TABLE = [[0, 1, 2, 3, 4, 5, 6, 7, 8, 9],
                       [1, 5, 7, 6, 2, 8, 3, 0, 9, 4],
                       [5, 8, 0, 3, 7, 9, 6, 1, 4, 2],
                       [8, 9, 1, 6, 0, 4, 3, 5, 2, 7],
                       [9, 4, 5, 3, 1, 2, 6, 8, 7, 0],
                       [4, 2, 8, 6, 5, 7, 3, 9, 0, 1],
                       [2, 7, 9, 3, 8, 0, 6, 4, 1, 5],
                       [7, 0, 4, 6, 9, 1, 3, 2, 5, 8]]

F verhoeffchecksum(n, validate = 1B, terse = 1B, verbose = 0B)
   ‘
    Calculate the Verhoeff checksum over `n`.
    Terse mode or with single argument: return True if valid (last digit is a correct check digit).
    If checksum mode, return the expected correct checksum digit.
    If validation mode, return True if last digit checks correctly.
   ’
   I verbose
      print(("\n"(I validate {‘Validation’} E ‘Check digit’))‘ ’(‘calculations for ’n":\n\n i  ni  p[i,ni] c\n------------------"))
   V (c, dig) = (0, Array(String(I validate {n} E 10 * n)))
   L(ni) reversed(dig)
      V i = L.index
      V p = :PERMUTATION_TABLE[i % 8][Int(ni)]
      c = :MULTIPLICATION_TABLE[c][p]
      I verbose
         print(f:‘{i:2}  {ni}      {p}    {c}’)

   I verbose & !validate
      print("\ninv("c‘) = ’:INV[c])
   I !terse
      print(I validate {"\nThe validation for '"n‘' is ’(I c == 0 {‘correct’} E ‘incorrect’)‘.’} E "\nThe check digit for '"n‘' is ’:INV[c]‘.’)
   R I validate {c == 0} E :INV[c]

L(n, va, t, ve) [(Int64(236), 0B, 0B, 1B),
                 (Int64(2363), 1B, 0B, 1B),
                 (Int64(2369), 1B, 0B, 1B),
                 (Int64(12345), 0B, 0B, 1B),
                 (Int64(123451), 1B, 0B, 1B),
                 (Int64(123459), 1B, 0B, 1B),
                 (Int64(123456789012), 0B, 0B, 0B),
                 (Int64(1234567890120), 1B, 0B, 0B),
                 (Int64(1234567890129), 1B, 0B, 0B)]
   verhoeffchecksum(n, va, t, ve)


cyc=: | +/[email protected]   NB. cyclic group, order y
ac=:  |(+-/[email protected]) NB. anticyclic group, order y
a2n=: (+#)@     NB. add 2^n
di=: (cyc,.cyc a2n),((ac a2n),.ac)

D=:   di 5
INV=: ,I.0=D
P=: {&(C.1 5 8 9 4 2 7 0;3 6)^:(i.8) i.10

verhoeff=: {{
  c=. 0
  for_N. |.10 #.inv y do.
    c=. D{~<c,P{~<(8|N_index),N
  end.
}}

traceverhoeff=: {{
  r=. EMPTY
  c=. 0
  for_N. |.10 #.inv y do.
    c0=. c
    c=. D{~<c,p=.P{~<(j=.8|N_index),N
    r=. r, c,p,j,N_index,N,c0
  end.
  labels=. cut 'cᵢ p[i,nᵢ] i nᵢ n cₒ'
  1 1}.}:~.":labels,(<;._1"1~[:*/' '=])' ',.":r
}}

checkdigit=: INV {~ [email protected]*&10
valid=: 0 = verhoeff


const multiplicationtable = [
    0  1  2  3  4  5  6  7  8  9;
    1  2  3  4  0  6  7  8  9  5;
    2  3  4  0  1  7  8  9  5  6;
    3  4  0  1  2  8  9  5  6  7;
    4  0  1  2  3  9  5  6  7  8;
    5  9  8  7  6  0  4  3  2  1;
    6  5  9  8  7  1  0  4  3  2;
    7  6  5  9  8  2  1  0  4  3;
    8  7  6  5  9  3  2  1  0  4;
    9  8  7  6  5  4  3  2  1  0]

const permutationtable = [
    0  1  2  3  4  5  6  7  8  9;
    1  5  7  6  2  8  3  0  9  4;
    5  8  0  3  7  9  6  1  4  2;
    8  9  1  6  0  4  3  5  2  7;
    9  4  5  3  1  2  6  8  7  0;
    4  2  8  6  5  7  3  9  0  1;
    2  7  9  3  8  0  6  4  1  5;
    7  0  4  6  9  1  3  2  5  8]

const inv = [0, 4, 3, 2, 1, 5, 6, 7, 8, 9]

"""
    verhoeffchecksum(n::Integer, validate=true, terse=true, verbose=false)

Calculate the Verhoeff checksum over `n`.
Terse mode or with single argument: return true if valid (last digit is a correct check digit).
If checksum mode, return the expected correct checksum digit.
If validation mode, return true if last digit checks correctly.
"""
function verhoeffchecksum(n::Integer, validate=true, terse=true, verbose=false)
    verbose && println("\n", validate ? "Validation" : "Check digit",
        " calculations for '$n':\n\n", " i  nᵢ  p[i,nᵢ]  c\n------------------")
    # transform number list
    c, dig = 0, reverse(digits(validate ? n : 10 * n))
    for i in length(dig):-1:1
        ni = dig[i]
        p = permutationtable[(length(dig) - i) % 8 + 1, ni + 1]
        c = multiplicationtable[c + 1, p + 1]
        verbose && println(lpad(length(dig) - i, 2), "  $ni      $p    $c")
    end
    verbose && !validate && println("\ninv($c) = $(inv[c + 1])")
    !terse && println(validate ? "\nThe validation for '$n' is $(c == 0 ?
        "correct" : "incorrect")." : "\nThe check digit for '$n' is $(inv[c + 1]).")
    return validate ? c == 0 : inv[c + 1]
end

for args in [(236, false, false, true), (2363, true, false, true), (2369, true, false, true),
    (12345, false, false, true), (123451, true, false, true), (123459, true, false, true),
    (123456789012, false, false), (1234567890120, true, false), (1234567890129, true, false)]
        verhoeffchecksum(args...)
end


import strformat

const

  D = [[0, 1, 2, 3, 4, 5, 6, 7, 8, 9],
       [1, 2, 3, 4, 0, 6, 7, 8, 9, 5],
       [2, 3, 4, 0, 1, 7, 8, 9, 5, 6],
       [3, 4, 0, 1, 2, 8, 9, 5, 6, 7],
       [4, 0, 1, 2, 3, 9, 5, 6, 7, 8],
       [5, 9, 8, 7, 6, 0, 4, 3, 2, 1],
       [6, 5, 9, 8, 7, 1, 0, 4, 3, 2],
       [7, 6, 5, 9, 8, 2, 1, 0, 4, 3],
       [8, 7, 6, 5, 9, 3, 2, 1, 0, 4],
       [9, 8, 7, 6, 5, 4, 3, 2, 1, 0]]

  Inv = [0, 4, 3, 2, 1, 5, 6, 7, 8, 9]

  P = [[0, 1, 2, 3, 4, 5, 6, 7, 8, 9],
       [1, 5, 7, 6, 2, 8, 3, 0, 9, 4],
       [5, 8, 0, 3, 7, 9, 6, 1, 4, 2],
       [8, 9, 1, 6, 0, 4, 3, 5, 2, 7],
       [9, 4, 5, 3, 1, 2, 6, 8, 7, 0],
       [4, 2, 8, 6, 5, 7, 3, 9, 0, 1],
       [2, 7, 9, 3, 8, 0, 6, 4, 1, 5],
       [7, 0, 4, 6, 9, 1, 3, 2, 5, 8]]

type Digit = 0..9

proc verhoeff[T: SomeInteger](n: T; validate, verbose = false): T =
  ## Compute or validate a check digit.
  ## Return the check digit if computation or the number with the check digit
  ## removed if validation.
  ## If not in verbose mode, an exception is raised if validation failed.

  doAssert n >= 0, "Argument must not be negative."

  # Extract digits.
  var digits: seq[Digit]
  if not validate: digits.add 0
  var val = n
  while val != 0:
    digits.add val mod 10
    val = val div 10

  if verbose:
    echo if validate: &"Check digit validation for {n}:" else: &"Check digit computation for {n}:"
    echo " i  ni  p(i, ni)  c"

  # Compute c.
  var c = 0
  for i, ni in digits:
    let p = P[i mod 8][ni]
    c = D[c][p]
    if verbose: echo &"{i:2}   {ni}     {p}      {c}"

  if validate:
    if verbose:
      let verb = if c == 0: "is" else: "is not"
      echo &"Validation {verb} successful.\n"
    elif c != 0:
      raise newException(ValueError, &"Check digit validation failed for {n}.")
    result = n div 10

  else:
    result = Inv[c]
    if verbose: echo &"The check digit for {n} is {result}.\n"

for n in [236, 12345]:
  let d = verhoeff(n, false, true)
  discard verhoeff(10 * n + d, true, true)
  discard verhoeff(10 * n + 9, true, true)

let n = 123456789012
let d = verhoeff(n)
echo &"Check digit for {n} is {d}."
discard verhoeff(10 * n + d, true)
echo &"Check digit validation was successful for {10 * n + d}."
try:
  discard verhoeff(10 * n + 9, true)
except ValueError:
  echo getCurrentExceptionMsg()


MULTIPLICATION_TABLE = [
    (0, 1, 2, 3, 4, 5, 6, 7, 8, 9),
    (1, 2, 3, 4, 0, 6, 7, 8, 9, 5),
    (2, 3, 4, 0, 1, 7, 8, 9, 5, 6),
    (3, 4, 0, 1, 2, 8, 9, 5, 6, 7),
    (4, 0, 1, 2, 3, 9, 5, 6, 7, 8),
    (5, 9, 8, 7, 6, 0, 4, 3, 2, 1),
    (6, 5, 9, 8, 7, 1, 0, 4, 3, 2),
    (7, 6, 5, 9, 8, 2, 1, 0, 4, 3),
    (8, 7, 6, 5, 9, 3, 2, 1, 0, 4),
    (9, 8, 7, 6, 5, 4, 3, 2, 1, 0),
]

INV = (0, 4, 3, 2, 1, 5, 6, 7, 8, 9)

PERMUTATION_TABLE = [
    (0, 1, 2, 3, 4, 5, 6, 7, 8, 9),
    (1, 5, 7, 6, 2, 8, 3, 0, 9, 4),
    (5, 8, 0, 3, 7, 9, 6, 1, 4, 2),
    (8, 9, 1, 6, 0, 4, 3, 5, 2, 7),
    (9, 4, 5, 3, 1, 2, 6, 8, 7, 0),
    (4, 2, 8, 6, 5, 7, 3, 9, 0, 1),
    (2, 7, 9, 3, 8, 0, 6, 4, 1, 5),
    (7, 0, 4, 6, 9, 1, 3, 2, 5, 8),
]

def verhoeffchecksum(n, validate=True, terse=True, verbose=False):
    """
    Calculate the Verhoeff checksum over `n`.
    Terse mode or with single argument: return True if valid (last digit is a correct check digit).
    If checksum mode, return the expected correct checksum digit.
    If validation mode, return True if last digit checks correctly.
    """
    if verbose:
        print(f"\n{'Validation' if validate else 'Check digit'}",\
            f"calculations for {n}:\n\n i  nᵢ  p[i,nᵢ]   c\n------------------")
    # transform number list
    c, dig = 0, list(str(n if validate else 10 * n))
    for i, ni in enumerate(dig[::-1]):
        p = PERMUTATION_TABLE[i % 8][int(ni)]
        c = MULTIPLICATION_TABLE[c][p]
        if verbose:
            print(f"{i:2}  {ni}      {p}    {c}")

    if verbose and not validate:
        print(f"\ninv({c}) = {INV[c]}")
    if not terse:
        print(f"\nThe validation for '{n}' is {'correct' if c == 0 else 'incorrect'}."\
              if validate else f"\nThe check digit for '{n}' is {INV[c]}.")
    return c == 0 if validate else INV[c]

if __name__ == '__main__':

    for n, va, t, ve in [
        (236, False, False, True), (2363, True, False, True), (2369, True, False, True),
        (12345, False, False, True), (123451, True, False, True), (123459, True, False, True),
        (123456789012, False, False, False), (1234567890120, True, False, False),
        (1234567890129, True, False, False)]:
        verhoeffchecksum(n, va, t, ve)


my @d = [^10] xx 5;
@d[$_][^5].=rotate($_), @d[$_][5..*].=rotate($_) for 1..4;
push @d: [@d[$_].reverse] for flat 1..4, 0;

my @i = 0,4,3,2,1,5,6,7,8,9;

my %h = flat (0,1,5,8,9,4,2,7,0).rotor(2 =>-1).map({.[0]=>.[1]}), 6=>3, 3=>6;
my @p = [^10],;
@p.push: [@p[*-1].map: {%h{$_}}] for ^7;

sub checksum (Int $int where * ≥ 0, :$verbose = True ) {
    my @digits = $int.comb;
    say "\nCheckdigit calculation for $int:";
    say " i  ni  p(i, ni)  c" if $verbose;
    my ($i, $p, $c) = 0 xx 3;
    say " $i   0      $p     $c" if $verbose;
    for @digits.reverse {
        ++$i;
        $p = @p[$i % 8][$_];
        $c = @d[$c; $p];
        say "{$i.fmt('%2d')}   $_      $p     $c" if $verbose;
    }
    say "Checkdigit: {@i[$c]}";
    +($int ~ @i[$c]);
}

sub validate (Int $int where * ≥ 0, :$verbose = True) {
    my @digits = $int.comb;
    say "\nValidation calculation for $int:";
    say " i  ni  p(i, ni)  c" if $verbose;
    my ($i, $p, $c) = 0 xx 3;
    for @digits.reverse {
        $p = @p[$i % 8][$_];
        $c = @d[$c; $p];
        say "{$i.fmt('%2d')}   $_      $p     $c" if $verbose;
        ++$i;
    }
    say "Checkdigit: {'in' if $c}correct";
}

## TESTING

for 236, 12345, 123456789012 -> $int {
    my $check = checksum $int, :verbose( $int.chars < 8 );
    validate $check, :verbose( $int.chars < 8 );
    validate +($check.chop ~ 9), :verbose( $int.chars < 8 );
}


V a = 12
V k1_factrl = 1.0
[Float] c
c.append(sqrt(2.0 * math:pi))
L(k) 1 .< a
   c.append(exp(a - k) * (a - k) ^ (k - 0.5) / k1_factrl)
   k1_factrl *= -k

F gamma_spounge(z)
   V accm = :c[0]
   L(k) 1 .< :a
      accm += :c[k] / (z + k)
   accm *= exp(-(z + :a)) * (z + :a) ^ (z + 0.5)
   R accm / z

F GammaInc_Q(a, x)
   V a1 = a - 1
   V a2 = a - 2
   F f0(t)
      R t ^ @a1 * exp(-t)

   F df0(t)
      R (@a1 - t) * t ^ @a2 * exp(-t)

   V y = a1
   L f0(y) * (x - y) > 2.0e-8 & y < x
      y += 0.3
   I y > x
      y = x

   V h = 3.0e-4
   V n = Int(y / h)
   h = y / n
   V hh = 0.5 * h
   V gamax = h * sum(((n - 1 .< -1).step(-1).map(j -> @h * j)).map(t -> @f0(t) + @hh * @df0(t)))

   R gamax / gamma_spounge(a)

F chi2UniformDistance(dataSet)
   V expected = sum(dataSet) * 1.0 / dataSet.len
   V cntrd = (dataSet.map(d -> d - @expected))
   R sum(cntrd.map(x -> x * x)) / expected

F chi2Probability(dof, distance)
   R 1.0 - GammaInc_Q(0.5 * dof, 0.5 * distance)

F chi2IsUniform(dataSet, significance)
   V dof = dataSet.len - 1
   V dist = chi2UniformDistance(dataSet)
   R chi2Probability(dof, dist) > significance

V dset1 = [199809, 200665, 199607, 200270, 199649]
V dset2 = [522573, 244456, 139979,  71531,  21461]

L(ds) (dset1, dset2)
   print(‘Data set: ’ds)
   V dof = ds.len - 1
   V distance = chi2UniformDistance(ds)
   print(‘dof: #. distance: #.4’.format(dof, distance), end' ‘ ’)
   V prob = chi2Probability(dof, distance)
   print(‘probability: #.4’.format(prob), end' ‘ ’)
   print(‘uniform?  ’(I chi2IsUniform(ds, 0.05) {‘Yes’} E ‘No’))


package Chi_Square is

   type Flt is digits 18;
   type Bins_Type is array(Positive range <>) of Natural;

   function Distance(Bins: Bins_Type) return Flt;

end Chi_Square;


#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#ifndef M_PI
#define M_PI 3.14159265358979323846
#endif

typedef double (* Ifctn)( double t);
/* Numerical integration method */
double Simpson3_8( Ifctn f, double a, double b, int N)
{
    int j;
    double l1;
    double h = (b-a)/N;
    double h1 = h/3.0;
    double sum = f(a) + f(b);

    for (j=3*N-1; j>0; j--) {
        l1 = (j%3)? 3.0 : 2.0;
        sum += l1*f(a+h1*j) ;
    }
    return h*sum/8.0;
}

#define A 12
double Gamma_Spouge( double z )
{
    int k;
    static double cspace[A];
    static double *coefs = NULL;
    double accum;
    double a = A;

    if (!coefs) {
        double k1_factrl = 1.0;
        coefs = cspace;
        coefs[0] = sqrt(2.0*M_PI);
        for(k=1; k<A; k++) {
            coefs[k] = exp(a-k) * pow(a-k,k-0.5) / k1_factrl;
            k1_factrl *= -k;
        }
    }

    accum = coefs[0];
    for (k=1; k<A; k++) {
        accum += coefs[k]/(z+k);
    }
    accum *= exp(-(z+a)) * pow(z+a, z+0.5);
    return accum/z;
}

double aa1;
double f0( double t)
{
    return  pow(t, aa1)*exp(-t);
}

double GammaIncomplete_Q( double a, double x)
{
    double y, h = 1.5e-2;  /* approximate integration step size */

    /* this cuts off the tail of the integration to speed things up */
    y = aa1 = a-1;
    while((f0(y) * (x-y) > 2.0e-8) && (y < x))   y += .4;
    if (y>x) y=x;

    return 1.0 - Simpson3_8( &f0, 0, y, (int)(y/h))/Gamma_Spouge(a);
}


import std.stdio, std.algorithm, std.mathspecial;

real x2Dist(T)(in T[] data) pure nothrow @safe @nogc {
    immutable avg = data.sum / data.length;
    immutable sqs = reduce!((a, b) => a + (b - avg) ^^ 2)(0.0L, data);
    return sqs / avg;
}

real x2Prob(in real dof, in real distance) pure nothrow @safe @nogc {
    return gammaIncompleteCompl(dof / 2, distance / 2);
}

bool x2IsUniform(T)(in T[] data, in real significance=0.05L)
pure nothrow @safe @nogc {
    return x2Prob(data.length - 1.0L, x2Dist(data)) > significance;
}

void main() {
    immutable dataSets = [[199809, 200665, 199607, 200270, 199649],
                          [522573, 244456, 139979,  71531,  21461]];
    writefln(" %4s %12s  %12s %8s   %s",
             "dof", "distance", "probability", "Uniform?", "dataset");
    foreach (immutable ds; dataSets) {
        immutable dof = ds.length - 1;
        immutable dist = ds.x2Dist;
        immutable prob = x2Prob(dof, dist);
        writefln("%4d %12.3f  %12.8f    %5s    %6s",
                 dof, dist, prob, ds.x2IsUniform ? "YES" : "NO", ds);
    }
}


defmodule Verify do
  defp gammaInc_Q(a, x) do
    a1 = a-1
    f0  = fn t -> :math.pow(t, a1) * :math.exp(-t) end
    df0 = fn t -> (a1-t) * :math.pow(t, a-2) * :math.exp(-t) end
    y = while_loop(f0, x, a1)
    n = trunc(y / 3.0e-4)
    h = y / n
    hh = 0.5 * h
    sum = Enum.reduce(n-1 .. 0, 0, fn j,sum ->
      t = h * j
      sum + f0.(t) + hh * df0.(t)
    end)
    h * sum / gamma_spounge(a, make_coef)
  end

  defp while_loop(f, x, y) do
    if f.(y)*(x-y) > 2.0e-8 and y < x, do: while_loop(f, x, y+0.3), else: min(x, y)
  end

  @a  12
  defp make_coef do
    coef0 = [:math.sqrt(2.0 * :math.pi)]
    {_, coef} = Enum.reduce([email protected], {1.0, coef0}, fn k,{k1_factrl,c} ->
      h = :math.exp(@a-k) * :math.pow(@a-k, k-0.5) / k1_factrl
      {-k1_factrl*k, [h | c]}
    end)
    Enum.reverse(coef) |> List.to_tuple
  end

  defp gamma_spounge(z, coef) do
    accm = Enum.reduce([email protected], elem(coef,0), fn k,res -> res + elem(coef,k) / (z+k) end)
    accm * :math.exp(-([email protected])) * :math.pow([email protected], z+0.5) / z
  end

  def chi2UniformDistance(dataSet) do
    expected = Enum.sum(dataSet) / length(dataSet)
    Enum.reduce(dataSet, 0, fn d,sum -> sum + (d-expected)*(d-expected) end) / expected
  end

  def chi2Probability(dof, distance) do
    1.0 - gammaInc_Q(0.5*dof, 0.5*distance)
  end

  def chi2IsUniform(dataSet, significance\\0.05) do
    dof = length(dataSet) - 1
    dist = chi2UniformDistance(dataSet)
    chi2Probability(dof, dist) > significance
  end
end

dsets = [ [ 199809, 200665, 199607, 200270, 199649 ],
          [ 522573, 244456, 139979,  71531,  21461 ] ]

Enum.each(dsets, fn ds ->
  IO.puts "Data set:#{inspect ds}"
  dof = length(ds) - 1
  IO.puts "  degrees of freedom: #{dof}"
  distance = Verify.chi2UniformDistance(ds)
  :io.fwrite "  distance:           ~.4f~n", [distance]
  :io.fwrite "  probability:        ~.4f~n", [Verify.chi2Probability(dof, distance)]
  :io.fwrite "  uniform?            ~s~n", [(if Verify.chi2IsUniform(ds), do: "Yes", else: "No")]
end)


module gsl_mini_bind_m

    use iso_c_binding
    implicit none
    private

    public :: p_value

    interface
        function gsl_cdf_chisq_q(x, nu) bind(c, name='gsl_cdf_chisq_Q')
            import
            real(c_double), value :: x
            real(c_double), value :: nu
            real(c_double) :: gsl_cdf_chisq_q
        end function gsl_cdf_chisq_q
    end interface

contains

    !> Get p-value from chi-square distribution
    real function p_value(x, df)
        real, intent(in) :: x
        integer, intent(in) :: df

        p_value = real(gsl_cdf_chisq_q(real(x, c_double), real(df, c_double)))

    end function p_value

end module gsl_mini_bind_m


package main

import (
    "fmt"
    "math"
)

type ifctn func(float64) float64

func simpson38(f ifctn, a, b float64, n int) float64 {
    h := (b - a) / float64(n)
    h1 := h / 3
    sum := f(a) + f(b)
    for j := 3*n - 1; j > 0; j-- {
        if j%3 == 0 {
            sum += 2 * f(a+h1*float64(j))
        } else {
            sum += 3 * f(a+h1*float64(j))
        }
    }
    return h * sum / 8
}

func gammaIncQ(a, x float64) float64 {
    aa1 := a - 1
    var f ifctn = func(t float64) float64 {
        return math.Pow(t, aa1) * math.Exp(-t)
    }
    y := aa1
    h := 1.5e-2
    for f(y)*(x-y) > 2e-8 && y < x {
        y += .4
    }
    if y > x {
        y = x
    }
    return 1 - simpson38(f, 0, y, int(y/h/math.Gamma(a)))
}

func chi2ud(ds []int) float64 {
    var sum, expected float64
    for _, d := range ds {
        expected += float64(d)
    }
    expected /= float64(len(ds))
    for _, d := range ds {
        x := float64(d) - expected
        sum += x * x
    }
    return sum / expected
}

func chi2p(dof int, distance float64) float64 {
    return gammaIncQ(.5*float64(dof), .5*distance)
}

const sigLevel = .05

func main() {
    for _, dset := range [][]int{
        {199809, 200665, 199607, 200270, 199649},
        {522573, 244456, 139979, 71531, 21461},
    } {
        utest(dset)
    }
}

func utest(dset []int) {
    fmt.Println("Uniform distribution test")
    var sum int
    for _, c := range dset {
        sum += c
    }
    fmt.Println(" dataset:", dset)
    fmt.Println(" samples:                      ", sum)
    fmt.Println(" categories:                   ", len(dset))

    dof := len(dset) - 1
    fmt.Println(" degrees of freedom:           ", dof)

    dist := chi2ud(dset)
    fmt.Println(" chi square test statistic:    ", dist)

    p := chi2p(dof, dist)
    fmt.Println(" p-value of test statistic:    ", p)

    sig := p < sigLevel
    fmt.Printf(" significant at %2.0f%% level?      %t\n", sigLevel*100, sig)
    fmt.Println(" uniform?                      ", !sig, "\n")
}


(import
  [scipy.stats [chisquare]]
  [collections [Counter]])

(defn uniform? [f repeats &optional [alpha .05]]
  "Call 'f' 'repeats' times and do a chi-squared test for uniformity
  of the resulting discrete distribution. Return false iff the
  null hypothesis of uniformity is rejected for the test with
  size 'alpha'."
  (<= alpha (second (chisquare
    (.values (Counter (take repeats (repeatedly f))))))))


require 'stats/base'

countCats=: #@~.                    NB. counts the number of unique items
getExpected=: #@] % [               NB. divides no of items by category count
getObserved=: #/[email protected]]                NB. counts frequency for each category
calcX2=: [: +/ *:@(getObserved - getExpected) % getExpected   NB. calculates test statistic
calcDf=: <:@[                       NB. calculates degrees of freedom for uniform distribution

NB.*isUniform v Tests (5%) whether y is uniformly distributed
NB. result is: boolean describing if distribution y is uniform
NB. y is: distribution to test
NB. x is: optionally specify number of categories possible
isUniform=: (countCats $: ]) : (0.95 > calcDf chisqcdf :: 1: calcX2)


import static java.lang.Math.pow;
import java.util.Arrays;
import static java.util.Arrays.stream;
import org.apache.commons.math3.special.Gamma;

public class Test {

    static double x2Dist(double[] data) {
        double avg = stream(data).sum() / data.length;
        double sqs = stream(data).reduce(0, (a, b) -> a + pow((b - avg), 2));
        return sqs / avg;
    }

    static double x2Prob(double dof, double distance) {
        return Gamma.regularizedGammaQ(dof / 2, distance / 2);
    }

    static boolean x2IsUniform(double[] data, double significance) {
        return x2Prob(data.length - 1.0, x2Dist(data)) > significance;
    }

    public static void main(String[] a) {
        double[][] dataSets = {{199809, 200665, 199607, 200270, 199649},
        {522573, 244456, 139979, 71531, 21461}};

        System.out.printf(" %4s %12s  %12s %8s   %s%n",
                "dof", "distance", "probability", "Uniform?", "dataset");

        for (double[] ds : dataSets) {
            int dof = ds.length - 1;
            double dist = x2Dist(ds);
            double prob = x2Prob(dof, dist);
            System.out.printf("%4d %12.3f  %12.8f    %5s    %6s%n",
                    dof, dist, prob, x2IsUniform(ds, 0.05) ? "YES" : "NO",
                    Arrays.toString(ds));
        }
    }
}


# v0.6

using Distributions

function eqdist(data::Vector{T}, α::Float64=0.05)::Bool where T <: Real
    if ! (0 ≤ α ≤ 1); error("α must be in [0, 1]") end
    exp = mean(data)
    chisqval = sum((x - exp) ^ 2 for x in data) / exp
    pval = ccdf(Chisq(2), chisqval)
    return pval > α
end

data1 = [199809, 200665, 199607, 200270, 199649]
data2 = [522573, 244456, 139979,  71531,  21461]

for data in (data1, data2)
    println("Data:\n$data")
    println("Hypothesis test: the original population is ", (eqdist(data) ? "" : "not "), "uniform.\n")
end


// version 1.1.51

typealias Func = (Double) -> Double

fun gammaLanczos(x: Double): Double {
    var xx = x
    val p = doubleArrayOf(
        0.99999999999980993,
      676.5203681218851,
    -1259.1392167224028,
      771.32342877765313,
     -176.61502916214059,
       12.507343278686905,
       -0.13857109526572012,
        9.9843695780195716e-6,
        1.5056327351493116e-7
    )
    val g = 7
    if (xx < 0.5) return Math.PI / (Math.sin(Math.PI * xx) * gammaLanczos(1.0 - xx))
    xx--
    var a = p[0]
    val t = xx + g + 0.5
    for (i in 1 until p.size) a += p[i] / (xx + i)
    return Math.sqrt(2.0 * Math.PI) * Math.pow(t, xx + 0.5) * Math.exp(-t) * a
}

fun integrate(a: Double, b: Double, n: Int, f: Func): Double {
    val h = (b - a) / n
    var sum = 0.0
    for (i in 0 until n) {
        val x = a + i * h
        sum += (f(x) + 4.0 * f(x + h / 2.0) + f(x + h)) / 6.0
    }
    return sum * h
}

fun gammaIncompleteQ(a: Double, x: Double): Double {
    val aa1 = a - 1.0
    fun f0(t: Double) = Math.pow(t, aa1) * Math.exp(-t)
    val h = 1.5e-2
    var y = aa1
    while ((f0(y) * (x - y) > 2.0e-8) && y < x) y += 0.4
    if (y > x) y = x
    return 1.0 - integrate(0.0, y, (y / h).toInt(), ::f0) / gammaLanczos(a)
}

fun chi2UniformDistance(ds: DoubleArray): Double {
    val expected = ds.average()
    val sum = ds.map { val x = it - expected; x * x }.sum()
    return sum / expected
}

fun chi2Probability(dof: Int, distance: Double) =
    gammaIncompleteQ(0.5 * dof, 0.5 * distance)

fun chiIsUniform(ds: DoubleArray, significance: Double):Boolean {
    val dof = ds.size - 1
    val dist = chi2UniformDistance(ds)
    return chi2Probability(dof, dist) > significance
}

fun main(args: Array<String>) {
    val dsets = listOf(
        doubleArrayOf(199809.0, 200665.0, 199607.0, 200270.0, 199649.0),
        doubleArrayOf(522573.0, 244456.0, 139979.0,  71531.0,  21461.0)
    )
    for (ds in dsets) {
        println("Dataset: ${ds.asList()}")
        val dist = chi2UniformDistance(ds)
        val dof = ds.size - 1
        print("DOF: $dof  Distance: ${"%.4f".format(dist)}")
        val prob = chi2Probability(dof, dist)
        print("  Probability: ${"%.6f".format(prob)}")
        val uniform = if (chiIsUniform(ds, 0.05)) "Yes" else "No"
        println("  Uniform? $uniform\n")
    }
}


discreteUniformDistributionQ[data_, {min_Integer, max_Integer}, confLevel_: .05] :=
If[$VersionNumber >= 8,
  confLevel <= PearsonChiSquareTest[data, DiscreteUniformDistribution[{min, max}]],
  Block[{v, k = max - min, n = [email protected]},
   v = (k + 1) (Plus @@ (((Length /@ Split[[email protected]]))^2))/n - n;
   GammaRegularized[k/2, 0, v/2] <= 1 - confLevel]]

discreteUniformDistributionQ[data_] :=discreteUniformDistributionQ[data, data[[Ordering[data][[{1, -1}]]]]]


import lenientops, math, stats, strformat, sugar

func simpson38(f: (float) -> float; a, b: float; n: int): float =
  let h = (b - a) / n
  let h1 = h / 3
  var sum = f(a) + f(b)
  for i in countdown(3 * n - 1, 1):
    if i mod 3 == 0:
      sum += 2 * f(a + h1 * i)
    else:
      sum += 3 * f(a + h1 * i)
  result = h * sum / 8

func gammaIncQ(a, x: float): float =
  let aa1 = a - 1
  func f(t: float): float = pow(t, aa1) * exp(-t)
  var y = aa1
  let h = 1.5e-2
  while f(y) * (x - y) > 2e-8 and y < x:
    y += 0.4
  if y > x: y = x
  result = 1 - simpson38(f, 0, y, (y / h / gamma(a)).toInt)

func chi2ud(ds: openArray[int]): float =
  let expected = mean(ds)
  var s = 0.0
  for d in ds:
    let x = d.toFloat - expected
    s += x * x
  result = s / expected

func chi2p(dof: int; distance: float): float =
  gammaIncQ(0.5 * dof, 0.5 * distance)

const SigLevel = 0.05

proc utest(dset: openArray[int]) =

  echo "Uniform distribution test"
  let s = sum(dset)
  echo " dataset:", dset
  echo " samples:                      ", s
  echo " categories:                   ", dset.len

  let dof = dset.len - 1
  echo " degrees of freedom:           ", dof

  let dist = chi2ud(dset)
  echo " chi square test statistic:    ", dist

  let p = chi2p(dof, dist)
  echo " p-value of test statistic:    ", p

  let sig = p < SigLevel
  echo &" significant at {int(SigLevel * 100)}% level?      {sig}"
  echo &" uniform?                      {not sig}\n"

for dset in [[199809, 200665, 199607, 200270, 199649],
             [522573, 244456, 139979, 71531, 21461]]:
  utest(dset)


let sqr x = x *. x

let chi2UniformDistance distrib =
  let count, len = Array.fold_left (fun (s, c) e -> s + e, succ c)
  				   (0, 0) distrib in
  let expected = float count /. float len in
  let distance = Array.fold_left (fun s e ->
    s +. sqr (float e -. expected) /. expected
  ) 0. distrib in
  let dof = float (pred len) in
  dof, distance

let chi2Proba dof distance =
  Gsl_sf.gamma_inc_Q (0.5 *. dof) (0.5 *. distance)

let chi2IsUniform distrib significance =
  let dof, distance = chi2UniformDistance distrib in
  let likelihoodOfRandom = chi2Proba dof distance in
  likelihoodOfRandom > significance

let _ =
  List.iter (fun distrib ->
    let dof, distance = chi2UniformDistance distrib in
    Printf.printf "distribution ";
    Array.iter (Printf.printf "\t%d") distrib;
    Printf.printf "\tdistance %g" distance;
    Printf.printf "\t[%g > 0.05]" (chi2Proba dof distance);
    if chi2IsUniform distrib 0.05 then Printf.printf " fair\n"
    else Printf.printf " unfair\n"
  )
  [
    [| 199809; 200665; 199607; 200270; 199649 |];
    [| 522573; 244456; 139979; 71531; 21461 |]
  ]


cumChi2(chi2,dof)={
	my(g=gamma(dof/2));
	incgam(dof/2,chi2/2,g)/g
};
test(v,alpha=.05)={
	my(chi2,p,s=sum(i=1,#v,v[i]),ave=s/#v);
	print("chi^2 statistic: ",chi2=sum(i=1,#v,(v[i]-ave)^2)/ave);
	print("p-value: ",p=cumChi2(chi2,#v-1));
	if(p<alpha,
		print("Significant at the alpha = "alpha" level: not uniform");
	,
		print("Not significant at the alpha = "alpha" level: uniform");
	)
};

test([199809, 200665, 199607, 200270, 199649])
test([522573, 244456, 139979, 71531, 21461])


use List::Util qw(sum reduce);
use constant pi => 3.14159265;

sub incomplete_G_series {
    my($s, $z) = @_;
    my $n = 10;
    push @numers, $z**$_ for 1..$n;
    my @denoms = $s+1;
    push @denoms, $denoms[-1]*($s+$_) for 2..$n;
    my $M = 1;
    $M += $numers[$_-1]/$denoms[$_-1] for 1..$n;
    $z**$s / $s * exp(-$z) * $M;
}

sub G_of_half {
    my($n) = @_;
    if ($n % 2) { f(2*$_) / (4**$_ * f($_)) * sqrt(pi) for int ($n-1) / 2 }
    else        { f(($n/2)-1) }
}

sub f { reduce { $a * $b } 1, 1 .. $_[0] } # factorial

sub chi_squared_cdf {
    my($k, $x) = @_;
    my $f = $k < 20 ? 20 : 10;
    if ($x == 0)                  { 0.0 }
    elsif ($x < $k + $f*sqrt($k)) { incomplete_G_series($k/2, $x/2) / G_of_half($k) }
    else                          { 1.0 }
}
sub chi_squared_test {
    my(@bins) = @_;
    $significance = 0.05;
    my $n = @bins;
    my $N = sum @bins;
    my $expected = $N / $n;
    my $chi_squared = sum map { ($_ - $expected)**2 / $expected } @bins;
    my $p_value = 1 - chi_squared_cdf($n-1, $chi_squared);
    return $chi_squared, $p_value, $p_value > $significance ? 'True' : 'False';
}

for $dataset ([199809, 200665, 199607, 200270, 199649], [522573, 244456, 139979, 71531, 21461]) {
    printf "C2 = %10.3f, p-value = %.3f, uniform = %s\n", chi_squared_test(@$dataset);
}


with javascript_semantics
function f(atom aa1, t)
    return power(t, aa1) * exp(-t)
end function

function simpson38(atom aa1, a, b, integer n)
    atom h := (b-a)/n,
         h1 := h/3,
         tot := f(aa1,a) + f(aa1,b)
    for j=3*n-1 to 1 by -1 do
        tot += (3-(mod(j,3)=0)) * f(aa1,a+h1*j)
    end for
    return h*tot/8
end function

--<copy of gamma from Gamma_function#Phix>
sequence c = repeat(0,12)

function gamma(atom z)
    atom accm = c[1]
    if accm=0 then
        accm = sqrt(2*PI)
        c[1] = accm
        atom k1_factrl = 1  -- (k - 1)!*(-1)^k with 0!==1
        for k=2 to 12 do
            c[k] = exp(13-k)*power(13-k,k-1.5)/k1_factrl
            k1_factrl *= -(k-1)
        end for
    end if
    for k=2 to 12 do
        accm += c[k]/(z+k-1)
    end for
    accm *= exp(-(z+12))*power(z+12,z+0.5) -- Gamma(z+1)
    return accm/z
end function
--</copy of gamma>

function gammaIncQ(atom a, x)
    atom aa1 := a-1,
         y := aa1,
         h := 1.5e-2
    while f(aa1,y)*(x-y) > 2e-8 and y < x do
        y += 0.4
    end while
    if y > x then y = x end if
    return 1 - simpson38(aa1,0,y,floor(y/h/gamma(a)))
end function

function chi2ud(sequence ds)
    atom expected = sum(ds)/length(ds),
         tot = sum(sq_power(sq_sub(ds,expected),2))
    return tot/expected
end function

function chi2p(integer dof, atom distance)
    return gammaIncQ(0.5*dof,0.5*distance)
end function

constant sigLevel = 0.05

procedure utest(sequence dset)
    printf(1,"Uniform distribution test\n")
    integer tot = sum(dset),
            dof := length(dset)-1
    atom dist := chi2ud(dset),
         p := chi2p(dof, dist)
    bool sig := p < sigLevel
    printf(1," dataset: %v\n",{dset})
    printf(1," samples:                   %d\n", tot)
    printf(1," categories:                %d\n", length(dset))
    printf(1," degrees of freedom:        %d\n", dof)
    printf(1," chi square test statistic: %g\n", dist)
    printf(1," p-value of test statistic: %g\n", p)
    printf(1," significant at %.0f%% level?   %t\n", {sigLevel*100, sig})
    printf(1," uniform?                   %t\n",not sig)
end procedure

utest({199809, 200665, 199607, 200270, 199649})
utest({522573, 244456, 139979, 71531, 21461})


import math
import random

def GammaInc_Q( a, x):
    a1 = a-1
    a2 = a-2
    def f0( t ):
        return t**a1*math.exp(-t)

    def df0(t):
        return (a1-t)*t**a2*math.exp(-t)

    y = a1
    while f0(y)*(x-y) >2.0e-8 and y < x: y += .3
    if y > x: y = x

    h = 3.0e-4
    n = int(y/h)
    h = y/n
    hh = 0.5*h
    gamax = h * sum( f0(t)+hh*df0(t) for t in ( h*j for j in xrange(n-1, -1, -1)))

    return gamax/gamma_spounge(a)

c = None
def gamma_spounge( z):
    global c
    a = 12

    if c is None:
       k1_factrl = 1.0
       c = []
       c.append(math.sqrt(2.0*math.pi))
       for k in range(1,a):
          c.append( math.exp(a-k) * (a-k)**(k-0.5) / k1_factrl )
          k1_factrl *= -k

    accm = c[0]
    for k in range(1,a):
        accm += c[k] / (z+k)
    accm *= math.exp( -(z+a)) * (z+a)**(z+0.5)
    return accm/z;

def chi2UniformDistance( dataSet ):
    expected = sum(dataSet)*1.0/len(dataSet)
    cntrd = (d-expected for d in dataSet)
    return sum(x*x for x in cntrd)/expected

def chi2Probability(dof, distance):
    return 1.0 - GammaInc_Q( 0.5*dof, 0.5*distance)

def chi2IsUniform(dataSet, significance):
    dof = len(dataSet)-1
    dist = chi2UniformDistance(dataSet)
    return chi2Probability( dof, dist ) > significance

dset1 = [ 199809, 200665, 199607, 200270, 199649 ]
dset2 = [ 522573, 244456, 139979,  71531,  21461 ]

for ds in (dset1, dset2):
    print "Data set:", ds
    dof = len(ds)-1
    distance =chi2UniformDistance(ds)
    print "dof: %d distance: %.4f" % (dof, distance),
    prob = chi2Probability( dof, distance)
    print "probability: %.4f"%prob,
    print "uniform? ", "Yes"if chi2IsUniform(ds,0.05) else "No"


dset1=c(199809,200665,199607,200270,199649)
dset2=c(522573,244456,139979,71531,21461)

chi2IsUniform<-function(dataset,significance=0.05){
  chi2IsUniform=(chisq.test(dataset)$p.value>significance)
}

for (ds in list(dset1,dset2)){
  print(c("Data set:",ds))
  print(chisq.test(ds))
  print(paste("uniform?",chi2IsUniform(ds)))
}


#lang racket
(require
 racket/flonum (planet williams/science:4:5/science)
 (only-in (planet williams/science/unsafe-ops-utils) real->float))

; (chi^2-goodness-of-fit-test observed expected df)
;  Given:   observed, a sequence of observed frequencies
;           expected, a sequence of expected frequencies
;           df,       the degrees of freedom
;  Result:  P-value  = 1-chi^2cdf(X^2,df) , the p-value
(define (chi^2-goodness-of-fit-test observed expected df)
  (define X^2 (for/sum ([o observed] [e expected])
                (/ (sqr (- o e)) e)))
  (- 1.0 (chi-squared-cdf X^2 df)))

(define (is-uniform? rand n α)
  ; Use significance level α to test whether
  ; n small random numbers generated by rand
  ; have a uniform distribution.

  ; Observed values:
  (define o (make-vector 10 0))
  ; generate n random integers from 0 to 9.
  (for ([_ (+ n 1)])
    (define r (rand 10))
    (vector-set! o r (+ (vector-ref o r) 1)))
  ; Expected values:
  (define ex (make-vector 10 (/ n 10)))

  ; Calculate the P-value:
  (define P (chi^2-goodness-of-fit-test o ex (- n 1)))

  ; If the P-value is larger than α we accept the
  ; hypothesis that the numbers are distributed uniformly.
  (> P α))

; Test whether the builtin generator is uniform:
(is-uniform? random 1000 0.05)
; Test whether the constant generator fails:
(is-uniform? (λ(_) 5) 1000 0.05)


sub incomplete-γ-series($s, $z) {
    my \numers = $z X** 1..*;
    my \denoms = [\*] $s X+ 1..*;
    my $M = 1 + [+] (numers Z/ denoms) ... * < 1e-6;
    $z**$s / $s * exp(-$z) * $M;
}

sub postfix:<!>(Int $n) { [*] 2..$n }

sub Γ-of-half(Int $n where * > 0) {
    ($n %% 2) ?? (($_-1)!                            given  $n    div 2)
              !! ((2*$_)! / (4**$_ * $_!) * sqrt(pi) given ($n-1) div 2);
}

# degrees of freedom constrained due to numerical limitations
sub chi-squared-cdf(Int $k where 1..200, $x where * >= 0) {
    my $f = $k < 20 ?? 20 !! 10;
    given $x {
        when 0                    { 0.0 }
        when * < $k + $f*sqrt($k) { incomplete-γ-series($k/2, $x/2) / Γ-of-half($k) }
        default                   { 1.0 }
    }
}

sub chi-squared-test(@bins, :$significance = 0.05) {
    my $n = +@bins;
    my $N = [+] @bins;
    my $expected = $N / $n;
    my $chi-squared = [+] @bins.map: { ($^bin - $expected)**2 / $expected }
    my $p-value = 1 - chi-squared-cdf($n-1, $chi-squared);
    return (:$chi-squared, :$p-value, :uniform($p-value > $significance));
}

for [< 199809 200665 199607 200270 199649 >],
    [< 522573 244456 139979  71531  21461 >]
    -> $dataset
{
    my %t = chi-squared-test($dataset);
    say 'data: ', $dataset;
    say "χ² = {%t<chi-squared>}, p-value = {%t<p-value>.fmt('%.4f')}, uniform = {%t<uniform>}";
}


/*REXX program performs a chi─squared test to verify a given distribution is uniform.   */
numeric digits length( pi() )  - length(.)       /*enough decimal digs for calculations.*/
@.=;                                        @.1= 199809 200665 199607 200270 199649
                                            @.2= 522573 244456 139979  71531  21461
        do s=1  while @.s\=='';  call uTest @.s  /*invoke  uTest with a data set of #'s.*/
        end   /*s*/
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
!:      procedure; parse arg x;  p=1;    do j=2  to x;   p= p*j;   end  /*j*/;    return p
chi2p:  procedure;  parse arg dof, distance;       return gammaI( dof/2,  distance/2 )
f:      parse arg t;   if t=0  then return 0;      return t ** (a-1)    *    exp(-t)
e:      e =2.718281828459045235360287471352662497757247093699959574966967627724; return e
pi:     pi=3.141592653589793238462643383279502884197169399375105820974944592308; return pi
/*──────────────────────────────────────────────────────────────────────────────────────*/
!!:     procedure; parse arg x;                   if x<2  then return 1;    p= x
                     do k=2+x//2  to x-1  by 2;   p= p*k;   end  /*k*/;          return p
/*──────────────────────────────────────────────────────────────────────────────────────*/
chi2ud: procedure: parse arg ds; sum=0;                       expect= 0
                                       do j=1  for words(ds); expect= expect + word(ds, j)
                                       end   /*j*/
        expect = expect / words(ds)
                                       do k=1  for words(ds)
                                       sum= sum   +   (word(ds, k) - expect) **2
                                       end   /*k*/
        return sum / expect
/*──────────────────────────────────────────────────────────────────────────────────────*/
exp:    procedure; parse arg x; ix= x%1;  if abs(x-ix)>.5  then ix= ix + sign(x);  x= x-ix
        z=1; _=1; w=z;    do j=1;  _= _*x/j;  z= (z + _)/1;  if z==w  then leave;      w=z
                          end  /*j*/;         if z\==0  then z= z * e()**ix;      return z
/*──────────────────────────────────────────────────────────────────────────────────────*/
gamma:  procedure; parse arg x; if datatype(x, 'W')  then return !(x-1) /*Int?  Use fact*/
        n= trunc(x)                     /*at this point, X is pos and a multiple of 1/2.*/
        d= !!(n+n - 1)                  /*compute the double factorial of:    2*n - 1.  */
        if n//2  then p= -1             /*if  N  is  odd,   then use a negative unity.  */
                 else p=  1             /*if  N  is even,   then use a positive unity.  */
        if x>0   then return p * d * sqrt(pi()) / (2**n)
                      return p * (2**n) * sqrt(pi()) / d
/*──────────────────────────────────────────────────────────────────────────────────────*/
gammaI: procedure; parse arg a,x;  y= a-1;   do  while f(y)*(x-y) > 2e-8 & y<x;  y= y + .4
                                             end  /*while*/
        y= min(x, y)
        return 1   -   simp38(0, y,   y / 0.015 / gamma(a-1) % 1)
/*──────────────────────────────────────────────────────────────────────────────────────*/
simp38: procedure; parse arg a, b, n;                h= (b-a) / n;        h1= h / 3
        sum= f(a) + f(b)
                             do j=3*n-1   by -1   while j>0
                             if j//3 == 0  then sum= sum   +   2 * f(a + h1*j)
                                           else sum= sum   +   3 * f(a + h1*j)
                             end   /*j*/
        return h * sum / 8
/*──────────────────────────────────────────────────────────────────────────────────────*/
sqrt:   procedure; parse arg x;  if x=0  then return 0; d=digits(); numeric digits; h= d+6
        numeric form; m.=9; parse value format(x,2,1,,0) 'E0' with g "E" _ .;g=g *.5'e'_%2
          do j=0  while h>9;      m.j=h;               h=h%2+1;       end  /*j*/
          do k=j+5  to 0  by -1;  numeric digits m.k;  g=(g+x/g)*.5;  end  /*k*/; return g
/*──────────────────────────────────────────────────────────────────────────────────────*/
uTest:  procedure; parse arg dset;  sum= 0;   pad= left('', 11);      sigLev= 1/20  /*5%*/
        say;   say '     '   center(" Uniform distribution test ", 75, '═')
        #= words(dset);                                              sigPC= sigLev*100/1
                             do j=1  for #;      sum= sum  +  word(dset, j)
                             end   /*j*/
                  say pad "                  dataset: "  dset
                  say pad "                  samples: "  sum
                  say pad "               categories: "  #
                  say pad "       degrees of freedom: "  # - 1
        dist= chi2ud(dset)
        P= chi2p(# - 1,  dist)
        sig = (abs(P) < dist * sigLev)
                  say pad "significant at " sigPC'%  level? '  word('no yes',    sig  + 1)
                  say pad "   is the dataset uniform? "        word('no yes', (\(sig))+ 1)
        return


def gammaInc_Q(a, x)
  a1, a2 = a-1, a-2
  f0  = lambda {|t| t**a1 * Math.exp(-t)}
  df0 = lambda {|t| (a1-t) * t**a2 * Math.exp(-t)}

  y = a1
  y += 0.3  while f0[y]*(x-y) > 2.0e-8 and y < x
  y = x  if y > x

  h = 3.0e-4
  n = (y/h).to_i
  h = y/n
  hh = 0.5 * h
  sum = 0
  (n-1).step(0, -1) do |j|
    t = h * j
    sum += f0[t] + hh * df0[t]
  end
  h * sum / gamma_spounge(a)
end

A = 12
k1_factrl = 1.0
coef = [Math.sqrt(2.0*Math::PI)]
COEF = (1...A).each_with_object(coef) do |k,c|
  c << Math.exp(A-k) * (A-k)**(k-0.5) / k1_factrl
  k1_factrl *= -k
end

def gamma_spounge(z)
  accm = (1...A).inject(COEF[0]){|res,k| res += COEF[k] / (z+k)}
  accm * Math.exp(-(z+A)) * (z+A)**(z+0.5) / z
end

def chi2UniformDistance(dataSet)
  expected = dataSet.inject(:+).to_f / dataSet.size
  dataSet.map{|d|(d-expected)**2}.inject(:+) / expected
end

def chi2Probability(dof, distance)
  1.0 - gammaInc_Q(0.5*dof, 0.5*distance)
end

def chi2IsUniform(dataSet, significance=0.05)
  dof = dataSet.size - 1
  dist = chi2UniformDistance(dataSet)
  chi2Probability(dof, dist) > significance
end

dsets = [ [ 199809, 200665, 199607, 200270, 199649 ],
          [ 522573, 244456, 139979,  71531,  21461 ] ]

for ds in dsets
  puts "Data set:#{ds}"
  dof = ds.size - 1
  puts "  degrees of freedom: %d" % dof
  distance = chi2UniformDistance(ds)
  puts "  distance:           %.4f" % distance
  puts "  probability:        %.4f" % chi2Probability(dof, distance)
  puts "  uniform?            %s" % (chi2IsUniform(ds) ? "Yes" : "No")
end


use statrs::function::gamma::gamma_li;

fn chi_distance(dataset: &[u32]) -> f64 {
    let expected = f64::from(dataset.iter().sum::<u32>()) / dataset.len() as f64;
    dataset
        .iter()
        .fold(0., |acc, &elt| acc + (elt as f64 - expected).powf(2.))
        / expected
}

fn chi2_probability(dof: f64, distance: f64) -> f64 {
    1. - gamma_li(dof * 0.5, distance * 0.5)
}

fn chi2_uniform(dataset: &[u32], significance: f64) -> bool {
    let d = chi_distance(&dataset);
    chi2_probability(dataset.len() as f64 - 1., d) > significance
}

fn main() {
    let dsets = vec![
        vec![199809, 200665, 199607, 200270, 199649],
        vec![522573, 244456, 139979, 71531, 21461],
    ];

    for ds in dsets {
        println!("Data set: {:?}", ds);
        let d = chi_distance(&ds);
        print!("Distance: {:.6} ", d);
        print!(
            "Chi2 probability: {:.6} ",
            chi2_probability(ds.len() as f64 - 1., d)
        );
        print!("Uniform? {}\n", chi2_uniform(&ds, 0.05));
    }
}


import org.apache.commons.math3.special.Gamma.regularizedGammaQ

object ChiSquare extends App {
  private val dataSets: Seq[Seq[Double]] =
    Seq(
      Seq(199809, 200665, 199607, 200270, 199649),
      Seq(522573, 244456, 139979, 71531, 21461)
    )

  private def χ2IsUniform(data: Seq[Double], significance: Double) =
    χ2Prob(data.size - 1.0, χ2Dist(data)) > significance

  private def χ2Dist(data: Seq[Double]) = {
    val avg = data.sum / data.size

    data.reduce((a, b) => a + math.pow(b - avg, 2)) / avg
  }

  private def χ2Prob(dof: Double, distance: Double) =
    regularizedGammaQ(dof / 2, distance / 2)

  printf(" %4s %10s  %12s %8s   %s%n",
    "d.f.", "χ²distance", "χ²probability", "Uniform?", "dataset")
  dataSets.foreach { ds =>
    val (dist, dof) = (χ2Dist(ds), ds.size - 1)

    printf("%4d %11.3f  %13.8f    %5s    %6s%n",
      dof, dist, χ2Prob(dof.toDouble, dist), if (χ2IsUniform(ds, 0.05)) "YES" else "NO", ds.mkString(", "))
  }
}


# Confluent hypergeometric function of the first kind F_1(a;b;z)
func F1(a, b, z, limit=100) {
    sum(0..limit, {|k|
        rising_factorial(a, k) / rising_factorial(b, k) * z**k / k!
    })
}

func γ(a,x) {    # lower incomplete gamma function γ(a,x)
    #a**(-1) * x**a * F1(a, a+1, -x)            # simpler formula
    a**(-1) * x**a * exp(-x) * F1(1, a+1, x)    # slightly better convergence
}

func P(a,z) {    # regularized gamma function P(a,z)
    γ(a,z) / Γ(a)
}

func chi_squared_cdf (k, x) {
    var f = (k<20 ? 20 : 10)
    given(x) {
        when (0) { 0 }
        case (. < (k + f*sqrt(k))) { P(k/2, x/2) }
        else { 1 }
    }
}

func chi_squared_test(arr, significance = 0.05) {
    var n = arr.len
    var N = arr.sum
    var expected = N/n
    var χ_squared = arr.sum_by {|v| (v-expected)**2 / expected }
    var p_value = (1 - chi_squared_cdf(n-1, χ_squared))
    [χ_squared, p_value, p_value > significance]
}

[
    %n< 199809 200665 199607 200270 199649 >,
    %n< 522573 244456 139979  71531  21461 >,
].each {|dataset|
    var r = chi_squared_test(dataset)
    say "data: #{dataset}"
    say "χ² = #{r[0]}, p-value = #{r[1].round(-4)}, uniform = #{r[2]}\n"
}


package require Tcl 8.5
package require math::statistics

proc isUniform {distribution {significance 0.05}} {
    set count [tcl::mathop::+ {*}[dict values $distribution]]
    set expected [expr {double($count) / [dict size $distribution]}]
    set X2 0.0
    foreach value [dict values $distribution] {
	set X2 [expr {$X2 + ($value - $expected)**2 / $expected}]
    }
    set degreesOfFreedom [expr {[dict size $distribution] - 1}]
    set likelihoodOfRandom [::math::statistics::incompleteGamma \
	[expr {$degreesOfFreedom / 2.0}] [expr {$X2 / 2.0}]]
    expr {$likelihoodOfRandom > $significance}
}


Private Function Test4DiscreteUniformDistribution(ObservationFrequencies() As Variant, Significance As Single) As Boolean
    'Returns true if the observed frequencies pass the Pearson Chi-squared test at the required significance level.
    Dim Total As Long, Ei As Long, i As Integer
    Dim ChiSquared As Double, DegreesOfFreedom As Integer, p_value As Double
    Debug.Print "[1] ""Data set:"" ";
    For i = LBound(ObservationFrequencies) To UBound(ObservationFrequencies)
        Total = Total + ObservationFrequencies(i)
        Debug.Print ObservationFrequencies(i); " ";
    Next i
    DegreesOfFreedom = UBound(ObservationFrequencies) - LBound(ObservationFrequencies)
    'This is exactly the number of different categories minus 1
    Ei = Total / (DegreesOfFreedom + 1)
    For i = LBound(ObservationFrequencies) To UBound(ObservationFrequencies)
        ChiSquared = ChiSquared + (ObservationFrequencies(i) - Ei) ^ 2 / Ei
    Next i
    p_value = 1 - WorksheetFunction.ChiSq_Dist(ChiSquared, DegreesOfFreedom, True)
    Debug.Print
    Debug.Print "   Chi-squared test for given frequencies"
    Debug.Print "X-squared ="; ChiSquared; ", ";
    Debug.Print "df ="; DegreesOfFreedom; ", ";
    Debug.Print "p-value = "; Format(p_value, "0.0000")
    Test4DiscreteUniformDistribution = p_value > Significance
End Function
Public Sub test()
    Dim O() As Variant
    O = [{199809,200665,199607,200270,199649}]
    Debug.Print "[1] ""Uniform? "; Test4DiscreteUniformDistribution(O, 0.05); """"
    O = [{522573,244456,139979,71531,21461}]
    Debug.Print "[1] ""Uniform? "; Test4DiscreteUniformDistribution(O, 0.05); """"
End Sub


import math

type Ifctn = fn(f64) f64

fn simpson38(f Ifctn, a f64, b f64, n int) f64 {
    h := (b - a) / f64(n)
    h1 := h / 3
    mut sum := f(a) + f(b)
    for j := 3*n - 1; j > 0; j-- {
        if j%3 == 0 {
            sum += 2 * f(a+h1*f64(j))
        } else {
            sum += 3 * f(a+h1*f64(j))
        }
    }
    return h * sum / 8
}

fn gamma_inc_q(a f64, x f64) f64 {
    aa1 := a - 1
    f := Ifctn(fn[aa1](t f64) f64 {
        return math.pow(t, aa1) * math.exp(-t)
    })
    mut y := aa1
    h := 1.5e-2
    for f(y)*(x-y) > 2e-8 && y < x {
        y += .4
    }
    if y > x {
        y = x
    }
    return 1 - simpson38(f, 0, y, int(y/h/math.gamma(a)))
}

fn chi2ud(ds []int) f64 {
    mut sum, mut expected := 0.0,0.0
    for d in ds {
        expected += f64(d)
    }
    expected /= f64(ds.len)
    for d in ds {
        x := f64(d) - expected
        sum += x * x
    }
    return sum / expected
}

fn chi2p(dof int, distance f64) f64 {
    return gamma_inc_q(.5*f64(dof), .5*distance)
}

const sig_level = .05

fn main() {
    for dset in [
        [199809, 200665, 199607, 200270, 199649],
        [522573, 244456, 139979, 71531, 21461],
     ] {
        utest(dset)
    }
}

fn utest(dset []int) {
    println("Uniform distribution test")
    mut sum := 0
    for c in dset {
        sum += c
    }
    println(" dataset: $dset")
    println(" samples:                      $sum")
    println(" categories:                   $dset.len")

    dof := dset.len - 1
    println(" degrees of freedom:           $dof")

    dist := chi2ud(dset)
    println(" chi square test statistic:    $dist")

    p := chi2p(dof, dist)
    println(" p-value of test statistic:    $p")

    sig := p < sig_level
    println(" significant at ${sig_level*100:2.0f}% level?     $sig")
    println(" uniform?                      ${!sig}\n")
}


import "/math" for Math, Nums
import "/fmt" for Fmt

var integrate = Fn.new { |a, b, n, f|
    var h = (b - a) / n
    var sum = 0
    for (i in 0...n) {
        var x = a + i*h
        sum = sum + (f.call(x) + 4 * f.call(x + h/2) + f.call(x + h)) / 6
    }
    return sum * h
}

var gammaIncomplete = Fn.new { |a, x|
    var am1 = a - 1
    var f0 = Fn.new { |t| t.pow(am1) * (-t).exp }
    var h = 1.5e-2
    var y = am1
    while ((f0.call(y) * (x - y) > 2e-8) && y < x) y = y + 0.4
    if (y > x) y = x
    return 1 - integrate.call(0, y, (y/h).truncate, f0) / Math.gamma(a)
}

var chi2UniformDistance = Fn.new { |ds|
    var expected = Nums.mean(ds)
    var sum = Nums.sum(ds.map { |d| (d - expected).pow(2) }.toList)
    return sum / expected
}

var chi2Probability = Fn.new { |dof, dist| gammaIncomplete.call(0.5*dof, 0.5*dist) }

var chiIsUniform = Fn.new { |ds, significance|
    var dof = ds.count - 1
    var dist = chi2UniformDistance.call(ds)
    return chi2Probability.call(dof, dist) > significance
}

var dsets = [
    [199809, 200665, 199607, 200270, 199649],
    [522573, 244456, 139979,  71531,  21461]
]
for (ds in dsets) {
    System.print("Dataset: %(ds)")
    var dist = chi2UniformDistance.call(ds)
    var dof = ds.count - 1
    Fmt.write("DOF: $d  Distance: $.4f", dof, dist)
    var prob = chi2Probability.call(dof, dist)
    Fmt.write("  Probability: $.6f", prob)
    var uniform = chiIsUniform.call(ds, 0.05) ? "Yes" : "No"
    System.print("  Uniform? %(uniform)\n")
}


/* Numerical integration method */
fcn Simpson3_8(f,a,b,N){  // fcn,double,double,Int --> double
   h,h1:=(b - a)/N, h/3.0;
   h*[1..3*N - 1].reduce('wrap(sum,j){
      l1:=(if(j%3) 3.0 else 2.0);
      sum + l1*f(a + h1*j);
   },f(a) + f(b))/8.0;
}

const A=12;
fcn Gamma_Spouge(z){  // double --> double
   var coefs=fcn{  // this runs only once, at construction time
      a,coefs:=A.toFloat(),(A).pump(List(),0.0);
      k1_factrl:=1.0;
      coefs[0]=(2.0*(0.0).pi).sqrt();
      foreach k in ([1.0..A-1]){
         coefs[k]=(a - k).exp() * (a - k).pow(k - 0.5) / k1_factrl;
	 k1_factrl*=-k;
      }
      coefs
   }();

   ( [1..A-1].reduce('wrap(accum,k){ accum + coefs[k]/(z + k) },coefs[0])
     * (-(z + A)).exp()*(z + A).pow(z + 0.5) )
   / z;
}

fcn f0(t,aa1){ t.pow(aa1)*(-t).exp() }

fcn GammaIncomplete_Q(a,x){  // double,double --> double
   h:=1.5e-2;  /* approximate integration step size */
   /* this cuts off the tail of the integration to speed things up */
   y:=a - 1; f:=f0.fp1(y);
   while((f(y)*(x - y)>2.0e-8) and (y<x)){ y+=0.4; }
   if(y>x) y=x;
   1.0 - Simpson3_8(f,0.0,y,(y/h).toInt())/Gamma_Spouge(a);
}


F to_str(v)
   R ‘[ ’v.map(n -> hex(n).lowercase().zfill(2)).join(‘ ’)‘ ]’

F to_seq(UInt64 x)
   V i = 0
   L(ii) (9.<0).step(-1)
      I x [&] (UInt64(127) << ii * 7) != 0
         i = ii
         L.break

   [Byte] out
   L(j) 0 .. i
      out [+]= ((x >> ((i - j) * 7)) [&] 127) [|] 128

   out[i] (+)= 128
   R out

F from_seq(seq)
   UInt64 r = 0

   L(b) seq
      r = (r << 7) [|] (b [&] 127)

   R r

L(x) [UInt64(7'F), 40'00, 0, 003F'FFFE, 001F'FFFF, 0020'0000, 3311'A123'4DF3'1413]
   V s = to_seq(x)
   print(‘seq from ’hex(x).lowercase()‘ ’to_str(s)‘ back: ’hex(from_seq(s)).lowercase())


with Ada.Containers.Vectors;
with Ada.Text_IO;
with Ada.Unchecked_Conversion;

procedure VLQ is

   package Nat_IO is new Ada.Text_IO.Integer_IO (Natural);

   type Byte is mod 2**8;

   package Byte_IO is new Ada.Text_IO.Modular_IO (Byte);

   type Int7 is mod 2**7;

   package Int7_IO is new Ada.Text_IO.Modular_IO (Int7);

   type VLQ_Octet is record
      Value : Int7 := 0;
      Next  : Boolean := True;
   end record;
   pragma Pack (VLQ_Octet);
   for VLQ_Octet'Size use 8;

   function VLQ_To_Byte is new Ada.Unchecked_Conversion (VLQ_Octet, Byte);
   function Byte_To_VLQ is new Ada.Unchecked_Conversion (Byte, VLQ_Octet);

   package VLQ_Vectors is new Ada.Containers.Vectors (Natural, VLQ_Octet);

   procedure Hex_Print (Position : in VLQ_Vectors.Cursor) is
      Value : Byte := VLQ_To_Byte (VLQ_Vectors.Element (Position));
   begin
      Ada.Text_IO.Put (':');
      Byte_IO.Put (Item => Value, Width => 6, Base => 16);
   end Hex_Print;

   procedure Print (X : VLQ_Vectors.Vector) is
   begin
      X.Iterate (Hex_Print'Access);
      Ada.Text_IO.New_Line;
   end Print;

   function To_VLQ (From : Natural) return VLQ_Vectors.Vector is
      Result : VLQ_Vectors.Vector;
      Current : Natural := From;
      Element : VLQ_Octet;
   begin
      loop
         Element.Value := Int7 (Current mod 2**7);
         Result.Prepend (Element);
         Current := Current / 2**7;
         exit when Current = 0;
      end loop;
      Element := Result.Last_Element;
      Element.Next := False;
      VLQ_Vectors.Replace_Element (Result, Result.Last, Element);
      return Result;
   end To_VLQ;

   function To_Int (From : VLQ_Vectors.Vector) return Natural is
      use type VLQ_Vectors.Cursor;
      Result : Natural := 0;
      Iterator : VLQ_Vectors.Cursor := From.First;
   begin
      while Iterator /= VLQ_Vectors.No_Element loop
         Result := Result * 2**7;
         Result := Result + Natural(VLQ_Vectors.Element (Iterator).Value);
         VLQ_Vectors.Next (Iterator);
      end loop;
      return Result;
   end To_Int;

   Test : VLQ_Vectors.Vector;
begin
   Test := To_VLQ (16#7f#);
   Nat_IO.Put (To_Int (Test), 10, 16); Ada.Text_IO.Put (" = ");
   Print (Test);
   Test := To_VLQ (16#4000#);
   Nat_IO.Put (To_Int (Test), 10, 16); Ada.Text_IO.Put (" = ");
   Print (Test);
   Test := To_VLQ (16#0#);
   Nat_IO.Put (To_Int (Test), 10, 16); Ada.Text_IO.Put (" = ");
   Print (Test);
   Test := To_VLQ (16#3FFFFE#);
   Nat_IO.Put (To_Int (Test), 10, 16); Ada.Text_IO.Put (" = ");
   Print (Test);
   Test := To_VLQ (16#1FFFFF#);
   Nat_IO.Put (To_Int (Test), 10, 16); Ada.Text_IO.Put (" = ");
   Print (Test);
   Test := To_VLQ (16#200000#);
   Nat_IO.Put (To_Int (Test), 10, 16); Ada.Text_IO.Put (" = ");
   Print (Test);
end VLQ;


INPUT s$
LET s$ = LTRIM$(RTRIM$(s$))
LET v = 0
FOR i = 1 TO LEN(s$)
   LET c$ = s$(i:i)
   LET k = POS("0123456789abcdef", c$)
   IF k > 0 THEN LET v = v*16 + k - 1
NEXT i
PRINT "S= ";s$, "V=";v

! Convert back to hex
LET hex$ ="0123456789abcdef"
LET hs$="                    "

FOR i = LEN(hs$) TO 1 STEP -1
   IF v = 0 THEN EXIT FOR
   LET d = MOD(v, 16) + 1
   LET hs$(i:i) = hex$(d:d)
   LET v = INT(v/16)
NEXT i
PRINT hs$
END


#include <stdio.h>
#include <stdint.h>

void to_seq(uint64_t x, uint8_t *out)
{
	int i, j;
	for (i = 9; i > 0; i--) {
		if (x & 127ULL << i * 7) break;
	}
	for (j = 0; j <= i; j++)
		out[j] = ((x >> ((i - j) * 7)) & 127) | 128;

	out[i] ^= 128;
}

uint64_t from_seq(uint8_t *in)
{
	uint64_t r = 0;

	do {
		r = (r << 7) | (uint64_t)(*in & 127);
	} while (*in++ & 128);

	return r;
}

int main()
{
	uint8_t s[10];
	uint64_t x[] = { 0x7f, 0x4000, 0, 0x3ffffe, 0x1fffff, 0x200000, 0x3311a1234df31413ULL};

	int i, j;
	for (j = 0; j < sizeof(x)/8; j++) {
		to_seq(x[j], s);
		printf("seq from %llx: [ ", x[j]);

		i = 0;
		do { printf("%02x ", s[i]); } while ((s[i++] & 128));
		printf("] back: %llx\n", from_seq(s));
	}

	return 0;
}


#include <iomanip>
#include <iostream>
#include <vector>

std::ostream &operator<<(std::ostream &os, const std::vector<uint8_t> &v) {
    auto it = v.cbegin();
    auto end = v.cend();

    os << "[ ";
    if (it != end) {
        os << std::setfill('0') << std::setw(2) << (uint32_t)*it;
        it = std::next(it);
    }
    while (it != end) {
        os << ' ' << std::setfill('0') << std::setw(2) << (uint32_t)*it;
        it = std::next(it);
    }
    return os << " ]";
}

std::vector<uint8_t> to_seq(uint64_t x) {
    int i;
    for (i = 9; i > 0; i--) {
        if (x & 127ULL << i * 7) {
            break;
        }
    }

    std::vector<uint8_t> out;
    for (int j = 0; j <= i; j++) {
        out.push_back(((x >> ((i - j) * 7)) & 127) | 128);
    }
    out[i] ^= 128;
    return out;
}

uint64_t from_seq(const std::vector<uint8_t> &seq) {
    uint64_t r = 0;

    for (auto b : seq) {
        r = (r << 7) | (b & 127);
    }

    return r;
}

int main() {
    std::vector<uint64_t> src{ 0x7f, 0x4000, 0, 0x3ffffe, 0x1fffff, 0x200000, 0x3311a1234df31413ULL };

    for (auto x : src) {
        auto s = to_seq(x);
        std::cout << std::hex;
        std::cout << "seq from " << x << ' ' << s << " back: " << from_seq(s) << '\n';
        std::cout << std::dec;
    }

    return 0;
}


namespace Vlq
{
  using System;
  using System.Collections.Generic;
  using System.Linq;

  public static class VarLenQuantity
  {
    public static ulong ToVlq(ulong integer)
    {
      var array = new byte[8];
      var buffer = ToVlqCollection(integer)
        .SkipWhile(b => b == 0)
        .Reverse()
        .ToArray();
      Array.Copy(buffer, array, buffer.Length);
      return BitConverter.ToUInt64(array, 0);
    }

    public static ulong FromVlq(ulong integer)
    {
      var collection = BitConverter.GetBytes(integer).Reverse();
      return FromVlqCollection(collection);
    }

    public static IEnumerable<byte> ToVlqCollection(ulong integer)
    {
      if (integer > Math.Pow(2, 56))
        throw new OverflowException("Integer exceeds max value.");

      var index = 7;
      var significantBitReached = false;
      var mask = 0x7fUL << (index * 7);
      while (index >= 0)
      {
        var buffer = (mask & integer);
        if (buffer > 0 || significantBitReached)
        {
          significantBitReached = true;
          buffer >>= index * 7;
          if (index > 0)
            buffer |= 0x80;
          yield return (byte)buffer;
        }
        mask >>= 7;
        index--;
      }
    }

    public static ulong FromVlqCollection(IEnumerable<byte> vlq)
    {
      ulong integer = 0;
      var significantBitReached = false;

      using (var enumerator = vlq.GetEnumerator())
      {
        int index = 0;
        while (enumerator.MoveNext())
        {
          var buffer = enumerator.Current;
          if (buffer > 0 || significantBitReached)
          {
            significantBitReached = true;
            integer <<= 7;
            integer |= (buffer & 0x7fUL);
          }

          if (++index == 8 || (significantBitReached && (buffer & 0x80) != 0x80))
            break;
        }
      }
      return integer;
    }

    public static void Main()
    {
      var integers = new ulong[] { 0x7fUL << 7 * 7, 0x80, 0x2000, 0x3FFF, 0x4000, 0x200000, 0x1fffff };

      foreach (var original in integers)
      {
        Console.WriteLine("Original: 0x{0:X}", original);

        //collection
        var seq = ToVlqCollection(original);
        Console.WriteLine("Sequence: 0x{0}", seq.Select(b => b.ToString("X2")).Aggregate(string.Concat));

        var decoded = FromVlqCollection(seq);
        Console.WriteLine("Decoded: 0x{0:X}", decoded);

        //ints
        var encoded = ToVlq(original);
        Console.WriteLine("Encoded: 0x{0:X}", encoded);

        decoded = FromVlq(encoded);
        Console.WriteLine("Decoded: 0x{0:X}", decoded);

        Console.WriteLine();
      }
      Console.WriteLine("Press any key to continue...");
      Console.ReadKey();
    }
  }
}


import std.stdio, std.string, std.file, std.algorithm;

/// Variable length quantity (unsigned long, max 63-bit).
struct VLQ {
    ulong value;

    // This allows VLQ to work like an ulong.
    alias value this;

    uint extract(in ubyte[] v) pure
    in {
        assert(v.length > 0);
    } body {
        immutable limit = min(v.length - 1, 8);
        ulong t = 0;
        size_t idx = 0;
        while ((idx < limit) && ((v[idx] & 0x80) > 0))
            t = (t << 7) | (0x7f & v[idx++]);
        if (idx > limit)
            throw new Exception(
                "Too large for ulong or invalid format.");
        else
            value = (t << 7) | v[idx];
        return idx + 1;
    }

    VLQ from(in ubyte[] v) pure {
        extract(v);
        return this;
    }

    @property ubyte[] toVLQ() const pure {
        ubyte[] v = [0x7f & value];
        for (ulong k = value >>> 7; k > 0; k >>>= 7)
            v ~= (k & 0x7f) | 0x80;
        if (v.length > 9)
            throw new Exception("Too large value.");
        v.reverse();
        return v;
    }

    static ulong[] split(in ubyte[] b) pure {
        ulong[] res;
        VLQ v;
        for (size_t i = 0; i < b.length; ) {
            i += v.extract(b[i .. $]);
            res ~= v.value;
        }
        return res;
    }

    string toString() const pure /*nothrow*/ {
        return format("(%(%02X:%))", this.toVLQ);
    }
}

void main() { // VLQ demo code.
    VLQ a = VLQ(0x7f),
        b = VLQ(0x4000),
        c;
    writefln("a:%8x = %s\nb:%8x = %s\nc:%8x = %s",
             a.value, a, b.value, b, c.value, c);

    // Some operations.
    c = (a + 1) * b;
    a = c - 1;
    b = VLQ().from(a.toVLQ);
    a <<= 1;

    // Convert ulong to octet sequence.
    writefln("\na:%8x = %s\nb:%8x = %s\nc:%8x = %s",
             a.value, a, b.value, b, c.value, c);

    // Write them to a binary file.
    std.file.write("vlqtest.bin", a.toVLQ ~ b.toVLQ ~ c.toVLQ);

    // Read them back.
    const buf = cast(ubyte[])std.file.read("vlqtest.bin");
    writefln("\nFile length: %d bytes.", buf.length);

    // Convert octet sequence to ulongs.
    foreach (immutable i, immutable v; VLQ.split(buf))
        writefln("%d:%8x = %s", i + 1, v, VLQ(v));
}


function vlq_encode(integer n)
    sequence s
    s = {}
    while n > 0 do
        s = prepend(s, #80 * (length(s) > 0) + and_bits(n, #7F))
        n = floor(n / #80)
    end while
    if length(s) = 0 then
        s = {0}
    end if
    return s
end function

function vlq_decode(sequence s)
    integer n
    n = 0
    for i = 1 to length(s) do
        n *= #80
        n += and_bits(s[i], #7F)
        if not and_bits(s[i], #80) then
            exit
        end if
    end for
    return n
end function

function svlg(sequence s)
    sequence out
    out = ""
    for i = 1 to length(s) do
        out &= sprintf("#%02x:", {s[i]})
    end for
    return out[1..$-1]
end function

constant testNumbers = { #200000, #1FFFFF, 1, 127, 128 }
sequence s
for i = 1 to length(testNumbers) do
    s = vlq_encode(testNumbers[i])
    printf(1, "#%02x -> %s -> #%02x\n", {testNumbers[i], svlg(s), vlq_decode(s)})
end for


package main

import (
    "fmt"
    "encoding/binary"
)

func main() {
    buf := make([]byte, binary.MaxVarintLen64)
    for _, x := range []int64{0x200000, 0x1fffff} {
        v := buf[:binary.PutVarint(buf, x)]
        fmt.Printf("%d encodes into %d bytes: %x\n", x, len(v), v)
        x, _ = binary.Varint(v)
        fmt.Println(x, "decoded")
    }
}


final RADIX = 7
final MASK = 2**RADIX - 1

def octetify = { n ->
    def octets = []
    for (def i = n; i != 0; i >>>= RADIX) {
        octets << ((byte)((i & MASK) + (octets.empty ? 0 : MASK + 1)))
    }
    octets.reverse()
}

def deoctetify = { octets ->
    octets.inject(0) { long n, octet ->
        (n << RADIX) + ((int)(octet) & MASK)
    }
}


import Numeric (readOct, showOct)
import Data.List (intercalate)

to :: Int -> String
to = flip showOct ""

from :: String -> Int
from = fst . head . readOct

main :: IO ()
main =
  mapM_
    (putStrLn .
     intercalate " <-> " . (pure (:) <*> to <*> (return . show . from . to)))
    [2097152, 2097151]


procedure main()
every i := 2097152 | 2097151 | 1 | 127 | 128 | 589723405834 | 165 | 256 do
   write(image(i)," = ",string2hex(v := uint2vlq(i))," = ",vlq2uint(v))
end

procedure vlq2uint(s)    #: decode a variable length quantity
   if *s > 0 then {
      i := 0
      s ? while h := ord(move(1)) do {
         if (pos(0) & h > 128) | (not pos(0) & h < 128) then fail
         i := 128 * i + h % 128
         }
      return i
      }
end

procedure uint2vlq(i,c)  #: encode a whole number as a variable length quantity
   if "integer" == type(-1 < i) then
      return if i = 0 then
         char((/c := 0)) | ""
      else
         uint2vlq(i/128,1) || char((i % 128) + ((/c := 0) | 128) )
end

procedure string2hex(s)  #: convert a string to hex
   h := ""
   every i := ord(!s) do
      h ||:= "0123456789abcdef"[i/16+1] || "0123456789abcdef"[i%16+1]
   return h
end


public class VLQCode
{
  public static byte[] encode(long n)
  {
    int numRelevantBits = 64 - Long.numberOfLeadingZeros(n);
    int numBytes = (numRelevantBits + 6) / 7;
    if (numBytes == 0)
      numBytes = 1;
    byte[] output = new byte[numBytes];
    for (int i = numBytes - 1; i >= 0; i--)
    {
      int curByte = (int)(n & 0x7F);
      if (i != (numBytes - 1))
        curByte |= 0x80;
      output[i] = (byte)curByte;
      n >>>= 7;
    }
    return output;
  }

  public static long decode(byte[] b)
  {
    long n = 0;
    for (int i = 0; i < b.length; i++)
    {
      int curByte = b[i] & 0xFF;
      n = (n << 7) | (curByte & 0x7F);
      if ((curByte & 0x80) == 0)
        break;
    }
    return n;
  }

  public static String byteArrayToString(byte[] b)
  {
    StringBuilder sb = new StringBuilder();
    for (int i = 0; i < b.length; i++)
    {
      if (i > 0)
        sb.append(", ");
      String s = Integer.toHexString(b[i] & 0xFF);
      if (s.length() < 2)
        s = "0" + s;
      sb.append(s);
    }
    return sb.toString();
  }

  public static void main(String[] args)
  {
    long[] testNumbers = { 2097152, 2097151, 1, 127, 128, 589723405834L };
    for (long n : testNumbers)
    {
      byte[] encoded = encode(n);
      long decoded = decode(encoded);
      System.out.println("Original input=" + n + ", encoded = [" + byteArrayToString(encoded) + "], decoded=" + decoded + ", " + ((n == decoded) ? "OK" : "FAIL"));
    }
  }
}


const RADIX = 7;
const MASK = 2**RADIX - 1;

const octetify = (n)=> {
	if (n >= 2147483648) {
		throw new RangeError("Variable Length Quantity not supported for numbers >= 2147483648");
	}
	const octets = [];
	for (let i = n; i != 0; i >>>= RADIX) {
		octets.push((((i & MASK) + (octets.empty ? 0 : (MASK + 1)))));
	}
	octets.reverse();
	return octets;
};

const deoctetify = (octets)=>
	octets.reduce((n, octet)=>
		(n << RADIX) + (octet & MASK)
	, 0);

// Test (assuming Node.js)

const assert = require("assert");
const testNumbers = [ 0x200000, 0x1fffff, 1, 127, 128, 2147483647 /*, 589723405834*/ ]

testNumbers.forEach((number)=> {
	const octets = octetify(number)
	console.log(octets);
	const got_back_number = deoctetify(octets)
	assert.strictEqual(got_back_number, number);
});


using Printf

mutable struct VLQ
    quant::Vector{UInt8}
end

function VLQ(n::T) where T <: Integer
    quant = UInt8.(digits(n, 128))
    @inbounds for i in 2:length(quant) quant[i] |= 0x80 end
    VLQ(reverse(quant))
end

import Base.UInt64
function Base.UInt64(vlq::VLQ)
    quant = reverse(vlq.quant)
    n = shift!(quant)
    p = one(UInt64)
    for i in quant
        p *= 0x80
        n += p * ( i & 0x7f)
    end
    return n
end

const test = [0x00200000, 0x001fffff, 0x00000000, 0x0000007f,
              0x00000080, 0x00002000, 0x00003fff, 0x00004000,
              0x08000000, 0x0fffffff]

for i in test
    vlq = VLQ(i)
    j = UInt(vlq)
    @printf "0x%-8x => [%-25s] => 0x%x\n" i join(("0x" * hex(r, 2) for r in vlq.quant), ", ") j
end


// version 1.0.6

fun Int.toOctets(): ByteArray {
    var s = Integer.toBinaryString(this)
    val r = s.length % 7
    var z = s.length / 7
    if (r > 0) {
        z++
        s = s.padStart(z * 7, '0')
    }
    s = Array(z) { "1" + s.slice(it * 7 until (it + 1) * 7) }.joinToString("")
    s = s.take(s.length - 8) + "0" + s.takeLast(7)
    return ByteArray(z) { Integer.parseInt(s.slice(it * 8 until (it + 1) * 8), 2).toByte() }
}

fun ByteArray.fromOctets(): Int {
    var s = ""
    for (b in this) s += Integer.toBinaryString(b.toInt()).padStart(7, '0').takeLast(7)
    return Integer.parseInt(s, 2)
}

fun main(args: Array<String>) {
    val tests = intArrayOf(0x7f, 0x3fff, 0x200000, 0x1fffff)
    for (test in tests) {
        val ba = test.toOctets()
        print("${"0x%x".format(test).padEnd(8)} -> ")
        var s = ""
        ba.forEach { s += "0x%02x ".format(it) }
        println("${s.padEnd(20)} <- ${"0x%x".format(ba.fromOctets())}")
    }
}


on DecToVLQ
   Ask "Enter base 10 value:" -- input dialog box
   if it is not empty then
      if it is a number then
         put it into theString
         if isWholeNumString(theString) is false then -- I think there is built in equivalent for this but I rolled my own!
            answer "Only Whole Decimal Numbers Are Allowed!"
            exit DecToVLQ
         end if
         if theString>4294967295 then
            answer "This function fails with whole numbers over 4294967295!"&cr\
            & "4294967295 is the maximum allowed value for 32bits (4 bytes)"
            exit DecToVLQ
         end if
         if theString>268435455 then
            answer "This function is not accurate with whole numbers over 268435455!"&cr\
            & "268435455 is the maximum allowed value for 28bit (7bits per byte) MIDI delta-time VLQ"
         end if
         put "Original Whole Number="& theString & cr & \
               "Original Whole Number in Hex="& baseConvert(theString,10,16) & cr & \ --- LC's built in baseConvert function
               "Variable Length Quantity in Hex=" & wholeNumToVLQ(theString) into fld "Output"
      else
         answer "Only Whole Decimal Numbers Are Allowed!"
      end if
   end if
end DecToVLQ

function wholeNumToVLQ theWholeNum
   -- baseConvert(number,originalBase,destinationBase) -- there is also bitwise operations in LC but I took the long road
   if theWholeNum < 127 then -- if it fits into a single 7bit byte value and theres no need to process it
      put baseConvert(theWholeNum,10,16) into VQLinHex
      if the number of chars in VQLinHex=1 then put "0" before VQLinHex
      return VQLinHex
      exit wholeNumToVLQ
   end if
   put baseConvert(theWholeNum,10,2) into theBits
   put number of chars in theBits into x
   put 0 into bitCounter
   put empty into the7bitBytes
   repeat
      if char x of theBits is not empty then
         put char x theBits before the7bitBytes
         delete char x of theBits
         if theBits is empty then exit repeat
         put number of chars in theBits into x
         add 1 to bitCounter
         if bitCounter=7 then
            put "," before the7bitBytes
            put 0 into bitCounter
            next repeat
         end if
      else
         exit repeat
      end if
   end repeat
   get the number of chars in item 1 of the7bitBytes
   if it<7 then
      put 7 - it into x
      repeat x
         put "0" before item 1 of the7bitBytes
      end repeat
   end if
   put the number of items in the7bitBytes into y
   repeat with x = 1 to y
      if x is not y then
         put "1" before item x of the7bitBytes
      else
         put "0" before item x of the7bitBytes
      end if
      put baseConvert(item x of the7bitBytes,2,16) into item x of the7bitBytes
      if the number of chars in item x of the7bitBytes<2 then put "0" before item x of the7bitBytes
      put item x of the7bitBytes after VQLinHex
   end repeat
   return VQLinHex
end wholeNumToVLQ

function isWholeNumString theString
   put the number of chars in theString into y
   repeat with x = 1 to y
      if char x of theString is not in "0123456789" then
         return false
         exit isWholeNumString
      end if
   end repeat
   return true
end isWholeNumString


toOctets[n_Integer] :=
 StringJoin @@@
  Partition[
   PadLeft[[email protected][n, 16],
    2 Ceiling[Plus @@ DigitCount[n, 16]/2], {"0"}], 2]
fromOctets[octets_List] := FromDigits[StringJoin @@ octets, 16]
Grid[{#, [email protected]#, fromOctets[[email protected]#]} & /@ {16^^3ffffe, 16^^1fffff, 16^^200000}]


import strformat

proc toSeq(x: uint64): seq[uint8] =
  var x = x
  var f = 0u64
  for i in countdown(9u64, 1):
    if (x and 127'u64 shl (i * 7)) > 0:
      f = i
      break
  for j in 0u64..f:
    result.add uint8((x shr ((f - j) * 7)) and 127) or 128

  result[f] = result[f] xor 128'u8

proc fromSeq(xs: openArray[uint8]): uint64 =
  for x in xs:
    result = (result shl 7) or (x and 127)

for x in [0x7f'u64, 0x4000'u64, 0'u64, 0x3ffffe'u64, 0x1fffff'u64,
          0x200000'u64, 0x3311a1234df31413'u64]:
  let c = toSeq(x)
  echo &"seq from {x}: {c} back: {fromSeq(c)}"


let to_vlq n =
  let a, b = n lsr 7, n land 0x7F in
  let rec aux n acc =
    let x = (n land 0x7F) lor 0x80
    and xs = n lsr 7 in
    if xs > 0
    then aux xs (x::acc)
    else x::acc
  in
  aux a [b]

let to_num = List.fold_left (fun n x -> n lsl 7 + (x land 0x7F)) 0

let v_rep n =
  Printf.printf "%d ->" n;
  let seq = to_vlq n in
  List.iter (Printf.printf " 0x%02X") seq;
  let num = to_num seq in
  Printf.printf "-> %d\n%!" num;
  assert (n = num)

let _ =
  v_rep 0x200000;
  v_rep 0x1FFFFF


use warnings;
use strict;

for my $testcase (
    0,   0xa,   123,   254,   255,   256,
    257, 65534, 65535, 65536, 65537, 0x1fffff,
    0x200000
  )
{
    my @vlq = vlq_encode($testcase);
    printf "%8s %12s %8s\n", $testcase, ( join ':', @vlq ), vlq_decode(@vlq);
}

sub vlq_encode {
    my @vlq;
    my $binary = sprintf "%s%b", 0 x 7, shift;
    $binary =~ s/(.{7})$//;
    @vlq = ( unpack 'H2', ( pack 'B8', '0' . $1 ) );
    while ( 0 + $binary ) {
        $binary =~ s/(.{7})$//;
        unshift @vlq, ( unpack 'H2', pack 'B8', '1' . $1 );
    }
    return @vlq;
}

sub vlq_decode {
    my $num;
    $num .= sprintf "%07b", hex(shift @_) & 0x7f while @_;
    return oct '0b' . $num;
}


function vlq_encode(sequence s)
    sequence res = {}
    for i=length(s) to 1 by -1 do
        integer n = s[i], msb = 0
        if n<0 then crash("unsigned integers only!") end if
        while 1 do
            res = prepend(res,msb+and_bits(n,#7F))
            n = floor(n/#80)
            if n=0 then exit end if
            msb = #80
        end while
    end for
    return res
end function

function vlq_decode(sequence s)
    sequence res = {}
    for i=1 to length(s) do
        integer si = s[i],
                n = n*#80+and_bits(byte,#7F)
        if not and_bits(si,#80) then
            res = append(res,n)
            n = 0
        end if
    end for
    return res
end function

function svlg(sequence s)
    string res = ""
    for i=1 to length(s) do
        res &= sprintf("#%02x:",{s[i]})
    end for
    return res[1..$-1]
end function

constant testNumbers = { #200000, #1FFFFF, 1, 127, 128 }
sequence s = vlq_encode(testNumbers),
         decoded = vlq_decode(s)
printf(1,"%s -> %s -> %s\n",{svlg(testNumbers),svlg(s),svlg(decoded)})
if decoded!=testNumbers then crash("something wrong") end if


(de numToVlq (Num)
   (let Res (cons (& Num 127))
      (while (gt0 (setq Num (>> 7 Num)))
         (push 'Res (| 128 (& Num 127))) )
      Res ) )

(de vlqToNum (Vlq)
   (let Res 0
      (for N Vlq
         (setq Res (| (>> -7 Res) (& N 127))) ) ) )

(for Num (0 15 16 127 128 255 2097151 2097152)
   (let Vlq (numToVlq Num)
      (tab (12 12 12) Num (glue ":" (mapcar hex Vlq)) (vlqToNum Vlq)) ) )


test: procedure options(main);
   declare s character (20) varying;
   declare c character (1);
   declare v fixed binary (31);
   declare (i, k) fixed binary;

   get edit (s) (L);
   s = trim (s);
   v = 0;
   do i = 1 to length(s);
      c = substr(s, i, 1);
      k = index('0123456789abcdef', c);
      if k > 0 then v = v*16 + k - 1;
   end;
   put skip data (s, v);

   /* Convert back to hex */
   declare hex character(16) initial ('0123456789abcdef');
   declare hs character (20) initial ('');
   declare d fixed binary;

   do i = length(hs) to 1 by -1 until (v = 0);
      d = mod(v, 16) + 1;
      substr(hs, i, 1) = substr(hex, d, 1);
      v = v/16;
   end;
   put skip list (hs);
end test;


def tobits(n, _group=8, _sep='_', _pad=False):
    'Express n as binary bits with separator'
    bits = '{0:b}'.format(n)[::-1]
    if _pad:
        bits = '{0:0{1}b}'.format(n,
                                  ((_group+len(bits)-1)//_group)*_group)[::-1]
        answer = _sep.join(bits[i:i+_group]
                                 for i in range(0, len(bits), _group))[::-1]
        answer = '0'*(len(_sep)-1) + answer
    else:
        answer = _sep.join(bits[i:i+_group]
                           for i in range(0, len(bits), _group))[::-1]
    return answer

def tovlq(n):
    return tobits(n, _group=7, _sep='1_', _pad=True)

def toint(vlq):
    return int(''.join(vlq.split('_1')), 2)

def vlqsend(vlq):
    for i, byte in enumerate(vlq.split('_')[::-1]):
        print('Sent byte {0:3}: {1:#04x}'.format(i, int(byte,2)))


#lang racket

(define (try n)
  (printf "Original number: ~s (0x~x)\n" n n)
  (define 4octets (integer->integer-bytes n 4 #f))
  (printf "Octets: ~a (byte-string: ~s)\n"
          (string-join (map (λ(o) (~r o #:base 16))
                            (bytes->list 4octets))
                       ":")
          4octets)
  (define m (integer-bytes->integer 4octets #f))
  (printf "Back to a number: ~s (~a)\n"
          m (if (= m n) "OK" "BAD")))

(for-each try '(#x200000 #x1fffff))


sub vlq_encode ($number is copy) {
    my $string = '';
    my $t = 0x7F +& $number;
    $number +>= 7;
    $string = $t.chr ~ $string;
    while ($number) {
       $t = 0x7F +& $number;
       $string = (0x80 +| $t).chr ~ $string;
       $number +>= 7;
    }
    return $string;
}

sub vlq_decode ($string is copy) {
    my $number = '0b';
    for $string.ords -> $oct {
        $number ~= ($oct +& 0x7F).fmt("%07b");
    }
    return :2($number);
}

#test encoding and decoding
for (
    0,   0xa,   123,   254,   255,   256,
    257, 65534, 65535, 65536, 65537, 0x1fffff,
    0x200000
 ) -> $testcase {
    my $encoded = vlq_encode($testcase);
    printf "%8s %12s %8s\n", $testcase,
      ( join ':', $encoded.ords>>.fmt("%02X") ),
      vlq_decode($encoded);
}


/*REXX program displays  (and also tests/verifies)  some numbers as  octets.            */
nums = x2d(200000)     x2d(1fffff)       2097172      2097151
#=words(nums)
say '  number       hex       octet    original'
say '══════════ ══════════ ══════════ ══════════'
ok=1
     do j=1  for #;      @.j= word(nums,j)
                      onum.j=octet(@.j)
                      orig.j=  x2d( space(onum.j, 0) )
     w=10
     say center(@.j, w)     center(d2x(@.j), w)     center(onum.j, w)    center(orig.j, w)
     if @.j\==orig.j  then ok=0
     end   /*j*/
say
if ok  then say 'All '   #    " numbers are OK." /*all  of the numbers are   good.      */
       else say "Some numbers are not OK."       /*some of the numbers are  ¬good.      */
exit                                             /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
octet: procedure;  parse arg z,$                 /*obtain  Z  from the passed arguments.*/
       x=d2x(z)                                  /*convert Z  to a hexadecimal octet.   */
                   do j=length(x)  by -2  to 1   /*process the  "little"  end first.    */
                   $= substr(x, j-1, 2, 0)   $   /*pad odd hexadecimal characters with  */
                   end   /*j*/                   /*           ···  a zero on the left.  */
       return strip($)


[0x200000, 0x1fffff].each do |i|
  # Encode i => BER
  ber = [i].pack("w")
  hex = ber.unpack("C*").collect {|c| "%02x" % c}.join(":")
  printf "%s => %s\n", i, hex

  # Decode BER => j
  j = ber.unpack("w").first
  i == j or fail "BER not preserve integer"
end


object VlqCode {
  def encode(x:Long)={
    val result=scala.collection.mutable.Stack[Byte]()
    result push (x&0x7f).toByte
    var l = x >>> 7
    while(l>0){
      result push ((l&0x7f)|0x80).toByte
      l >>>= 7
    }
    result.toArray
  }

  def decode(a:Array[Byte])=a.foldLeft(0L)((r, b) => r<<7|b&0x7f)

  def toString(a:Array[Byte])=a map("%02x".format(_)) mkString("[", ", ", "]")

  def test(x:Long)={
    val enc=encode(x)
    println("0x%x => %s => 0x%x".format(x, toString(enc), decode(enc)))
  }

  def main(args: Array[String]): Unit = {
    val xs=Seq(0, 0x7f, 0x80, 0x2000, 0x3fff, 0x4000, 0x1FFFFF, 0x200000, 0x8000000,
               0xFFFFFFF, 0xFFFFFFFFL, 0x842FFFFFFFFL, 0x0FFFFFFFFFFFFFFFL)
    xs foreach test
  }
}


$ include "seed7_05.s7i";
  include "bigint.s7i";

const func string: toSequence (in var bigInteger: number) is func
  result
    var string: sequence is "";
  begin
    sequence := str(chr(ord(number mod 128_)));
    number >>:= 7;
    while number <> 0_ do
      sequence := str(chr(ord(number mod 128_) + 128)) & sequence;
      number >>:= 7;
    end while;
  end func;

const func bigInteger: fromSequence (in string: sequence) is func
  result
    var bigInteger: number is 0_;
  local
    var integer: index is 1;
  begin
    while ord(sequence[index]) >= 128 do
      number <<:= 7;
      number +:= bigInteger conv (ord(sequence[index]) - 128);
      incr(index);
    end while;
    number <<:= 7;
    number +:= bigInteger conv ord(sequence[index]);
  end func;

const proc: main is func
  local
    const array bigInteger: testValues is [] (
        0_, 10_, 123_, 254_, 255_, 256_, 257_, 65534_, 65535_, 65536_, 65537_, 2097151_, 2097152_);
    var string: sequence is "";
    var bigInteger: testValue is 0_;
    var char: element is ' ';
  begin
    for testValue range testValues do
      sequence := toSequence(testValue);
      write("sequence from " <& testValue <& ": [ ");
      for element range sequence do
        write(ord(element) radix 16 lpad0 2 <& " ");
      end for;
      writeln("] back: " <& fromSequence(sequence));
    end for;
  end func;


func vlq_encode(num) {
    var t = (0x7F & num)
    var str = t.chr
    while (num >>= 7) {
       t = (0x7F & num)
       str += chr(0x80 | t)
    }
    str.reverse
}

func vlq_decode(str) {
    var num = ''
    str.each_byte { |b|
        num += ('%07b' % (b & 0x7F))
    }
    Num(num, 2)
}

var tests = [0,   0xa,   123,   254,   255,   256,
             257, 65534, 65535, 65536, 65537, 0x1fffff,
             0x200000]

tests.each { |t|
    var vlq = vlq_encode(t)
    printf("%8s %12s %8s\n", t,
        vlq.bytes.join(':', { "%02X" % _ }), vlq_decode(vlq))
}


package require Tcl 8.5

proc vlqEncode number {
    if {$number < 0} {error "negative not supported"}
    while 1 {
	lappend digits [expr {$number & 0x7f}]
	if {[set number [expr {$number >> 7}]] == 0} break
    }
    set out [format %c [lindex $digits 0]]
    foreach digit [lrange $digits 1 end] {
	set out [format %c%s [expr {0x80+$digit}] $out]
    }
    return $out
}
proc vlqDecode chars {
    set n 0
    foreach c [split $chars ""] {
	scan $c %c c
	set n [expr {($n<<7) | ($c&0x7f)}]
	if {!($c&0x80)} break
    }
    return $n
}


1> (carray-num #x200000)
#<carray 3 #<ffi-type uchar>>
2> (carray-get *1)
#(32 0 0)
3> (carray-num #x1FFFFF)
#<carray 3 #<ffi-type uchar>>
4> (carray-get *3)
#(31 255 255)
5> (num-carray *1)
2097152
6> (num-carray *3)
2097151