#!/usr/local/bin/shale

time library

// This solves a sudoku with:
//  row/column/3x3box constraints (standard sudoku)
//  row/column/irregular, or jigsaw, region constraints
// optionally with a Chess Knight's move constraint.
// It is based on the python code from the Computerphile video
//  https://www.youtube.com/watch?v=G_UYXzGuqvM
// The sudoku example from this video is used below, along with
// a couple of Cracking The Cryptic examples and one from Andrew Stuart.

// The sudoku grid is stored in a multi-dimensional array under the grid:: namespace.
// The row and column of each cell is represented by:
//
//  row column:: grid::
//
// A 0 value represents an empty cell, and a 1 to 9 value represents a cell value.

// You can specify which of the sudokus to solve by specifying s={n} on the command line.
// If it is not specified then you get a text explaining how to specify an option
// and what the options are and the default (s=1) option is solved.

startTime dup var now time::() =

whichSudoku var

s initialised {
  whichSudoku s =
} {
  "You can choose to solve one of several sudokus by adding s=n to the command line," println
  "where n is" println
  "  1: standard sudoku from Computerphile (the default)" println
  "  2: standard sudoku from Cracking The Cryptic" println
  "  3: standard sudoku from Cracking The Cryptic, with Knight's move constraint" println
  "  4: standard sudoku from Cracking The Cryptic" println
  "  5: irregular sudoku from Cracking The Cryptic" println
  "  6: irregular sudoku from Andrew Stuart" println
  "" println
  "You can also enable colour output by adding colour=true or color=true to the command line." println
  "" println
  "For example," println
  file arg:: shale:: "  %s s=3 colour=true\n" printf
  "will solve the CTC sudoku with the Knight's move constraint" println
  "" println
  whichSudoku 1 =
} if

// Prints the sudoku grid.
printGrid dup var {
  r var
  c var
  doColour var
  irregular var
  region var

  colour initialised {
    doColour colour =
  } {
    color initialised {
      doColour color =
    } {
      doColour false =
    } if
  } if
  irregular 0 0:: regions:: initialised =

  r 0 =
  { r 9 < } {
    c 0 =
    { c 9 < } {
      doColour {
        irregular {
          region r.value c.value:: regions:: =
          region.value colour:: 0x1b "%c[1;%dm" printf
        } {
          r 3 / c 3 / + 1 + 2 % 3 * 31 + 0x1b "%c[1;%dm" printf
        } if
      } ifthen
      r.value c.value:: grid:: dup 0 == { pop " ." } { " %d" } if printf
      doColour {
        0x1b "%c[0m" printf
      } ifthen
      c++
    } while
    "" println
    r++
  } while
} =

// This sets up the colour map for irregular sudokus.
1 colour:: dup var 30 =
2 colour:: dup var 31 =
3 colour:: dup var 32 =
4 colour:: dup var 33 =
5 colour:: dup var 34 =
6 colour:: dup var 35 =
7 colour:: dup var 36 =
8 colour:: dup var 30 =   // skip 37 (too light) and reuse 30 and 31 (with luck they won't be close to regions 1 and 2).
9 colour:: dup var 31 =

// Assign the cell values to one row of the grid.
setRow dup var {
  8$ dup var swap =   // cell 9 of the row
  7$ dup var swap =   // cell 8 of the row
  6$ dup var swap =   // ...
  5$ dup var swap =
  4$ dup var swap =
  3$ dup var swap =
  2$ dup var swap =
  1$ dup var swap =   // ...
  0$ dup var swap =   // cell 1 of the row
  r dup var swap =    // the row number
  ns dup var swap &=  // the namespace to use
  i var               // loop counter

  r 0 < r 8 > or {
    r "Illegal row %d\n" printf
    1 exit
  } ifthen

  i 0 =
  { i 9 < } {
    i.value$ 0 < i.value$ 9 > or {
      i r i.value$ "Illegal value %d specified for r%dc%d\n" printf
      1 exit
    } ifthen
    r.value i.value:: ns->:: defined not {    // define this grid cell if not already defined
      r.value i.value:: ns->:: var
    } ifthen
    r.value i.value:: ns->:: i.value$ =       // assign the value to the grid cell
    i++
  } while
} =

// Standard 3x3 box region checker.
// This only works when called from within possible().
standardRegions dup var {
  r0 var
  c0 var

  r0 r 3 / 3 * =
  c0 c 3 / 3 * =
  i 0 =
  { i 3 < } {
    j 0 =
    { j 3 < } {
      r0 i + c0 j +:: grid:: n == {
        false return
      } ifthen
      j++
    } while
    i++
  } while
} =

// Irregular region checker.
// This only works when called from within possible().
irregularRegions dup var {
  region var
  i var

  region r.value c.value:: regions:: =   // The region we are in.

  i 0 =
  { i 9 < } {
    i.value r:: region.value:: region:: value i.value c:: region.value:: region:: value:: grid:: n == {
      false return
    } ifthen
    i++
  } while
} =

// Convert the regions:: namespace into something a little more cpu-time friendly.
// Only optimise if there are irregular regions defined.
optimiseRegions dup var {
  0 0:: regions:: initialised {
    region var
    r var
    c var
    i var

    region 1 =
    { region 10 < } {
      i 0 =
      r 0 =
      { r 9 < } {
        c 0 =
        { c 9 < } {
          r.value c.value:: regions:: region == {
            i.value r:: region.value:: region:: dup var r =
            i.value c:: region.value:: region:: dup var c =
            i++
          } ifthen
          c++
        } while
        r++
      } while
      i 9 != {
        i region "Region %d contains the wrong number of cells (%d)\n" printf
        1 exit
      } ifthen
      region++
    } while
  } ifthen
} =

// Is it possible to place a digit in a given cell?
possible dup var { function
  n dup var swap =
  c dup var swap =
  r dup var swap =
  i var
  j var

  // Check the column doesn't already contain this value.
  i 0 =
  { i 9 < } {
    r.value i.value:: grid:: n == {
      false return
    } ifthen
    i++
  } while

  // Check the row doesn't already contain this value.
  i 0 =
  { i 9 < } {
    i.value c.value:: grid:: n == {
      false return
    } ifthen
    i++
  } while

  // Check that the region doesn't already contain this value.
  regionChecker()

  // Check for any other constraint.
  constraint initialised { r c n constraint() not } and {
    false return
  } ifthen

  true
} =

// This is a Knight's move constraint.
knightsMoveConstraint dup var { function
  0$ dup var swap =  // n
  1$ dup var swap =  // column
  2$ dup var swap =  // row
  nr var
  nc var

  // Check Knight's move 2 left and 1 up and down.
  nc 1$ 2 - =
  nc 0 >= {
    nr 2$ 1 - =
    nr 0 >= {
      nr.value nc.value:: grid:: 0$ == {
        false return
      } ifthen
    } ifthen
    nr 2$ 1 + =
    nr 9 < {
      nr.value nc.value:: grid:: 0$ == {
        false return
      } ifthen
    } ifthen
  } ifthen

  // Check Knight's move 1 left and 2 up and down.
  nc 1$ 1 - =
  nc 0 >= {
    nr 2$ 2 - =
    nr 0 >= {
      nr.value nc.value:: grid:: 0$ == {
        false return
      } ifthen
    } ifthen
    nr 2$ 2 + =
    nr 9 < {
      nr.value nc.value:: grid:: 0$ == {
        false return
      } ifthen
    } ifthen
  } ifthen

  // Check Knight's move 1 right and 2 up and down.
  nc 1$ 1 + =
  nc 9 < {
    nr 2$ 2 - =
    nr 0 >= {
      nr.value nc.value:: grid:: 0$ == {
        false return
      } ifthen
    } ifthen
    nr 2$ 2 + =
    nr 9 < {
      nr.value nc.value:: grid:: 0$ == {
        false return
      } ifthen
    } ifthen
  } ifthen

  // Check Knight's move 2 right and 1 up and down.
  nc 1$ 2 + =
  nc 9 < {
    nr 2$ 1 - =
    nr 0 >= {
      nr.value nc.value:: grid:: 0$ == {
        false return
      } ifthen
    } ifthen
    nr 2$ 1 + =
    nr 9 < {
      nr.value nc.value:: grid:: 0$ == {
        false return
      } ifthen
    } ifthen
  } ifthen

  true
} =

// Set this to standardRegions for the usual 3x3 boxes,
// or irregularRegions to handle irregular, or jigsaw, regions.
regionChecker var

// Leave this undefined to get the standard sudoku rules, or set this
// to constraint code such as knightsMoveConstraint defined above.
constraint var

solve dup var { function
  r var
  c var
  n var

  r 0 =
  { r 9 < } {
    c 0 =
    { c 9 < } {
      r.value c.value:: grid:: dup 0 == {   // dup r.value c.value:: grid:: so we don't have to recalculate it in the inner loop.
        n 1 =
        { n 10 < } {
          r.value c.value n.value possible() {
            dup n =   // picking up r.value c.value:: grid:: again.
            solve()
            dup 0 =   // picking up r.value c.value:: grid:: again.
          } ifthen
          n++
        } while
        pop   // get rid of r.value c.value:: grid::
        return
      } ifthen
      pop   // get rid of r.value c.value:: grid::
      c++
    } while
    r++
  } while

  "" println
  printGrid()
  now time::() startTime - 1000.0 / "Solution in %0.3f seconds\n" printf
} =

found var
found false =

// As mentioned above, this is the example taken from the Computerphile video.
// Raspberry Pi3 Model A time: 17s to the solution, 19s to finish.
// The time spent between the solution and the finish is the script searching
// of other, non-existant, soultion.
whichSudoku 1 == {
  found true =
  "From Computerphile: https://www.youtube.com/watch?v=G_UYXzGuqvM" println
  regionChecker standardRegions =
  grid 0 5 3 0 0 7 0 0 0 0 setRow()
  grid 1 6 0 0 1 9 5 0 0 0 setRow()
  grid 2 0 9 8 0 0 0 0 6 0 setRow()
  grid 3 8 0 0 0 6 0 0 0 3 setRow()
  grid 4 4 0 0 8 0 3 0 0 1 setRow()
  grid 5 7 0 0 0 2 0 0 0 6 setRow()
  grid 6 0 6 0 0 0 0 2 8 0 setRow()
  grid 7 0 0 0 4 1 9 0 0 5 setRow()
  grid 8 0 0 0 0 8 0 0 7 9 setRow()
} ifthen

// From https://www.youtube.com/watch?v=MXUgYxHmKq4&t=0s
// This sudoku was featured on Cracking The Cryptic, and takes considerably longer than the one above.
// Pi3 Model A time: 3m 23s to the solution, 15m 11s to finish.
whichSudoku 2 == {
  found true =
  "From Cracking The Cryptic: https://www.youtube.com/watch?v=MXUgYxHmKq4&t=0s" println
  regionChecker standardRegions =
  grid 0 0 6 8 0 0 0 0 1 3 setRow()
  grid 1 0 0 0 9 0 1 0 0 0 setRow()
  grid 2 0 0 0 0 0 8 0 0 4 setRow()
  grid 3 0 1 0 0 4 0 5 0 0 setRow()
  grid 4 0 3 0 0 0 9 0 0 0 setRow()
  grid 5 0 8 5 0 0 0 0 7 0 setRow()
  grid 6 0 2 0 0 0 7 3 0 0 setRow()
  grid 7 0 0 0 0 9 4 0 0 6 setRow()
  grid 8 4 0 0 0 6 0 0 0 0 setRow()
} ifthen

// From https://www.youtube.com/watch?v=rQHV-gIAG_0
// Another Cracking The Cryptic video, this one with a Knight's move constraint.
// Pi3 Model A time: 48s to the solution, 6m 10s to finish.
whichSudoku 3 == {
  found true =
  "From Cracking The Cryptic: https://www.youtube.com/watch?v=rQHV-gIAG_0" println
  "This includes a Chess Knight's move constraint." println
  regionChecker standardRegions =
  constraint knightsMoveConstraint =
  grid 0 0 0 0 0 0 6 0 0 0 setRow()
  grid 1 0 0 3 0 0 0 0 0 7 setRow()
  grid 2 2 0 0 3 0 0 4 9 0 setRow()
  grid 3 6 0 0 0 0 0 0 4 5 setRow()
  grid 4 0 0 2 0 0 0 8 0 0 setRow()
  grid 5 0 0 0 1 0 0 0 0 0 setRow()
  grid 6 3 0 0 0 0 0 0 0 0 setRow()
  grid 7 7 0 0 0 0 1 0 0 9 setRow()
  grid 8 0 0 0 0 0 0 5 0 0 setRow()
} ifthen

// Another CTC sudoku: https://www.youtube.com/watch?v=vH-JooV8RA4&t=0s
// Pi3 Model A time: 1m 6s to the solution, 48m 35s to finish.
whichSudoku 4 == {
  found true =
  "From Cracking The Cryptic: https://www.youtube.com/watch?v=vH-JooV8RA4&t=0s" println
  regionChecker standardRegions =
  grid 0 0 0 0 0 0 0 0 0 0 setRow()
  grid 1 0 0 9 8 0 0 0 0 7 setRow()
  grid 2 0 8 0 0 6 0 0 5 0 setRow()
  grid 3 0 5 0 0 4 0 0 3 0 setRow()
  grid 4 0 0 7 9 0 0 0 0 2 setRow()
  grid 5 0 0 0 0 0 0 0 0 0 setRow()
  grid 6 0 0 2 7 0 0 0 0 9 setRow()
  grid 7 0 4 0 0 5 0 0 6 0 setRow()
  grid 8 3 0 0 0 0 6 2 0 0 setRow()
} ifthen

// Another Cracking The Cryptic sudoku: https://www.youtube.com/watch?v=eJIu8w3ZXo8
// This is an irregular (jigsaw) sudoku.
// Pi3 Model A time: 2m 5s to the solution, 7m 5s to finish.
whichSudoku 5 == {
  found true =
  "From Cracking The Cryptic: https://www.youtube.com/watch?v=eJIu8w3ZXo8" println
  "An irregular sudoku." println
  regionChecker irregularRegions =
  regions 0 1 1 1 1 1 2 2 2 2 setRow()
  regions 1 1 3 3 3 6 6 2 2 2 setRow()
  regions 2 1 3 3 3 6 7 7 7 2 setRow()
  regions 3 1 3 3 3 6 7 7 7 2 setRow()
  regions 4 1 6 6 6 6 7 7 7 8 setRow()
  regions 5 9 6 4 4 4 8 8 8 8 setRow()
  regions 6 9 9 4 4 4 8 5 5 5 setRow()
  regions 7 9 9 4 4 4 8 5 5 5 setRow()
  regions 8 9 9 9 9 8 8 5 5 5 setRow()
  grid 0 3 0 0 0 0 0 0 0 1 setRow()
  grid 1 0 9 0 1 7 2 0 0 0 setRow()
  grid 2 0 0 3 0 0 0 9 0 0 setRow()
  grid 3 0 7 0 0 0 0 0 4 0 setRow()
  grid 4 0 4 0 0 3 0 0 6 0 setRow()
  grid 5 0 5 0 0 0 0 0 9 0 setRow()
  grid 6 0 0 6 0 0 0 5 0 0 setRow()
  grid 7 0 0 0 8 5 6 0 2 0 setRow()
  grid 8 7 0 0 0 0 0 0 0 8 setRow()
} ifthen

// This is taken from Andrew Stuart's web site https://www.sudokuwiki.org/Daily_Jigsaw_Sudoku
// No. 4294, dated 13 Nov 2020. It is rated 5-star out of 6: Diabolical.
// The archived version is here: https://www.sudokuwiki.org/Print_Daily_Jigsaw.asp?day=13/11/2020
// At the time of writing, Andrew only archives sudoku's for 31 days, then they are deleted.
// The region layout is called "Andrew Stuart 24" and the numbering is taken directly
// from Andrew's solver page. A big thanks goes to Andrew for giving me permission to include this sudoku.
// The region numbers must be between 1 and 9 inclusive.
// Pi3 Model A time: 26m 23s to the solution, 1h 15m 20s to finish.
whichSudoku 6 == {
  found true =
  "From Andrew Stuart's web page: https://www.sudokuwiki.org/Daily_Jigsaw_Sudoku" println
  "No. 4294, dated 13 Nov 2020" println
  regionChecker irregularRegions =
  regions 0 1 1 2 2 2 2 3 3 4 setRow()
  regions 1 1 1 2 2 2 3 3 3 4 setRow()
  regions 2 1 1 1 2 3 3 3 4 4 setRow()
  regions 3 1 1 5 2 3 7 4 4 4 setRow()
  regions 4 5 5 5 6 6 7 7 4 4 setRow()
  regions 5 5 5 5 6 6 7 7 7 9 setRow()
  regions 6 8 5 5 6 6 7 7 7 9 setRow()
  regions 7 8 8 6 6 6 9 9 9 9 setRow()
  regions 8 8 8 8 8 8 8 9 9 9 setRow()
  grid 0 0 0 0 0 0 0 0 9 0 setRow()
  grid 1 5 0 0 0 8 1 0 0 0 setRow()
  grid 2 0 0 0 9 0 4 5 0 0 setRow()
  grid 3 0 0 0 0 0 0 0 0 5 setRow()
  grid 4 0 1 0 0 0 8 0 0 0 setRow()
  grid 5 7 0 6 0 0 0 0 0 0 setRow()
  grid 6 0 0 0 1 0 0 6 0 0 setRow()
  grid 7 1 0 0 7 2 0 0 0 0 setRow()
  grid 8 0 9 0 0 0 0 0 0 0 setRow()
} ifthen

// If you want to add your own sudoku, add it here.
whichSudoku 7 == {
  found true =
  // add it here
  // regionChecker standardRegions =          // Include a region checker
  // regionChecker irregularRegions =
  // constraint knightsMoveConstraint =       // Include any extra contraints, as appropriate
} ifthen

// Don't change anything from here to the end.

found {
  optimiseRegions()

  "" println
  "Initial grid" println
  printGrid()

  solve()

  now time::() startTime - 1000.0 / "Total runtime was %0.3f seconds\n" printf
} {
  whichSudoku "Sudoku %d not found\n" printf
} if

// I'd like to see an irregular sudoku with a knight's move constraint. Any takers...


with javascript_semantics
function read_table(string cb)
    sequence encode = repeat("",128),
             decode = repeat(0,128),
             row = {0}
    if length(cb)!=30 then crash("table wrong length") end if
    for i=1 to 30 do
        integer c = cb[i]
        if c=' ' then
            row &= i-1
        else
            integer code = row[floor((i-1)/10)+1]*10+mod((i-1),10)
            encode[c] = sprintf("%d",code)
            decode[code+1] = c
        end if
    end for
    return {encode, decode}
end function

function encipher(sequence encode, string s, bool strip=false)
    string res = ""
    for i=1 to length(s) do
        integer c = upper(s[i]), code
        if c>='0' and c<='9' then
            res &= encode['.']&c
        elsif c>='A' and c<='Z' then
            res &= encode[c]
        elsif not strip or c='/' then   -- (see note)
            res &= encode['/']
        end if
    end for
    return res
end function

function decipher(sequence decode, string s, bool strip=false)
    string res = ""
    integer i = 1
    while i<=length(s) do
        integer c = s[i]-'0'+1
        if decode[c]=0 then
            i += 1
            c = (c-1)*10+s[i]-'0'+1
        end if
        integer d = decode[c]
        if d='.' then
            i += 1
            d = s[i]
        elsif d='/' and not strip then  -- (see note)
            d = ' '
        end if
        res &= d
        i += 1
    end while
    return res
end function

constant cb =  "ET AON RIS"&
               "BCDFGHJKLM"&
               "PQ/UVWXYZ."
sequence {encode,decode} = read_table(cb)

--  Note there is a subtle difference in space handling, to exactly match other outputs try
--  {encode,decode} = read_table("HOL MES RTABCDFGIJKNPQUVWXYZ/.") instead of
--  {encode,decode} = read_table("HOL MES RTABCDFGIJKNPQUVWXYZ./"), and
--  {encode,decode} = read_table("ET AON RISBCDFGHJKLMPQ.UVWXYZ/") instead of
--  {encode,decode} = read_table("ET AON RISBCDFGHJKLMPQ/UVWXYZ.")

string msg = "In the winter 1965/we were hungry/just barely alive"
printf(1,"message: %s\n", {msg})
string enc = encipher(encode, msg),
       dec = decipher(decode, enc)
printf(1,"encoded: %s\n", {enc})
printf(1,"decoded: %s\n", {dec})

printf(1,"\nNo spaces:\n")
enc = encipher(encode, msg, true)
dec = decipher(decode, enc, true)
printf(1,"encoded: %s\n", {enc})
printf(1,"decoded: %s\n", {dec})


WITH
  symbols (d) AS (SELECT to_char(level) FROM dual CONNECT BY level <=  9)
, board   (i) AS (SELECT level          FROM dual CONNECT BY level <= 81)
, neighbors (i, j) AS (
    SELECT b1.i, b2.i
    FROM   board b1 INNER JOIN board b2
      ON   b1.i != b2.i
           AND (
                    MOD(b1.i - b2.i, 9) = 0
                 OR CEIL(b1.i /  9) = CEIL(b2.i /  9)
                 OR CEIL(b1.i / 27) = CEIL(b2.i / 27) AND trunc(MOD(b1.i - 1, 9) / 3) = trunc(MOD(b2.i - 1, 9) / 3)
               )
  )
, r (str, pos) AS (
    SELECT  :game, instr(:game, ' ')
      FROM  dual
    UNION ALL
    SELECT  substr(r.str, 1, r.pos - 1) || s.d || substr(r.str, r.pos + 1), instr(r.str, ' ', r.pos + 1)
      FROM  r INNER JOIN symbols s
        ON  r.pos > 0 AND NOT EXISTS (
                                       SELECT *
                                       FROM   neighbors n
                                       WHERE  r.pos = n.i AND s.d = substr(r.str, n.j, 1)
                                     )
  )
SELECT str
FROM   r
WHERE  pos = 0
;


(de *Straddling
   (NIL  "H"  "O"  "L"  NIL  "M"  "E"  "S"  NIL  "R"  "T")
   ("3"  "A"  "B"  "C"  "D"  "F"  "G"  "I"  "J"  "K"  "N")
   ("7"  "P"  "Q"  "U"  "V"  "W"  "X"  "Y"  "Z"  "."  "/")
   ("79" "0"  "1"  "2"  "3"  "4"  "5"  "6"  "7"  "8"  "9") )

(de straddle (Str)
   (pack
      (mapcar
         '((C)
            (pick
               '((L)
                  (and
                     (index C (cdr L))
                     (cons (car L) (dec @)) ) )
               *Straddling ) )
         (chop (uppc Str)) ) ) )

(de unStraddle (Str)
   (pack
      (make
         (for (L (chop Str)  L)
            (let C (pop 'L)
               (setq C
                  (if (assoc C *Straddling)
                     (get (cdr @) (inc (format (pop 'L))))
                     (get (cdar *Straddling) (inc (format C))) ) )
               (link (if (= "/" C) (pop 'L) C)) ) ) ) ) )


Procedure.s encrypt_SC(originalText.s, alphabet.s, blank_1, blank_2)
  Static notEscape.s = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ."
  Protected preDigit_1.s = Str(blank_1), preDigit_2.s = Str(blank_2)
  Protected i, index, curChar.s, escapeChar.s, outputText.s
  Protected NewMap cipher.s()

  ;build cipher reference
  alphabet = UCase(alphabet)
  For i = 1 To 28
    curChar = Mid(alphabet, i, 1)
    If Not FindString(notEscape, curChar)
      escapeChar = curChar
    EndIf

    Select i
      Case 1 To 8
        If index = blank_1 Or index = blank_2: index + 1: EndIf ;adjust index for blank

        cipher(curChar) = Str(index)
        index + 1
      Case 9 To 18
        cipher(curChar) = preDigit_1 + Str(i - 9)
      Case 19 To 28
        cipher(curChar) = preDigit_2 + Str(i - 19)
    EndSelect
  Next

  For i = 0 To 9: cipher(Str(i)) = cipher(escapeChar) + Str(i): Next

  ;encrypt each character
  originalText = UCase(originalText)
  Protected length = Len(originalText)
  For i = 1 To length
    outputText + cipher(Mid(originalText, i, 1))
  Next

  ProcedureReturn outputText
EndProcedure

Procedure.s decrypt_SC(cipherText.s, alphabet.s, blank_1, blank_2)
  Static notEscape.s = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ."
  Protected preDigit_1.s = Str(blank_1), preDigit_2.s = Str(blank_2)
  Protected i, index, curChar.s, escapeCipher.s, outputText.s
  Protected NewMap cipher.s()

  ;build decipher reference
  alphabet = UCase(alphabet)
  For i = 1 To 28
    curChar = Mid(alphabet, i, 1)

    Select i
      Case 1 To 8
        If index = blank_1 Or index = blank_2: index + 1: EndIf ;adjust index for blank

        cipher(Str(index)) = curChar
        index + 1
      Case 9 To 18
        cipher(preDigit_1 + Str(i - 9)) = curChar
      Case 19 To 28
        cipher(preDigit_2 + Str(i - 19)) = curChar
    EndSelect
    If Not FindString(notEscape, curChar)
      escapeCipher = MapKey(cipher())
    EndIf
  Next

  For i = 0 To 9: cipher(escapeCipher + Str(i)) = Str(i): Next

  ;decrypt each character
  Protected length = Len(cipherText)
  index = 1
  While index <=length
    curChar = Mid(cipherText, index, 1)
    If curChar = preDigit_1 Or curChar = preDigit_2
      curChar = Mid(cipherText, index, 2)
      If curChar = escapeCipher: curChar = Mid(cipherText, index, 3): EndIf
    EndIf
    outputText + cipher(curChar)
    index + Len(curChar)
  Wend

  ProcedureReturn outputText
EndProcedure

If OpenConsole()
  Define message.s = "One night-it was on the twentieth of March, 1888-I was returning"
  Define cipher.s = "HOLMESRTABCDFGIJKNPQUVWXYZ./", encoded.s

  PrintN("Original: " + message)
  encoded = encrypt_SC(message, cipher, 3, 7)
  PrintN("encoded: " + encoded)
  PrintN("decoded: " + decrypt_SC(encoded, cipher, 3, 7))

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf


import Foundation

typealias SodukuPuzzle = [[Int]]

class Soduku {
    let mBoardSize:Int!
    let mBoxSize:Int!
    var mBoard:SodukuPuzzle!
    var mRowSubset:[[Bool]]!
    var mColSubset:[[Bool]]!
    var mBoxSubset:[[Bool]]!

    init(board:SodukuPuzzle) {
        mBoard = board
        mBoardSize = board.count
        mBoxSize = Int(sqrt(Double(mBoardSize)))
        mRowSubset = [[Bool]](count: mBoardSize, repeatedValue: [Bool](count: mBoardSize, repeatedValue: false))
        mColSubset = [[Bool]](count: mBoardSize, repeatedValue: [Bool](count: mBoardSize, repeatedValue: false))
        mBoxSubset = [[Bool]](count: mBoardSize, repeatedValue: [Bool](count: mBoardSize, repeatedValue: false))
        initSubsets()
    }

    func computeBoxNo(i:Int, _ j:Int) -> Int {
        let boxRow = i / mBoxSize
        let boxCol = j / mBoxSize

        return boxRow * mBoxSize + boxCol
    }

    func initSubsets() {
        for i in 0..<mBoard.count {
            for j in 0..<mBoard.count {
                let value = mBoard[i][j]

                if value != 0 {
                    setSubsetValue(i, j, value, true);
                }
            }
        }
    }

    func isValid(i:Int, _ j:Int, var _ val:Int) -> Bool {
        val--
        let isPresent = mRowSubset[i][val] || mColSubset[j][val] || mBoxSubset[computeBoxNo(i, j)][val]
        return !isPresent
    }

    func printBoard() {
        for i in 0..<mBoardSize {
            if i % mBoxSize == 0 {
                println(" -----------------------")
            }

            for j in 0..<mBoardSize {
                if j % mBoxSize == 0 {
                    print("| ")
                }

                print(mBoard[i][j] != 0 ? String(mBoard[i][j]) : " ")
                print(" ")
            }

            println("|")
        }

        println(" -----------------------")
    }

    func setSubsetValue(i:Int, _ j:Int, _ value:Int, _ present:Bool) {
        mRowSubset[i][value - 1] = present
        mColSubset[j][value - 1] = present
        mBoxSubset[computeBoxNo(i, j)][value - 1] = present
    }

    func solve() {
        solve(0, 0)
    }

    func solve(var i:Int, var _ j:Int) -> Bool {
        if i == mBoardSize {
            i = 0
            j++
            if j == mBoardSize {
                return true
            }
        }

        if mBoard[i][j] != 0 {
            return solve(i + 1, j)
        }

        for value in 1...mBoardSize {
            if isValid(i, j, value) {
                mBoard[i][j] = value
                setSubsetValue(i, j, value, true)

                if solve(i + 1, j) {
                    return true
                }

                setSubsetValue(i, j, value, false)
            }
        }

        mBoard[i][j] = 0
        return false
    }
}

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

let puzzle = Soduku(board: board)
puzzle.solve()
puzzle.printBoard()


#lang racket

(struct *straddling (header main original)
  #:reflection-name 'straddling
  #:methods gen:custom-write
  [(define (write-proc board port mode)
     (write-string "#<straddling " port)
     (write (*straddling-original board) port)
     (write-string ">" port))])

(define string->vector (compose list->vector string->list))

(define (straddling . lines)
  (define header-tail (reverse
                       (for/fold ([rev-ret '()])
                                 ([char (in-list (string->list (car lines)))]
                                  [i (in-naturals)])
                         (if (equal? char #\space)
                             (cons (number->string i) rev-ret)
                             rev-ret))))
  (define main (list->vector
                (map string->vector
                     (cons "0123456789"
                           (map string-upcase
                                lines)))))
  (define temporal-board
    (*straddling (list->vector (list* "?" "" header-tail)) main lines))
  (define escape (straddling-encode-char #\/ temporal-board))
  (*straddling (list->vector (list* escape "" header-tail)) main lines))


//////////////////////////////////////////////////////////////////////////////
/// SudokuSolver                                                           ///
///    A class that fills up a sudoku board, the initial board is given    ///
///    as an array preset_rows, the positions where preset_rows is zero    ///
///    are to be determined. Three views of the sudoku board are created   ///
///    and the uniqueness of its elements are defined by on constraint for ///
///    each view, one constraint ensures that the values are between 1 and ///
///    9, and two other constraints are used to ensure that the values in  ///
///    all three views agree to each other.                                ///
///                                                                        ///
///                                                                        ///
///    A solution using only the "rows" array would be possible, however   ///
///    this illustrates better how one can relate different variables in   ///
///    SystemVerilog Constrained randomization.                            ///
//////////////////////////////////////////////////////////////////////////////
class SudokuSolver;
  rand int tiles[0:8][0:8];
  rand int rows[0:8][0:8];
  rand int cols[0:8][0:8];
  int preset_rows[0:8][0:8];
  constraint board_input {
    foreach(preset_rows[i])foreach(preset_rows[i][j])
       if(preset_rows[i][j] != 0) rows[i][j] == preset_rows[i][j];
  }
  constraint range {
    foreach(rows[i]) foreach(rows[i][j])
        rows[i][j] inside {[1:9]};
  }
  ////////////////////////////////////////////////
  /// Every number in a row is unique          ///
  ////////////////////////////////////////////////
  constraint rows_permutation {
    foreach(rows[i]) foreach(rows[i][j1])
                     foreach(rows[i][j2])
      if(j1 != j2) rows[i][j1] != rows[i][j2];
  }
  ///////////////////////////////////////////////
  /// Every number in a column is unique      ///
  ///////////////////////////////////////////////
  constraint cols_permutation {
    foreach(cols[i]) foreach(cols[i][j1])
                     foreach(cols[i][j2])
      if(j1 != j2) cols[i][j1] != cols[i][j2];
  }
  /////////////////////////////////////////////////
  /// Every number in a tile (square) is unique ///
  /////////////////////////////////////////////////
  constraint tiles_permutation {
    foreach(tiles[i]) foreach(tiles[i][j1])
                     foreach(tiles[i][j2])
      if(j1 != j2) tiles[i][j1] != tiles[i][j2];
  }
  ///////////////////////////////////////////////////
  /// Makes sure that sure that the numbers in    ///
  /// each view agree with other views            ///
  ///////////////////////////////////////////////////
  constraint rows_vs_tiles {
    foreach(tiles[i]) foreach(tiles[i][j])
      tiles[i][j] == rows[(i/3) * 3 + (j/3)][3*(i%3)+(j%3)];
  }
  constraint rows_vs_cols {
    foreach(cols[i]) foreach(cols[i][j])
      cols[i][j] == rows[j][i];
  }
  ///////////////////////////////////////////////////
  /// Print the current state of the board in the ///
  /// standard output                             ///
  ///////////////////////////////////////////////////
  function void printBoard;
    int i, j;
    for(i = 0; i < 9; ++i) begin
      if(i % 3 == 0)$display("   -------------");
      $write("   ");
      for(j = 0; j < 9; ++j) begin
        if(j % 3 == 0) $write("|");
        $write("%c", "0" + rows[i][j]);
      end
      $display("|");
    end
    $display("   -------------");
  endfunction
  function void printInitial;
    int i, j;
    for(i = 0; i < 9; ++i) begin
      if(i % 3 == 0)$display("-------------");
      for(j = 0; j < 9; ++j) begin
        if(j % 3 == 0) $write("|");
        if(preset_rows[i][j]) begin
          $write("%c", "0" + preset_rows[i][j]);
        end
        else begin
          $write(".");
        end
      end
      $display("|");
    end
    $display("-------------");
  endfunction

endclass

//////////////////////////////////////////////////////
/// Simple program instantiating the sudoku object ///
//////////////////////////////////////////////////////
program SudokuTest;
  SudokuSolver board;
initial begin
  board = new;
  foreach(board.preset_rows[0][i]) board.preset_rows[i][i] = i+1;
  $display("Initial Board:");
  board.printInitial();
  // Generate two different solutions for the board
  if(board.randomize())begin
    $display("One solution:");
    board.printBoard();
  end
  else begin
    $display("ERROR: Failed to generate first solution");
  end
  if(board.randomize())begin
    $display("Another solution:");
    board.printBoard();
  end
  else begin
    $display("ERROR: Failed to generate second solution");
  end
end
endprogram


class Straddling_Checkerboard {
    has @!flat_board; # 10x3 stored as 30x1
    has $!plain2code; # full translation table, invertable
    has @!table;      # Printable layout, like Wikipedia entry

    my $numeric_escape = '/';
    my $exclude = /<-[A..Z0..9.]>/; # Omit the escape character

    method display_table { gather { take ~ .list for @!table } };

    method decode ( Str $s --> Str ) {
        $s.trans($!plain2code.antipairs);
    }

    method encode ( Str $s, :$collapse? --> Str ) {
        my $replace = $collapse ?? '' !! '.';
        $s.uc.subst( $exclude, $replace, :g ).trans($!plain2code);
    }

    submethod BUILD ( :$alphabet, :$u where 0..9, :$v where 0..9 ) {
        die if $u == $v;
        die if $alphabet.comb.sort.join ne [~] flat './', 'A'..'Z';

        @!flat_board = $alphabet.uc.comb;
        @!flat_board.splice( $u min $v, 0, Any );
        @!flat_board.splice( $u max $v, 0, Any );

        @!table = [ ' ',|            [ 0 ..  9]                              ],
                  [ ' ',|@!flat_board[ 0 ..  9].map: {.defined ?? $_ !! ' '} ],
                  [ $u, |@!flat_board[10 .. 19]                              ],
                  [ $v, |@!flat_board[20 .. 29]                              ];

        my @order = 0..9; # This may be passed as a param in the future

        my @nums = flat @order,
                   @order.map({ +"$u$_" }),
                   @order.map({ +"$v$_" });

        my %c2p = @nums Z=> @!flat_board;
        %c2p{$_}:delete if %c2p{$_} eqv Any for keys %c2p;
        my %p2c = %c2p.invert;
        %p2c{$_} = %p2c{$numeric_escape} ~ $_ for 0..9;
        $!plain2code = [%p2c.keys] => [%p2c.values];
    }
}

sub MAIN ( :$u = 3, :$v = 7, :$alphabet = 'HOLMESRTABCDFGIJKNPQUVWXYZ./' ) {
    my Straddling_Checkerboard $sc .= new: :$u, :$v, :$alphabet;
    $sc.display_table;

    for 0..1 -> $collapse {
        my $original = 'One night-it was on the twentieth of March, 1888-I was returning';
        my $en = $sc.encode($original, :$collapse);
        my $de = $sc.decode($en);
        say '';
        say "Original: $original";
        say "Encoded:  $en";
        say "Decoded:  $de";
    }
}


templates deduceRemainingDigits
  data row <"1">, col <"1"> local
  templates findOpenPosition
    @:{options: 10};
    $ -> \[i;j](when <[]([email protected])> do @findOpenPosition: {row: $i, col: $j, options: $::length}; \) -> !VOID
    [email protected] !
  end findOpenPosition

  templates selectFirst&{pos:}
    def digit: $($pos.row;$pos.col) -> $(1);
    $ -> \[i;j](
      when <?($i <=$pos.row>)?($j <=$pos.col>)> do $digit !
      when <[]?($i <=$pos.row>)
      |[]?($j <=$pos.col>)
      |[]?(($i-1)~/3 <=($pos.row-1)~/3>)?(($j-1)~/3 <=($pos.col-1)~/3>)> do [$... -> \(when <~=$digit> do $! \)] !
      otherwise $ !
    \) !
  end selectFirst

  @: $;
  $ -> findOpenPosition -> #
  when <{options: <=0>}> do [] !
  when <{options: <=10>}> do [email protected] !
  otherwise def next: $;
     [email protected] -> selectFirst&{pos: $next} -> deduceRemainingDigits
        -> \(when <~=[]> do @deduceRemainingDigits: $; {options: 10} !
          when <=[]> do ^@deduceRemainingDigits($next.row;$next.col;1)
               -> { $next..., options: $next.options::raw-1} ! \) -> #
end deduceRemainingDigits

test 'internal solver'
  def sample: [
    [5,3,4,6,7,8,9,1,2],
    [6,7,2,1,9,5,3,4,8],
    [1,9,8,3,4,2,5,6,7],
    [8,5,9,7,6,1,4,2,3],
    [4,2,6,8,5,3,7,9,1],
    [7,1,3,9,2,4,8,5,6],
    [9,6,1,5,3,7,2,8,4],
    [2,8,7,4,1,9,6,3,5],
    [3,4,5,2,8,6,1,7,9]
  ];

  assert $sample -> deduceRemainingDigits <=$sample> 'completed puzzle unchanged'

  assert [
    [[5],3,4,6,7,8,9,1,2],
    $sample(2..last)...] -> deduceRemainingDigits <=$sample> 'final digit gets placed'

  assert [
    [[],3,4,6,7,8,9,1,2],
    $sample(2..last)...] -> deduceRemainingDigits <=[]> 'no remaining options returns empty'

  assert [
    [[5],3,4,6,[2,5,7],8,9,1,[2,5]],
    $sample(2..last)...] -> deduceRemainingDigits <=$sample> 'solves 3 digits on row'

  assert [
    [5,3,4,6,7,8,9,1,2],
    [[6,7,9],7,2,1,9,5,3,4,8],
    [1,9,8,3,4,2,5,6,7],
    [8,5,9,7,6,1,4,2,3],
    [4,2,6,8,5,3,7,9,1],
    [[7],1,3,9,2,4,8,5,6],
    [[7,9],6,1,5,3,7,2,8,4],
    [2,8,7,4,1,9,6,3,5],
    [3,4,5,2,8,6,1,7,9]
  ] -> deduceRemainingDigits <=$sample> 'solves 3 digits on column'

  assert [
    [5,3,[4,6],6,7,8,9,1,2],
    [[6],7,2,1,9,5,3,4,8],
    [1,[4,6,9],8,3,4,2,5,6,7],
    $sample(4..last)...
  ] -> deduceRemainingDigits <=$sample> 'solves 3 digits in block'

  // This gives a contradiction if 3 gets chosen out of [3,5]
  assert [
    [[3,5],[3,4,6],[3,4,6],[3,4,6],7,8,9,1,2],
    $sample(2..last)...] -> deduceRemainingDigits <=$sample> 'contradiction is backtracked'
end 'internal solver'

composer parseSudoku
  [<section>=3]
  rule section: <row>=3 (<'-+'>? <WS>?)
  rule row: [<triple>=3] (<WS>?)
  rule triple: <digit|dot>=3 (<'\|'>?)
  rule digit: [<'\d'>]
  rule dot: <'\.'> -> [1..9 -> '$;']
end parseSudoku

test 'input sudoku'
def parsed:
'53.|.7.|...
 6..|195|...
 .98|...|.67
 -----------
 8..|.6.|..3
 4..|8.3|..1
 7..|.2.|..6
 -----------
 .6.|...|28.
 ...|419|..5
 ...|.8.|.79' -> parseSudoku;

  assert $parsed <[<[<[]>=9](9)>=9](9)> 'parsed sudoku has 9 rows containing 9 columns of lists'
  assert $parsed(1;1) <=['5']> 'a digit'
  assert $parsed(1;3) <=['1','2','3','4','5','6','7','8','9']> 'a dot'
end 'input sudoku'

templates solveSudoku
  $ -> parseSudoku -> deduceRemainingDigits -> #
  when <=[]> do 'No result found' !
  when <> do $ -> \[i](
       '$(1..3)...;|$(4..6)...;|$(7..9)...;$#10;' !
       $i -> \(when <=3|=6> do '-----------$#10;' !\) !
     \) -> '$...;' !
end solveSudoku

test 'sudoku solver'
  assert
'53.|.7.|...
 6..|195|...
 .98|...|.67
 -----------
 8..|.6.|..3
 4..|8.3|..1
 7..|.2.|..6
 -----------
 .6.|...|28.
 ...|419|..5
 ...|.8.|.79'
  -> solveSudoku <=
'534|678|912
672|195|348
198|342|567
-----------
859|761|423
426|853|791
713|924|856
-----------
961|537|284
287|419|635
345|286|179
'> 'solves sudoku and outputs pretty solution'
end 'sudoku solver'


/*REXX program uses the  straddling checkerboard  cipher to encrypt/decrypt a message.  */
parse arg msg                                    /*obtain optional message from the C.L.*/
if msg=''  then msg= 'One night-it was the twentieth of March, 1888-I was returning'
                      say 'plain text='  msg
call genCipher  'et aon ris',  'bcdfghjklm',  'pq/uvwxyz.'    /*build the cipher (board)*/
enc= encrypt(msg);     say ' encrypted='  enc    /*encrypt message and show encryption. */
dec= decrypt(enc);     say ' decrypted='  dec    /*decrypt    "     "    "  decryption. */
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
genCipher: @.=;   arg @..,two,three;    z= -1;  @.z= @..      /*build top row of cipher.*/
           _= pos(' ', @..     )  - 1;  @._= two              /*  "   2nd  "   "    "   */
           _= pos(' ', @.., _+2)  - 1;  @._= three            /*  "   3rd  "   "    "   */
             do j=0  for 9;    @..= @.. || @.j   /*construct a table for fast searching.*/
             if @.j\==''  then @.r= @.r || j
             _= pos('/', @.j)                    /*is the escape character in this row? */
             if _\==0  then @.dig= j || (_-1)    /*define    "       "     for numerals.*/
             end   /*j*/
           @..= space(@.., 0);       return      /*purify the table of encryptable chars*/
/*──────────────────────────────────────────────────────────────────────────────────────*/
encrypt: procedure expose @.;  arg !,,$          /*$:  output  (encrypted text)  so far.*/
           do j=1  for length(!)                 /*process each of the plain─text chars.*/
           x= substr(!, j, 1)                    /*obtain a message char to be encrypted*/
           if datatype(x, 'W')  then do;  $= $ || @.dig || x;  iterate;  end  /*numeral?*/
           if pos(x, @..)==0    then iterate     /*Not one of the allowable chars?  Skip*/
              do k=-1  for 10;  y= pos(x, @.k)   /*traipse thru rows, looking for match.*/
              if y==0           then iterate     /*Not in this row?   Then keep looking.*/
              z= k;   if z==-1  then z=          /*construct the index of the cypher row*/
              $= $  ||  z  ||  (y-1);  leave     /*add an encrypted character to output.*/
              end   /*k*/
           end      /*j*/;      return $
/*──────────────────────────────────────────────────────────────────────────────────────*/
decrypt: procedure expose @.;     parse arg !,,$ /*$:  output  (decrypted text)  so far.*/
           do j=1  to length(!);    rw= -1       /*process each of the encypted numbers.*/
           x= substr(!,j,1)                      /*obtain a message char to be decrypted*/
           if substr(!,j,2)[email protected].dig  then do; j= j+2; $= $ || substr(!, j, 1); iterate; end
           if pos(x, @.r)\==0       then do; j= j+1; rw=x; x=substr(!, j, 1);          end
           $= $ || substr(@.rw, x+1, 1)          /*add a character to decrypted message.*/
           end   /*j*/;             return $


package require Tcl 8.6
oo::class create Sudoku {
    variable idata

    method clear {} {
	for {set y 0} {$y < 9} {incr y} {
	    for {set x 0} {$x < 9} {incr x} {
		my set $x $y {}
	    }
	}
    }
    method load {data} {
	set error "data must be a 9-element list, each element also being a\
		list of 9 numbers from 1 to 9 or blank or an @ symbol."
	if {[llength $data] != 9} {
	    error $error
	}
	for {set y 0} {$y<9} {incr y} {
	    set row [lindex $data $y]
	    if {[llength $row] != 9} {
		error $error
	    }
	    for {set x 0} {$x<9} {incr x} {
		set d [lindex $row $x]
		if {![regexp {^[@1-9]?$} $d]} {
		    error $d-$error
		}
		if {$d eq "@"} {set d ""}
		my set $x $y $d
	    }
	}
    }
    method dump {} {
	set rows {}
	for {set y 0} {$y < 9} {incr y} {
	    lappend rows [my getRow 0 $y]
	}
	return $rows
    }

    method Log msg {
	# Chance to print message
    }

    method set {x y value} {
	if {[catch {set value [format %d $value]}]} {set value 0}
	if {$value<1 || $value>9} {
	    set idata(sq$x$y) {}
	} else {
	    set idata(sq$x$y) $value
	}
    }
    method get {x y} {
	if {![info exists idata(sq$x$y)]} {
	    return {}
	}
	return $idata(sq$x$y)
    }

    method getRow {x y} {
	set row {}
	for {set x 0} {$x<9} {incr x} {
	    lappend row [my get $x $y]
	}
	return $row
    }
    method getCol {x y} {
	set col {}
	for {set y 0} {$y<9} {incr y} {
	    lappend col [my get $x $y]
	}
	return $col
    }
    method getRegion {x y} {
	set xR [expr {($x/3)*3}]
	set yR [expr {($y/3)*3}]
	set regn {}
	for {set x $xR} {$x < $xR+3} {incr x} {
	    for {set y $yR} {$y < $yR+3} {incr y} {
		lappend regn [my get $x $y]
	    }
	}
	return $regn
    }
}

# SudokuSolver inherits from Sudoku, and adds the ability to filter
# possibilities for a square by looking at all the squares in the row, column,
# and region that the square is a part of. The method 'solve' contains a list
# of rule-objects to use, and iterates over each square on the board, applying
# each rule sequentially until the square is allocated.

oo::class create SudokuSolver {
    superclass Sudoku
    method validchoices {x y} {
	if {[my get $x $y] ne {}} {
	    return [my get $x $y]
	}

	set row [my getRow $x $y]
	set col [my getCol $x $y]
	set regn [my getRegion $x $y]
	set eliminate [list {*}$row {*}$col {*}$regn]
	set eliminate [lsearch -all -inline -not $eliminate {}]
	set eliminate [lsort -unique $eliminate]

	set choices {}
	for {set c 1} {$c < 10} {incr c} {
	    if {$c ni $eliminate} {
		lappend choices $c
	    }
	}
	if {[llength $choices]==0} {
	    error "No choices left for square $x,$y"
	}
	return $choices
    }
    method completion {} {
	return [expr {
	    81-[llength [lsearch -all -inline [join [my dump]] {}]]
	}]
    }
    method solve {} {
	foreach ruleClass [info class subclass Rule] {
	    lappend rules [$ruleClass new]
	}

	while {1} {
	    set begin [my completion]
	    for {set y 0} {$y < 9} {incr y} {
		for {set x 0} {$x < 9} {incr x} {
		    if {[my get $x $y] eq ""} {
			foreach rule $rules {
			    set c [$rule solve [self] $x $y]
			    if {$c} {
				my set $x $y $c
				my Log "[info object class $rule] solved [self] at $x,$y for $c"
				break
			    }
			}
		    }
		}
	    }
	    set end [my completion]
	    if {$end==81} {
		my Log "Finished solving!"
		break
	    } elseif {$begin==$end} {
		my Log "A round finished without solving any squares, giving up."
		break
	    }
	}
	foreach rule $rules {
	    $rule destroy
	}
    }
}

# Rule is the template for the rules used in Solver. The other rule-objects
# apply their logic to the values passed in and return either '0' or a number
# to allocate to the requested square.
oo::class create Rule {
    method solve {hSudoku x y} {
	if {![info object isa typeof $hSudoku SudokuSolver]} {
	    error "hSudoku must be an instance of class SudokuSolver."
	}

	tailcall my Solve $hSudoku $x $y [$hSudoku validchoices $x $y]
    }
}

# Get all the allocated numbers for each square in the the row, column, and
# region containing $x,$y. If there is only one unallocated number among all
# three groups, it must be allocated at $x,$y
oo::class create RuleOnlyChoice {
    superclass Rule
    method Solve {hSudoku x y choices} {
	if {[llength $choices]==1} {
	    return $choices
	} else {
	    return 0
	}
    }
}

# Test each column to determine if $choice is an invalid choice for all other
# columns in row $X. If it is, it must only go in square $x,$y.
oo::class create RuleColumnChoice {
    superclass Rule
    method Solve {hSudoku x y choices} {
	foreach choice $choices {
	    set failed 0
	    for {set x2 0} {$x2<9} {incr x2} {
		if {$x2 != $x && $choice in [$hSudoku validchoices $x2 $y]} {
		    set failed 1
		    break
		}
	    }
	    if {!$failed} {return $choice}
	}
	return 0
    }
}

# Test each row to determine if $choice is an invalid choice for all other
# rows in column $y. If it is, it must only go in square $x,$y.
oo::class create RuleRowChoice {
    superclass Rule
    method Solve {hSudoku x y choices} {
	foreach choice $choices {
	    set failed 0
	    for {set y2 0} {$y2<9} {incr y2} {
		if {$y2 != $y && $choice in [$hSudoku validchoices $x $y2]} {
		    set failed 1
		    break
		}
	    }
	    if {!$failed} {return $choice}
	}
	return 0
    }
}

# Test each square in the region occupied by $x,$y to determine if $choice is
# an invalid choice for all other squares in that region. If it is, it must
# only go in square $x,$y.
oo::class create RuleRegionChoice {
    superclass Rule
    method Solve {hSudoku x y choices} {
	foreach choice $choices {
	    set failed 0
	    set regnX [expr {($x/3)*3}]
	    set regnY [expr {($y/3)*3}]
	    for {set y2 $regnY} {$y2 < $regnY+3} {incr y2} {
		for {set x2 $regnX} {$x2 < $regnX+3} {incr x2} {
		    if {
			($x2!=$x || $y2!=$y)
			&& $choice in [$hSudoku validchoices $x2 $y2]
		    } then {
			set failed 1
			break
		    }
		}
	    }
	    if {!$failed} {return $choice}
	}
	return 0
    }
}


class StraddlingCheckerboard
  EncodableChars = "A-Z0-9."
  SortedChars = "  ./" + [*"A".."Z"].join

  def initialize(board = nil)
    if board.nil?
      # create a new random board
      rest = "BCDFGHJKLMPQUVWXYZ/.".chars.shuffle
      @board = ["  ESTONIAR".chars.shuffle, rest[0..9], rest[10..19]]
    elsif board.chars.sort.join == SortedChars
      @board = board.chars.each_slice(10).to_a
    else
      raise ArgumentError, "invalid #{self.class}: #{board}"
    end
    # find the indices of the first row blanks
    @row_labels = @board[0].each_with_index.select {|v, i| v == " "}.map {|v,i| i}

    @mapping = {}
    @board[0].each_with_index {|char, idx| @mapping[char] = idx.to_s unless char == " "}
    @board[1..2].each_with_index do |row, row_idx|
      row.each_with_index do |char, idx|
        @mapping[char] = "%d%d" % [@row_labels[row_idx], idx]
      end
    end
  end

  def encode(message)
    msg = message.upcase.delete("^#{EncodableChars}")
    msg.chars.inject("") do |crypt, char|
      crypt << (char =~ /[0-9]/ ? @mapping["/"] + char : @mapping[char])
    end
  end

  def decode(code)
    msg = ""
    tokens = code.chars
    until tokens.empty?
      token = tokens.shift
      itoken = token.to_i
      unless @row_labels.include?(itoken)
        msg << @board[0][itoken]
      else
        token2 = tokens.shift
        if @mapping["/"] == token + token2
          msg << tokens.shift
        else
          msg << @board[[email protected]_labels.index(itoken)][token2.to_i]
        end
      end
    end
    msg
  end

  def to_s
    @board.inject("") {|res, row| res << row.join}
  end

  def inspect
    "#<%s board=%p, row_labels=%p, mapping=%p>" % [self.class, to_s, @row_labels, @mapping]
  end
end


#import std
#import nat

sudoku =

@FL mat0+ block3+ mat` *+ block3*+ block9+ -+
   ~&rSL+ (psort (nleq+)* <~&blrl,~&blrr>)+ ~&arg^& -+
      ~&al?\~&ar ~&aa^&~&afahPRPfafatPJPRY+ ~&farlthlriNCSPDPDrlCS2DlrTS2J,
      ^|J/~& ~&rt!=+ ^= ~&s+ ~&H(
         -+.|=&lrr;,|=&lrl;,|=≪+-,
         ~&rgg&& ~&irtPFXlrjrXPS; ~&lrK2tkZ2g&& ~&llrSL2rDrlPrrPljXSPTSL)+-,
   //~&p ^|DlrDSLlrlPXrrPDSL(~&,num*+ rep2 block3)*= num block27 ~&iiK0 iota9,
   * `0?=\~&iNC ! ~&t digits+-


package require Tcl 8.6

oo::class create StraddlingCheckerboardCypher {
    variable encmap decmap
    constructor table {
	# Sanity check the table
	foreach ch [lindex $table 0] i {"" 0 1 2 3 4 5 6 7 8 9} {
	    if {$ch eq "" && $i ne "" && [lsearch -index 0 $table $i] < 1} {
		error "bad checkerboard table"
	    }
	}
	# Synthesize the escaped number row
	foreach row $table {
	    if {"/" ni $row} continue
	    set pfx [lindex $row 0][expr {[lsearch -exact $row "/"]-1}]
	    lappend table [list $pfx 0 1 2 3 4 5 6 7 8 9]
	    break
	}
	# Build the actual per-character mapping
	foreach row $table {
	    foreach ch [lrange $row 1 end] n {0 1 2 3 4 5 6 7 8 9} {
		if {$ch in {"" "/"}} continue;  # Skip escape cases
		lappend encmap $ch [lindex $row 0]$n
		lappend decmap [lindex $row 0]$n $ch
	    }
	}
    }

    # These methods just sanitize their input and apply the map
    method encode msg {
	string map $encmap [regsub -all {[^A-Z0-9.]} [string toupper $msg] ""]
    }
    method decode msg {
	string map $decmap [regsub -all {[^0-9]} $msg ""]
    }
}


' Straddling checkerboard - VBScript - 19/04/2019

Function encrypt(ByVal originalText, ByVal alphabet, blank1, blank2)
  Const notEscape = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ."
  Dim i, j, curChar, escChar, outText
  Dim cipher  'Hash table
  Set cipher = CreateObject("Scripting.Dictionary")
  'build cipher reference
  alphabet = UCase(alphabet) : j = 0
  For i = 1 To 28
    curChar = Mid(alphabet, i, 1)
    Select Case True
      Case i>= 1 And i<= 8
        If j = blank1 Or j = blank2 Then j = j + 1  'adjust for blank
		cipher.Add curChar, CStr(j)
        j = j + 1
      Case i>= 9 And i<=18
		cipher.Add curChar, CStr(blank1) & CStr(i -  9)
      Case i>=19 And i<=28
		cipher.Add curChar, CStr(blank2) & CStr(i - 19)
    End Select 'i
    If InStr(notEscape, curChar) = 0 Then
      escChar = curChar
      'Wscript.Echo "escChar=" & escChar & "  cipher(escChar)=" & cipher(escChar)
    End If
  Next 'i
  For i = 0 To 9: cipher.Add CStr(i), cipher(escChar) & CStr(i): Next
  'encrypt each character
  originalText = UCase(originalText)
  For i = 1 To Len(originalText)
    outText = outText & cipher(Mid(originalText, i, 1))
  Next
  encrypt=outText
End Function 'encrypt

Function decrypt(ByVal cipherText, ByVal alphabet, blank1, blank2)
  Const notEscape = "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ."
  Dim i, j, curChar, escCipher, outText
  Dim cipher  'Hash table
  Set cipher = CreateObject("Scripting.Dictionary")
  'build decipher reference
  alphabet = UCase(alphabet) : j = 0
  For i = 1 To 28
    curChar = Mid(alphabet, i, 1)
    Select Case True
      Case i>= 1 And i<= 8
        If j = blank1 Or j = blank2 Then j = j + 1  'adjust for blank
		cipher.Add CStr(j),curChar
        j = j + 1
      Case i>= 9 And i<=18
        cipher.Add CStr(blank1) & CStr(i -  9), curChar
      Case i>=19 And i<=28
        cipher.Add CStr(blank2) & CStr(i - 19), curChar
    End Select 'i
    If InStr(notEscape, curChar) = 0 Then
      'the last element of cipher
      arrayKeys=cipher.keys
      escCipher = arrayKeys(cipher.count-1)
      'Wscript.Echo "escCipher=" & escCipher & "  cipher(escCipher)=" & cipher(escCipher)
    End If
  Next 'i
  For i = 0 To 9: cipher.Add escCipher & CStr(i), CStr(i): Next
  'decrypt each character
  i = 1
  Do While i <= Len(cipherText)
    curChar = Mid(cipherText, i, 1)
    If curChar = CStr(blank1) Or curChar = CStr(blank2) Then
      curChar = Mid(cipherText, i, 2)
      If curChar = escCipher Then curChar = Mid(cipherText, i, 3)
    End If
    outText = outText & cipher(curChar)
    i = i + Len(curChar)
  Loop 'i
  decrypt=outText
End Function 'decrypt

  message = "One night-it was on the twentieth of March, 1888-I was returning"
  cipher = "HOLMESRTABCDFGIJKNPQUVWXYZ./"
  '3 7         <=8
  'HOL MES RT
  'ABCDFGIJKN
  'PQUVWXYZ./
  Buffer=Buffer & "Original: " & message & vbCrlf
  encoded = encrypt(message, cipher, 3, 7)
  Buffer=Buffer &  "encoded: " & encoded & vbCrlf
  decoded = decrypt(encoded, cipher, 3, 7)
  Buffer=Buffer &  "decoded: " & decoded & vbCrlf
  Wscript.Echo Buffer


Dim grid(9, 9)
Dim gridSolved(9, 9)

Public Sub Solve(i, j)
  If i > 9 Then
    'exit with gridSolved = Grid
    For r = 1 To 9
      For c = 1 To 9
        gridSolved(r, c) = grid(r, c)
      Next c
    Next r
    Exit Sub
  End If
  For n = 1 To 9
    If isSafe(i, j, n) Then
      nTmp = grid(i, j)
      grid(i, j) = n
      If j = 9 Then
        Solve i + 1, 1
      Else
        Solve i, j + 1
      End If
      grid(i, j) = nTmp
    End If
  Next n
End Sub

Public Function isSafe(i, j, n) As Boolean
Dim iMin As Integer
Dim jMin As Integer

If grid(i, j) <> 0 Then
  isSafe = (grid(i, j) = n)
  Exit Function
End If

'grid(i,j) is an empty cell. Check if n is OK
'first check the row i
For c = 1 To 9
  If grid(i, c) = n Then
    isSafe = False
    Exit Function
  End If
Next c

'now check the column j
For r = 1 To 9
 If grid(r, j) = n Then
   isSafe = False
   Exit Function
 End If
Next r

'finally, check the 3x3 subsquare containing grid(i,j)
iMin = 1 + 3 * Int((i - 1) / 3)
jMin = 1 + 3 * Int((j - 1) / 3)
For r = iMin To iMin + 2
  For c = jMin To jMin + 2
    If grid(r, c) = n Then
      isSafe = False
      Exit Function
    End If
  Next c
Next r

'all tests were OK
isSafe = True
End Function

Public Sub Sudoku()
  'main routine
  'to use, fill in the grid and
  'type "Sudoku" in the Immediate panel of the Visual Basic for Applications window

  Dim s(9) As String

  'initialise grid using 9 strings,one per row
  s(1) = "001005070"
  s(2) = "920600000"
  s(3) = "008000600"
  s(4) = "090020401"
  s(5) = "000000000"
  s(6) = "304080090"
  s(7) = "007000300"
  s(8) = "000007069"
  s(9) = "010800700"
  For i = 1 To 9
    For j = 1 To 9
      grid(i, j) = Int(Val(Mid$(s(i), j, 1)))
    Next j
  Next i
  'solve it!
  Solve 1, 1
  'print solution
  Debug.Print "Solution:"
  For i = 1 To 9
    For j = 1 To 9
      Debug.Print Format$(gridSolved(i, j)); " ";
    Next j
    Debug.Print
  Next i
End Sub


import "/str" for Str

var board  = "ET AON RISBCDFGHJKLMPQ/UVWXYZ."
var digits = "0123456789"
var rows   = " 26"
var escape = "62"
var key    = "0452"

var encrypt = Fn.new { |message|
    var msg = Str.upper(message).
              where { |c| (board.contains(c) || digits.contains(c)) && !" /".contains(c) }.join()
    var sb = ""
    for (c in msg) {
        var idx = board.indexOf(c)
        if (idx > -1) {
            var row = (idx/10).floor
            var col = idx % 10
            sb = sb + ((row == 0) ? "%(col)" : "%(rows[row])%(col)")
        } else {
            sb = sb + "%(escape)%(c)"
        }
    }
    var enc = sb.bytes.toList
    var i = 0
    for (c in enc) {
        var k = key[i%4].bytes[0] - 48
        if (k != 0) {
            var j = c - 48
            enc[i] = 48 + ((j + k) % 10)
        }
        i = i + 1
    }
    return enc.map { |b| String.fromByte(b) }.join()
}

var decrypt = Fn.new { |encoded|
    var enc = encoded.bytes.toList
    var i = 0
    for (c in enc) {
        var k = key[i%4].bytes[0] - 48
        if (k != 0) {
            var j = c - 48
            enc[i] = 48 + ((j >= k) ? (j - k) % 10 : (10 + j - k) % 10)
        }
        i = i + 1
    }
    var len = enc.count
    var sb = ""
    i = 0
    while (i < len) {
        var c = enc[i]
        var idx = rows.indexOf((c-48).toString)
        if (idx == -1) {
            var idx2 = c - 48
            sb = sb + board[idx2]
            i = i + 1
        } else if ("%(c-48)%(enc[i + 1]-48)" == escape) {
            sb = sb + (enc[i + 2] - 48).toString
            i = i + 3
        } else {
            var idx2 = idx * 10 + enc[i + 1] - 48
            sb = sb + board[idx2]
            i = i + 2
        }
    }
    return sb
}

var messages = [
    "Attack at dawn",
    "One night-it was on the twentieth of March, 1888-I was returning",
    "In the winter 1965/we were hungry/just barely alive",
    "you have put on 7.5 pounds since I saw you.",
    "The checkerboard cake recipe specifies 3 large eggs and 2.25 cups of flour."
]
for (message in messages) {
    var encrypted = encrypt.call(message)
    var decrypted = decrypt.call(encrypted)
    System.print("\nMessage   : %(message)")
    System.print("Encrypted : %(encrypted)")
    System.print("Decrypted : %(decrypted)")
}


Dim grid(9, 9)
Dim gridSolved(9, 9)

Public Sub Solve(i, j)
    If i > 9 Then
        'exit with gridSolved = Grid
        For r = 1 To 9
	    For c = 1 To 9
	        gridSolved(r, c) = grid(r, c)
	    Next 'c
        Next 'r
        Exit Sub
    End If
    For n = 1 To 9
        If isSafe(i, j, n) Then
          nTmp = grid(i, j)
          grid(i, j) = n
          If j = 9 Then
                Solve i + 1, 1
          Else
                Solve i, j + 1
          End If
          grid(i, j) = nTmp
        End If
    Next 'n
End Sub 'Solve

Public Function isSafe(i, j, n)
    If grid(i, j) <> 0 Then
        isSafe = (grid(i, j) = n)
        Exit Function
    End If
    'grid(i,j) is an empty cell. Check if n is OK
    'first check the row i
    For c = 1 To 9
        If grid(i, c) = n Then
            isSafe = False
            Exit Function
        End If
    Next 'c
    'now check the column j
    For r = 1 To 9
        If grid(r, j) = n Then
            isSafe = False
            Exit Function
        End If
    Next 'r
    'finally, check the 3x3 subsquare containing grid(i,j)
    iMin = 1 + 3 * Int((i - 1) / 3)
    jMin = 1 + 3 * Int((j - 1) / 3)
    For r = iMin To iMin + 2
        For c = jMin To jMin + 2
            If grid(r, c) = n Then
                isSafe = False
                Exit Function
            End If
        Next 'c
    Next 'r
    'all tests were OK
    isSafe = True
End Function 'isSafe

Public Sub Sudoku()
    'main routine
   Dim s(9)
    s(1) = "001005070"
    s(2) = "920600000"
    s(3) = "008000600"
    s(4) = "090020401"
    s(5) = "000000000"
    s(6) = "304080090"
    s(7) = "007000300"
    s(8) = "000007069"
    s(9) = "010800700"
    For i = 1 To 9
        For j = 1 To 9
            grid(i, j) = Int(Mid(s(i), j, 1))
        Next 'j
    Next 'j
    'print problem
    Wscript.echo "Problem:"
    For i = 1 To 9
	    c=""
        For j = 1 To 9
            c=c & grid(i, j) & " "
        Next 'j
	    Wscript.echo c
    Next 'i
    'solve it!
    Solve 1, 1
    'print solution
    Wscript.echo "Solution:"
    For i = 1 To 9
	    c=""
        For j = 1 To 9
            c=c & gridSolved(i, j) & " "
        Next 'j
	    Wscript.echo c
    Next 'i
End Sub 'Sudoku

Call sudoku


class Sudoku {
    construct new(rows) {
        if (rows.count != 9 || rows.any { |r| r.count != 9 }) {
            Fiber.abort("Grid must be 9 x 9")
        }
        _grid = List.filled(81, null)
        for (i in 0..8) {
            for (j in 0..8 ) _grid[9 * i + j] = rows[i][j]
        }
        _solved = false
    }

    checkValidity_(v, x, y) {
        for (i in 0..8) {
            if (_grid[y * 9 + i] == v || _grid[i * 9 + x] == v) return false
        }
        var startX = (x / 3).floor * 3
        var startY = (y / 3).floor * 3
        for (i in startY...startY + 3) {
            for (j in startX...startX + 3) {
                if (_grid[i * 9 + j] == v) return false
            }
        }
        return true
    }

    placeNumber_(pos) {
        if (_solved) return
        if (pos == 81) {
            _solved = true
            return
        }
        if (_grid[pos].bytes[0] > 48) {
            placeNumber_(pos + 1)
            return
        }
        for (n in 1..9) {
            if (checkValidity_(n.toString, pos % 9, (pos/9).floor)) {
                _grid[pos] = n.toString
                placeNumber_(pos + 1)
                if (_solved) return
                _grid[pos] = "0"
            }
        }
    }

    solve() {
        System.print("Starting grid:\n\n%(this)")
        placeNumber_(0)
        System.print(_solved ? "Solution:\n\n%(this)" : "Unsolvable!")
    }

    toString {
        var sb = ""
        for (i in 0..8) {
            for (j in 0..8) {
                sb = sb + _grid[i * 9 + j] + " "
                if (j == 2 || j == 5) sb = sb + "| "
            }
            sb = sb + "\n"
            if (i == 2 || i == 5) sb = sb + "------+-------+------\n"
        }
        return sb
    }
}

var rows = [
    "850002400",
    "720000009",
    "004000000",
    "000107002",
    "305000900",
    "040000000",
    "000080070",
    "017000000",
    "000036040"
]
Sudoku.new(rows).solve()


code    ChOut=8, CrLf=9, IntOut=11, Text=12;

proc    Show(X);
char    X;
int     I, J;
[for I:= 0 to 8 do
        [if rem(I/3) = 0 then CrLf(0);
        for J:= 0 to 8 do
                [if rem(J/3) = 0 then ChOut(0, ^ );
                ChOut(0, ^ );  IntOut(0, X(0));
                X:= X+1;
                ];
        CrLf(0);
        ];
];

func    TryCell(X, Pos);
char    X;
int     Pos;
int     Row, Col, I, J, Used;
[Row:= Pos/9;
Col:= rem(0);
Used:= 0;

if Pos = 81 then return true;
if X(Pos) then return TryCell(X, Pos+1);

for I:= 0 to 8 do Used:= Used ! 1 << (X(I*9+Col)-1);
for J:= 0 to 8 do Used:= Used ! 1 << (X(Row*9+J)-1);

Row:= Row/3*3;
Col:= Col/3*3;
for I:= Row to Row+2 do
        for J:= Col to Col+2 do
                Used:= Used ! 1 << (X(I*9+J)-1);

for I:= 1 to 9 do
        [X(Pos):= I;
        if (Used&1)=0 & TryCell(X, Pos+1) then return true;
        Used:= Used>>1;
        ];
X(Pos):= 0;
return false;
];

proc    Solve(S);
char    S;
int     I, J, C;
char    X(81);
[J:= 0;
for I:= 0 to 80 do
        [repeat C:= S(J);
                J:= J+1;
        until   C>=^1 & C<=^9 ! C=^.;
        X(I):= if C=^. then 0 else C-^0;
        ];

if TryCell(X, 0) then Show(X)
else Text(0, "No solution");
];

[Solve("394 ..2 67.
        ... 3.. 4..
        5.. 69. .2.
        .45 ... 9..
        6.. ... ..7
        ..7 ... 58.
        .1. .67 ..8
        ..9 ..8 ...
        .26 4.. 735 ");
]


fcn trycell(sdku,pos=0){
   row,col:=pos/9, pos%9;

   if(pos==81)   return(True);
   if(sdku[pos]) return(trycell(sdku, pos + 1));

   used:=0;
   foreach r in (9){ used=used.bitOr((1).shiftLeft(sdku[r*9 + col] - 1)) }
   foreach c in (9){ used=used.bitOr((1).shiftLeft(sdku[row*9 + c] - 1)) }

   row,col = row/3*3, col/3*3;
   foreach r,c in ([row..row+2], [col..col+2])
      { used=used.bitOr((1).shiftLeft(sdku[r*9 + c] - 1)) }

   sdku[pos]=1; while(sdku[pos]<=9){
      if(used.isEven and trycell(sdku, pos + 1)) return(True);
      sdku[pos]+=1; used/=2;
   }

   sdku[pos]=0;
   return(False);
}


with Ada.Text_IO;
procedure Foo is
begin
   Ada.Text_IO.Put_Line("Bar");
end Foo;


BEGIN
    print( ( "Hello, World!", newline ) )
END


main: function [][
    print "Yes, we are in main!"
]

main


BEGIN {
  # This is our main startup procedure
  print "Hello World!"
}


SUB main
    PRINT "Hello from main!"
END SUB

main


#include<stdio.h>

#define start main()

int start
{
	printf("Hello World !");
	return 0;
}


MODULE MainProcedure;
IMPORT StdLog;

PROCEDURE Do*;
BEGIN
	StdLog.String("From Do");StdLog.Ln
END Do;

PROCEDURE Main*;
BEGIN
	StdLog.String("From Main");StdLog.Ln
END Main;
END MainProcedure.


USE: io
IN: example

: hello ( -- ) "Hello, world!" print ;

MAIN: hello


include foo.fs
...
: main  ... ;

main bye


' FB 1.05.0 Win64

Sub main()
  Print "Hello from main!"
End Sub

main
Sleep


PUBLIC SUB Main()
  ' This is the start of the program
END


package main

import "fmt"

var count = 0

func foo() {
    fmt.Println("foo called")
}

func init() {
    fmt.Println("first init called")
    foo()
}

func init() {
    fmt.Println("second init called")
    main()
}

func main() {
    count++
    fmt.Println("main called when count is", count)
}


Welcome to Kotlin version 1.1.1 (JRE 1.8.0_121-b13)
Type :help for help, :quit for quit
>>> println("Look no main!")
Look no main!
>>> :quit


proc main() =
  echo "Hello World!"

main()


: main(n)
   "Sleeping..." println
   n sleep
   "Awake and leaving." println ;


BEGIN {...} # as soon as parsed
CHECK {...} # end of compile time
INIT {...}  # beginning of run time
END {...}   # end of run time


procedure main()
    ...
end procedure
main()


println("hello world");
line(0, 0, width, height);


[ say "Please use the shell to calculate a value" cr
  say "and leave it on the stack. Type 'leave' when" cr
  say "you have done this." cr
  shell ]                             constant is my-value


#/usr/bin/env racket -tm
#lang racket
(provide main)
(define (main . args) (displayln "Hello World!"))


/*REXX*/
address 'XEDIT'
  .
  .
  .
[XEDIT commands here.]
  .
  .
  .


BEGIN {
  # begin code
}

END {
  # end code
}


object PrimaryMain extends App {
Console.println("Hello World: " + (args mkString ", "))
}

object MainTheSecond extends App {
Console.println("Goodbye, World: " + (args mkString ", "))
}


# This code runs only for line 1.
1 {
	i\
Explain-a-lot processed this file and
	i\
replaced every period with three exclamation points!!!
	i\

}

# This code runs for each line of input.
s/\./!!!/g


$ include "seed7_05.s7i";

const proc: main is func
  begin
    writeln("hello world");
  end func;


SUB Main()
  ' This is the start of the program
END


Imports System.Collections.ObjectModel
Imports Microsoft.VisualBasic.ApplicationServices

Namespace My
    ' The following events are available for MyApplication:
    ' Startup: Raised when the application starts, before the startup form is created.
    ' Shutdown: Raised after all application forms are closed.  This event is not raised if the application terminates abnormally.
    ' UnhandledException: Raised if the application encounters an unhandled exception.
    ' StartupNextInstance: Raised when launching a single-instance application and the application is already active.
    ' NetworkAvailabilityChanged: Raised when the network connection is connected or disconnected.

    Partial Friend Class MyApplication
        '''Sets the visual styles, text display styles, and current principal for the main application thread
        '''(if the application uses Windows authentication), and initializes the splash screen, if defined.
        '''<param name="commandLineArgs">A <see cref="ReadOnlyCollection(Of T)" /> of <see langword="String" />,
        '''containing the command-line arguments as strings for the current application.</param>
        '''<returns>A <see cref="T:System.Boolean" /> indicating if application startup should continue.</returns>
        Protected Overrides Function OnInitialize(commandLineArgs As ReadOnlyCollection(Of String)) As Boolean
            Console.WriteLine("oninitialize; args: " & String.Join(", ", commandLineArgs))
            Return MyBase.OnInitialize(commandLineArgs)
        End Function

        ' WindowsFormsApplicationBase.Startup occurs "when the application starts".
        Private Sub MyApplication_Startup(sender As Object, e As StartupEventArgs) Handles Me.Startup
            Console.WriteLine("startup; args: " & String.Join(", ", e.CommandLine))
        End Sub

        '''Provides the starting point for when the main application is ready to start running, after the
        '''initialization is done.
        Protected Overrides Sub OnRun()
            Console.WriteLine("onrun")
            MyBase.OnRun()
        End Sub
    End Class
End Namespace


var main = Fn.new {
    System.print("Hello from the main function.")
}

main.call()


FUNCTION  main ()
    'This is the beginning of the program
END FUNCTION


SAVE "MYPROG" LINE 500: REM For a program with main code starting at line 500


/*
 * RosettaCode example: Statistics/Normal distribution in C
 *
 * The random number generator rand() of the standard C library is obsolete
 * and should not be used in more demanding applications. There are plenty
 * libraries with advanced features (eg. GSL) with functions to calculate
 * the mean, the standard deviation, generating random numbers etc.
 * However, these features are not the core of the standard C library.
 */
#include <stdio.h>
#include <stdlib.h>
#include <math.h>
#include <string.h>
#include <time.h>

#define NMAX 10000000

double mean(double* values, int n)
{
    int i;
    double s = 0;

    for ( i = 0; i < n; i++ )
        s += values[i];
    return s / n;
}

double stddev(double* values, int n)
{
    int i;
    double average = mean(values,n);
    double s = 0;

    for ( i = 0; i < n; i++ )
        s += (values[i] - average) * (values[i] - average);
    return sqrt(s / (n - 1));
}

/*
 * Normal random numbers generator - Marsaglia algorithm.
 */
double* generate(int n)
{
    int i;
    int m = n + n % 2;
    double* values = (double*)calloc(m,sizeof(double));
    double average, deviation;

    if ( values )
    {
        for ( i = 0; i < m; i += 2 )
        {
            double x,y,rsq,f;
            do {
                x = 2.0 * rand() / (double)RAND_MAX - 1.0;
                y = 2.0 * rand() / (double)RAND_MAX - 1.0;
                rsq = x * x + y * y;
            }while( rsq >= 1. || rsq == 0. );
            f = sqrt( -2.0 * log(rsq) / rsq );
            values[i]   = x * f;
            values[i+1] = y * f;
        }
    }
    return values;
}

void printHistogram(double* values, int n)
{
    const int width = 50;
    int max = 0;

    const double low   = -3.05;
    const double high  =  3.05;
    const double delta =  0.1;

    int i,j,k;
    int nbins = (int)((high - low) / delta);
    int* bins = (int*)calloc(nbins,sizeof(int));
    if ( bins != NULL )
    {
        for ( i = 0; i < n; i++ )
        {
            int j = (int)( (values[i] - low) / delta );
            if ( 0 <= j  &&  j < nbins )
                bins[j]++;
        }

        for ( j = 0; j < nbins; j++ )
            if ( max < bins[j] )
                max = bins[j];

        for ( j = 0; j < nbins; j++ )
        {
            printf("(%5.2f, %5.2f) |", low + j * delta, low + (j + 1) * delta );
            k = (int)( (double)width * (double)bins[j] / (double)max );
            while(k-- > 0) putchar('*');
            printf("  %-.1f%%", bins[j] * 100.0 / (double)n);
            putchar('\n');
        }

        free(bins);
    }
}

int main(void)
{
    double* seq;

    srand((unsigned int)time(NULL));

    if ( (seq = generate(NMAX)) != NULL )
    {
        printf("mean = %g, stddev = %g\n\n", mean(seq,NMAX), stddev(seq,NMAX));
        printHistogram(seq,NMAX);
        free(seq);

        printf("\n%s\n", "press enter");
        getchar();
        return EXIT_SUCCESS;
    }
    return EXIT_FAILURE;
}


using System;
using MathNet.Numerics.Distributions;
using MathNet.Numerics.Statistics;

class Program
{
    static void RunNormal(int sampleSize)
    {
        double[] X = new double[sampleSize];
        var norm = new Normal(new Random());
        norm.Samples(X);

        const int numBuckets = 10;
        var histogram = new Histogram(X, numBuckets);
        Console.WriteLine("Sample size: {0:N0}", sampleSize);
        for (int i = 0; i < numBuckets; i++)
        {
            string bar = new String('#', (int)(histogram[i].Count * 360 / sampleSize));
            Console.WriteLine(" {0:0.00} : {1}", histogram[i].LowerBound, bar);
        }
        var statistics = new DescriptiveStatistics(X);
        Console.WriteLine("  Mean: " + statistics.Mean);
        Console.WriteLine("StdDev: " + statistics.StandardDeviation);
        Console.WriteLine();
    }
    static void Main(string[] args)
    {
        RunNormal(100);
        RunNormal(1000);
        RunNormal(10000);
    }
}


#include <random>
#include <map>
#include <string>
#include <iostream>
#include <cmath>
#include <iomanip>

int main( ) {
   std::random_device myseed ;
   std::mt19937 engine ( myseed( ) ) ;
   std::normal_distribution<> normDistri ( 2 , 3 ) ;
   std::map<int , int> normalFreq ;
   int sum = 0 ; //holds the sum of the randomly created numbers
   double mean = 0.0 ;
   double stddev = 0.0 ;
   for ( int i = 1 ; i < 10001 ; i++ )
      ++normalFreq[ normDistri ( engine ) ] ;
   for ( auto MapIt : normalFreq ) {
      sum += MapIt.first * MapIt.second ;
   }
   mean = sum / 10000 ;
   stddev = sqrt( sum / 10000 ) ;
   std::cout << "The mean of the distribution is " << mean << " , the " ;
   std::cout << "standard deviation " << stddev << " !\n" ;
   std::cout << "And now the histogram:\n" ;
   for ( auto MapIt : normalFreq ) {
      std::cout << std::left << std::setw( 4 ) << MapIt.first <<
	 std::string( MapIt.second / 100 , '*' ) << std::endl ;
   }
   return 0 ;
}


import std.stdio, std.random, std.math, std.range, std.algorithm,
       statistics_basic;

struct Normals {
    double mu, sigma;
    double[2] state;
    size_t index = state.length;
    enum empty = false;

    void popFront() pure nothrow { index++; }

    @property double front() {
        if (index >= state.length) {
            immutable r = sqrt(-2 * uniform!"]["(0., 1.0).log) * sigma;
            immutable x = 2 * PI * uniform01;
            state = [mu + r * x.sin, mu + r * x.cos];
            index = 0;
        }
        return state[index];
    }
}

void main() {
    const data = Normals(0.0, 0.5).take(100_000).array;
    writefln("Mean: %8.6f, SD: %8.6f\n", data.meanStdDev[]);
    data.map!q{ max(0.0, min(0.9999, a / 3 + 0.5)) }.showHistogram01;
}


defmodule Statistics do
  def normal_distribution(n, w\\5) do
    {sum, sum2, hist} = generate(n, w)
    mean = sum / n
    stddev = :math.sqrt(sum2 / n - mean*mean)

    IO.puts "size:   #{n}"
    IO.puts "mean:   #{mean}"
    IO.puts "stddev: #{stddev}"
    {min, max} = Map.to_list(hist)
                 |> Enum.filter_map(fn {_k,v} -> v >= n/120/w end, fn {k,_v} -> k end)
                 |> Enum.min_max
    Enum.each(min..max, fn i ->
      bar = String.duplicate("=", trunc(120 * w * Map.get(hist, i, 0) / n))
      :io.fwrite "~4.1f: ~s~n", [i/w, bar]
    end)
    IO.puts ""
  end

  defp generate(n, w) do
    Enum.reduce(1..n, {0, 0, %{}}, fn _,{sum, sum2, hist} ->
      z = :rand.normal
      {sum+z, sum2+z*z, Map.update(hist, round(w*z), 1, &(&1+1))}
    end)
  end
end

Enum.each([100,1000,10000], fn n ->
  Statistics.normal_distribution(n)
end)


USING: assocs formatting kernel math math.functions
math.statistics random sequences sorting ;

2,000,000 [ 0 1 normal-random-float ] replicate   ! make data set
dup [ mean ] [ population-std ] bi                ! calculate and show
"Mean: %f\nStdev: %f\n\n" printf                  ! mean and stddev

[ 10 * floor 10 / ] map                   ! map data to buckets
histogram >alist [ first ] sort-with      ! create histogram sorted by bucket (key)
dup values supremum                       ! find maximum count
[
    [ /f 100 * >integer ] keepd             ! how big should this histogram bar be?
    [ [ CHAR: * ] "" replicate-as ] dip     ! make the bar
    "% 5.2f: %s   %d\n" printf              ! print a line of the histogram
] curry assoc-each


program Normal_Distribution
  implicit none

  integer, parameter :: i64 = selected_int_kind(18)
  integer, parameter :: r64 = selected_real_kind(15)
  integer(i64), parameter :: samples = 1000000_i64
  real(r64) :: mean, stddev
  real(r64) :: sumn = 0, sumnsq = 0
  integer(i64) :: n = 0
  integer(i64) :: bin(-50:50) = 0
  integer :: i, ind
  real(r64) :: ur1, ur2, nr1, nr2, s

  n = 0
  do while(n <= samples)
    call random_number(ur1)
    call random_number(ur2)
    ur1 = ur1 * 2.0 - 1.0
    ur2 = ur2 * 2.0 - 1.0

    s = ur1*ur1 + ur2*ur2
    if(s >= 1.0_r64) cycle

    nr1 = ur1 * sqrt(-2.0*log(s)/s)
    ind = floor(5.0*nr1)
    bin(ind) = bin(ind) + 1_i64
    sumn = sumn + nr1
    sumnsq = sumnsq + nr1*nr1

    nr2 = ur2 * sqrt(-2.0*log(s)/s)
    ind = floor(5.0*nr2)
    bin(ind) = bin(ind) + 1_i64
    sumn = sumn + nr2
    sumnsq = sumnsq + nr2*nr2
    n = n + 2_i64
  end do

  mean = sumn / n
  stddev = sqrt(sumnsq/n - mean*mean)

  write(*, "(a, i0)") "sample size = ", samples
  write(*, "(a, f17.15)") "Mean :   ", mean,
  write(*, "(a, f17.15)") "Stddev : ", stddev

  do i = -15, 15
    write(*, "(f4.1, a, a)") real(i)/5.0, ": ", repeat("=", int(bin(i)*500/samples))
  end do

end program


' FB 1.05.0 Win64

Const pi As Double = 3.141592653589793
Randomize

' Generates normally distributed random numbers with mean 0 and standard deviation 1
Function randomNormal() As Double
  Return Cos(2.0 * pi * Rnd) * Sqr(-2.0 * Log(Rnd))
End Function

Sub normalStats(sampleSize As Integer)
  If sampleSize < 1 Then Return
  Dim r(1 To sampleSize) As Double
  Dim h(-1 To 10) As Integer '' all zero by default
  Dim sum As Double = 0.0
  Dim hSum As Integer = 0

  ' Generate 'sampleSize' normally distributed random numbers with mean 0.5 and standard deviation 0.25
  ' calculate their sum
  ' and in which box they will fall when drawing the histogram
  For i As Integer = 1 To sampleSize
    r(i) = 0.5 + randomNormal / 4.0
    sum += r(i)
    If r(i) < 0.0 Then
      h(-1) += 1
    ElseIf r(i) >= 1.0 Then
      h(10) += 1
    Else
      h(Int(r(i) * 10)) += 1
    End If
  Next

  For i As Integer = -1 To 10 : hSum += h(i) :  Next
  ' adjust one of the h() values if necessary to ensure hSum = sampleSize
  Dim adj As Integer = sampleSize - hSum
  If adj <> 0 Then
    For i As Integer = -1 To 10
      h(i) += adj
      If h(i) >= 0 Then Exit For
      h(i) -= adj
    Next
  End If

  Dim mean As Double = sum / sampleSize

  Dim sd As Double
  sum = 0.0
  ' Now calculate their standard deviation
  For i As Integer = 1 To sampleSize
    sum += (r(i) - mean) ^ 2.0
  Next
  sd  = Sqr(sum/sampleSize)

  ' Draw a histogram of the data with interval 0.1
  Dim numStars As Integer
  ' If sample size > 300 then normalize histogram to 300
  Dim scale As Double = 1.0
  If sampleSize > 300 Then scale = 300.0 / sampleSize
  Print "Sample size "; sampleSize
  Print
  Print Using "  Mean #.######"; mean;
  Print Using "  SD #.######"; sd
  Print
  For i As Integer = -1 To 10
    If i = -1 Then
      Print Using "< 0.00 : ";
    ElseIf i = 10 Then
      Print Using ">=1.00 : ";
    Else
      Print Using "  #.## : "; i/10.0;
    End If
    Print Using "##### " ; h(i);
    numStars = Int(h(i) * scale + 0.5)
    Print String(numStars, "*")
  Next
End Sub

normalStats 100
Print
normalStats 1000
Print
normalStats 10000
Print
normalStats 100000
Print
Print "Press any key to quit"
Sleep


package main

import (
    "fmt"
    "math"
    "math/rand"
    "strings"
)

// Box-Muller
func norm2() (s, c float64) {
    r := math.Sqrt(-2 * math.Log(rand.Float64()))
    s, c = math.Sincos(2 * math.Pi * rand.Float64())
    return s * r, c * r
}

func main() {
    const (
        n     = 10000
        bins  = 12
        sig   = 3
        scale = 100
    )
    var sum, sumSq float64
    h := make([]int, bins)
    for i, accum := 0, func(v float64) {
        sum += v
        sumSq += v * v
        b := int((v + sig) * bins / sig / 2)
        if b >= 0 && b < bins {
            h[b]++
        }
    }; i < n/2; i++ {
        v1, v2 := norm2()
        accum(v1)
        accum(v2)
    }
    m := sum / n
    fmt.Println("mean:", m)
    fmt.Println("stddev:", math.Sqrt(sumSq/float64(n)-m*m))
    for _, p := range h {
        fmt.Println(strings.Repeat("*", p/scale))
    }
}


import Data.Map (Map, empty, insert, findWithDefault, toList)
import Data.Maybe (fromMaybe)
import Text.Printf (printf)
import Data.Function (on)
import Data.List (sort, maximumBy, minimumBy)
import Control.Monad.Random (RandomGen, Rand, evalRandIO, getRandomR)
import Control.Monad (replicateM)

-- Box-Muller
getNorm :: RandomGen g => Rand g Double
getNorm = do
    u0 <- getRandomR (0.0, 1.0)
    u1 <- getRandomR (0.0, 1.0)
    let r = sqrt $ (-2.0) * log u0
        theta = 2.0 * pi * u1
    return $ r * sin theta

putInBin :: Double -> Map Int Int -> Double -> Map Int Int
putInBin binWidth t v =
    let bin = round (v / binWidth)
        count = findWithDefault 0 bin t
    in insert bin (count+1) t

runTest :: Int -> IO ()
runTest n = do
    rs <- evalRandIO $ replicateM n getNorm
    let binWidth = 0.1

        tally v (sv, sv2, t) = (sv+v, sv2 + v*v, putInBin binWidth t v)

        (sum, sum2, tallies) = foldr tally (0.0, 0.0, empty) rs

        tallyList = sort $ toList tallies

        printStars tallies binWidth maxCount selection =
            let count = findWithDefault 0 selection tallies
                bin = binWidth * fromIntegral selection
                maxStars = 100
                starCount = if maxCount <= maxStars
                            then count
                            else maxStars * count `div` maxCount
                stars = replicate  starCount '*'
            in printf "%5.2f: %s  %d\n" bin stars count

        mean = sum / fromIntegral n
        stddev = sqrt (sum2/fromIntegral n - mean*mean)

    printf "\n"
    printf "sample count: %d\n" n
    printf "mean:         %9.7f\n" mean
    printf "stddev:       %9.7f\n" stddev

    let maxCount = snd $ maximumBy (compare `on` snd) tallyList
        maxBin = fst $ maximumBy (compare `on` fst) tallyList
        minBin = fst $ minimumBy (compare `on` fst) tallyList

    mapM_ (printStars tallies binWidth maxCount) [minBin..maxBin]

main = do
    runTest 1000
    runTest 2000000


runif01=: [email protected]$ 0:                                           NB. random uniform number generator
rnorm01=. (2 o. 2p1 * runif01) * [: %: _2 * ^[email protected]     NB. random normal number generator (Box-Muller)

mean=: +/ % #                        NB. mean
stddev=: (<:@# %~ +/)&.:*:@(- mean)  NB. standard deviation
histogram=: <:@(#/.~)@([email protected]#@[ , I.)


import static java.lang.Math.*;
import static java.util.Arrays.stream;
import java.util.Locale;
import java.util.function.DoubleSupplier;
import static java.util.stream.Collectors.joining;
import java.util.stream.DoubleStream;
import static java.util.stream.IntStream.range;

public class Test implements DoubleSupplier {

    private double mu, sigma;
    private double[] state = new double[2];
    private int index = state.length;

    Test(double m, double s) {
        mu = m;
        sigma = s;
    }

    static double[] meanStdDev(double[] numbers) {
        if (numbers.length == 0)
            return new double[]{0.0, 0.0};

        double sx = 0.0, sxx = 0.0;
        long n = 0;
        for (double x : numbers) {
            sx += x;
            sxx += pow(x, 2);
            n++;
        }

        return new double[]{sx / n, pow((n * sxx - pow(sx, 2)), 0.5) / n};
    }

    static String replicate(int n, String s) {
        return range(0, n + 1).mapToObj(i -> s).collect(joining());
    }

    static void showHistogram01(double[] numbers) {
        final int maxWidth = 50;
        long[] bins = new long[10];

        for (double x : numbers)
            bins[(int) (x * bins.length)]++;

        double maxFreq = stream(bins).max().getAsLong();

        for (int i = 0; i < bins.length; i++)
            System.out.printf(" %3.1f: %s%n", i / (double) bins.length,
                    replicate((int) (bins[i] / maxFreq * maxWidth), "*"));
        System.out.println();
    }

    @Override
    public double getAsDouble() {
        index++;
        if (index >= state.length) {
            double r = sqrt(-2 * log(random())) * sigma;
            double x = 2 * PI * random();
            state = new double[]{mu + r * sin(x), mu + r * cos(x)};
            index = 0;
        }
        return state[index];

    }

    public static void main(String[] args) {
        Locale.setDefault(Locale.US);
        double[] data = DoubleStream.generate(new Test(0.0, 0.5)).limit(100_000)
                .toArray();

        double[] res = meanStdDev(data);
        System.out.printf("Mean: %8.6f, SD: %8.6f%n", res[0], res[1]);

        showHistogram01(stream(data).map(a -> max(0.0, min(0.9999, a / 3 + 0.5)))
                .toArray());
    }
}


  cat /dev/urandom | tr -cd '0-9' | fold -w 10 |
     jq -nRr -f normal-distribution.jq


using Printf, Distributions, Gadfly

data = rand(Normal(0, 1), 1000)
@printf("N = %i\n", length(data))
@printf("μ = %2.2f\tσ = %2.2f\n", mean(data), std(data))
@printf("range = (%2.2f, %2.2f\n)", minimum(data), maximum(data))
h = plot(x=data, Geom.histogram)
draw(PNG("norm_hist.png", 10cm, 10cm), h)


// version 1.1.2

val rand = java.util.Random()

fun normalStats(sampleSize: Int) {
    if (sampleSize < 1) return
    val r = DoubleArray(sampleSize)
    val h = IntArray(12) // all zero by default
    /*
       Generate 'sampleSize' normally distributed random numbers with mean 0.5 and SD 0.25
       and calculate in which box they will fall when drawing the histogram
    */
    for (i in 0 until sampleSize) {
        r[i] = 0.5 + rand.nextGaussian() / 4.0
        when {
            r[i] <  0.0 -> h[0]++
            r[i] >= 1.0 -> h[11]++
            else        -> h[1 + (r[i] * 10).toInt()]++
        }
    }

    // adjust one of the h[] values if necessary to ensure they sum to sampleSize
    val adj = sampleSize - h.sum()
    if (adj != 0) {
        for (i in 0..11) {
            h[i] += adj
            if (h[i] >= 0) break
            h[i] -= adj
        }
    }

    val mean = r.average()
    val sd = Math.sqrt(r.map { (it - mean) * (it - mean) }.average())

    // Draw a histogram of the data with interval 0.1
    var numStars: Int
    // If sample size > 300 then normalize histogram to 300
    val scale = if (sampleSize <= 300) 1.0 else 300.0 / sampleSize
    println("Sample size $sampleSize\n")
    println("  Mean ${"%1.6f".format(mean)}  SD ${"%1.6f".format(sd)}\n")
    for (i in 0..11) {
        when (i) {
            0    -> print("< 0.00 : ")
            11   -> print(">=1.00 : ")
            else -> print("  %1.2f : ".format(i / 10.0))
        }
        print("%5d ".format(h[i]))
        numStars = (h[i] * scale + 0.5).toInt()
        println("*".repeat(numStars))
    }
    println()
}

fun main(args: Array<String>) {
    val sampleSizes = intArrayOf(100, 1_000, 10_000, 100_000)
    for (sampleSize in sampleSizes) normalStats(sampleSize)
}


define stat1(a) => {
	if(#a->size) => {
		local(mean = (with n in #a sum #n) / #a->size)
		local(sdev = math_pow(((with n in #a sum Math_Pow((#n - #mean),2)) / #a->size),0.5))
		return (:#sdev, #mean)
	else
		return (:0,0)
	}
}
define stat2(a) => {
	if(#a->size) => {
		local(sx = 0, sxx = 0)
		with x in #a do => {
			#sx += #x
			#sxx += #x*#x
		}
		local(sdev = math_pow((#a->size * #sxx - #sx * #sx),0.5) / #a->size)
		return (:#sdev, #sx / #a->size)
	else
		return (:0,0)
	}
}
define histogram(a) => {
	local(
		out = '\r',
		h = array(0,0,0,0,0,0,0,0,0,0,0),
		maxwidth = 50,
		sc = 0
	)
	with n in #a do => {
		if((#n * 10) <= 0) => {
			#h->get(1) += 1
		else((#n * 10) >= 10)
			#h->get(#h->size) += 1
		else
			#h->get(integer(decimal(#n)*10)+1) += 1
		}

	}
	local(mx = decimal(with n in #h max #n))
	with i in #h do => {
		#out->append((#sc/10.0)->asString(-precision=1)+': '+('+' * integer(#i / #mx * #maxwidth))+'\r')
		#sc++
	}
	return #out
}
define normalDist(mean,sdev) => {
	// Uses Box-Muller transform
	return ((-2 * decimal_random->log)->sqrt * (2 * pi * decimal_random)->cos) * #sdev + #mean
}

with scale in array(100,1000,10000) do => {^
	local(n = array)
	loop(#scale) => { #n->insert(normalDist(0.5, 0.2)) }
	local(sdev1,mean1) = stat1(#n)
	local(sdev2,mean2) = stat2(#n)
	#scale' numbers:\r'
    'Naive  method: sd: '+#sdev1+', mean: '+#mean1+'\r'
    'Second  method: sd: '+#sdev2+', mean: '+#mean2+'\r'
    histogram(#n)
    '\r\r'
^}


call sample 100000

end

sub sample n
    dim dat( n)
    for i =1 to n
        dat( i) =normalDist( 1, 0.2)
    next i

    '// show mean, standard deviation. Find max, min.
    mx  =-1000
    mn  = 1000
    sum =0
    sSq =0
    for i =1 to n
        d =dat( i)
        mx =max( mx, d)
        mn =min( mn, d)
        sum =sum +d
        sSq =sSq +d^2
    next i
    print n; " data terms used."

    mean =sum / n
    print "Largest term was "; mx; " & smallest was "; mn
    range =mx -mn
    print "Mean ="; mean

    print "Stddev ="; ( sSq /n -mean^2)^0.5

    '// show histogram
    nBins =50
    dim bins( nBins)
    for i =1 to n
        z =int( ( dat( i) -mn) /range *nBins)
        bins( z) =bins( z) +1
    next i
    for b =0 to nBins -1
        for j =1 to int( nBins *bins( b)) /n *30)
            print "#";
        next j
        print
    next b
    print
end sub

function normalDist( m, s)  '   Box Muller method
    u =rnd( 1)
    v =rnd( 1)
    normalDist =( -2 *log( u))^0.5 *cos( 2 *3.14159265 *v)
end function


function gaussian (mean, variance)
    return  math.sqrt(-2 * variance * math.log(math.random())) *
            math.cos(2 * math.pi * math.random()) + mean
end

function mean (t)
    local sum = 0
    for k, v in pairs(t) do
        sum = sum + v
    end
    return sum / #t
end

function std (t)
    local squares, avg = 0, mean(t)
    for k, v in pairs(t) do
        squares = squares + ((avg - v) ^ 2)
    end
    local variance = squares / #t
    return math.sqrt(variance)
end

function showHistogram (t)
    local lo = math.ceil(math.min(unpack(t)))
    local hi = math.floor(math.max(unpack(t)))
    local hist, barScale = {}, 200
    for i = lo, hi do
        hist[i] = 0
        for k, v in pairs(t) do
            if math.ceil(v - 0.5) == i then
                hist[i] = hist[i] + 1
            end
        end
        io.write(i .. "\t" .. string.rep('=', hist[i] / #t * barScale))
        print(" " .. hist[i])
    end
end

math.randomseed(os.time())
local t, average, variance = {}, 50, 10
for i = 1, 1000 do
    table.insert(t, gaussian(average, variance))
end
print("Mean:", mean(t) .. ", expected " .. average)
print("StdDev:", std(t) .. ", expected " .. math.sqrt(variance) .. "\n")
showHistogram(t)


with(Statistics):
n := 100000:
X := Sample( Normal(0,1), n );
Mean( X );
StandardDeviation( X );
Histogram( X );


x:= RandomReal[1]
SampleNormal[n_] := (Print[#//Length, " numbers, Mean : ", #//Mean, ", StandardDeviation : ", #//StandardDeviation];
    Histogram[#, BarOrigin -> Left,Axes -> False])& [(Table[(-2*Log[x])^0.5*Cos[2*Pi*x], {n} ]]
Invocation:
SampleNormal[ 10000 ]
->10000 numbers, Mean : -0.0122308, StandardDeviation : 1.00646


  N = 100000;
  x = randn(N,1);
  mean(x)
  std(x)
  [nn,xx] = hist(x,100);
  bar(xx,nn);


import math, random, sequtils, stats, strformat, strutils

proc drawHistogram(ns: seq[float]) =

  # Distribute values in bins.
  const NBins = 50
  var minval = min(ns)
  var maxval = max(ns)
  var h = newSeq[int](NBins + 1)
  for n in ns:
    let pos = ((n - minval) * NBins / (maxval - minval)).toInt
    inc h[pos]

  # Eliminate extremes values.
  const MaxWidth = 50
  let mx = max(h)
  var first = 0
  while (h[first] / mx * MaxWidth).toInt == 0: inc first
  var last = h.high
  while (h[last] / mx * MaxWidth).toInt == 0: dec last

  # Draw the histogram.
  echo ""
  for n in first..last:
    echo repeat('+', (h[n] / mx * MaxWidth).toInt)
  echo ""

const N = 100_000

randomize()

let u1, u2 = newSeqWith(N, rand(1.0))

var z = newSeq[float](N)
for i in 0..<N:
  z[i] = sqrt(-2 * ln(u1[i])) * cos(2 * PI * u2[i])

echo &"μ = {z.mean:.12f}   σ = {z.standardDeviation:.12f}"
z.drawHistogram()


rnormal()={
	my(u1=random(1.),u2=random(1.);
	sqrt(-2*log(u1))*cos(2*Pi*u1)
	\\ Could easily be extended with a second normal at very little cost.
};
mean(v)={
  sum(i=1,#v,v[i])/#v
};
stdev(v,mu="")={
  if(mu=="",mu=mean(v));
  sqrt(sum(i=1,#v,(v[i]-mu)^2))/#v
};
histogram(v,bins=16,low=0,high=1)={
  my(u=vector(bins),width=(high-low)/bins);
  for(i=1,#v,u[(v[i]-low)\width+1]++);
  u
};
show(n)={
  my(v=vector(n,i,rnormal()),m=mean(v),s=stdev(v,m),h,sz=ceil(n/300));
  h=histogram(v,,vecmin(v)-.1,vecmax(v)+.1);
  for(i=1,#h,for(j=1,h[i]\sz,print1("#"));print());
};
show(10^4)


Program Example40;
{$IFDEF FPC}
  {$MOde objFPC}
{$ENDIF}
{ Program to demonstrate the randg function. }
Uses Math;

type
  tTestData =  extended;//because of math.randg
  ttstfunc = function  (mean, sd: tTestData): tTestData;
  tExArray = Array of tTestData;
  tSolution = record
                SolExArr : tExArray;
                SollowVal,
                SolHighVal,
                SolMean,
                SolStdDiv : tTestData;
                SolSmpCnt : LongInt;
              end;

function getSol(genFunc:ttstfunc;Mean,StdDiv: tTestData;smpCnt: LongInt): tSolution;
var
  GenValue,
  sumValue,
  sumsqrVal : extended;
Begin
  with result do
  Begin
    SolSmpCnt  := smpCnt;
    SolMean    := 0;
    SolStdDiv  := 0;
    SolLowVal  := Mean+50* StdDiv;
    SolHighVal := Mean-50* StdDiv;
    setlength(SolExArr,smpCnt);
    if smpCnt <= 0 then
      EXIT;
    sumValue   := 0;
    sumsqrVal  := 0;
    repeat
      GenValue   := genFunc(Mean,StdDiv);
      sumValue   := sumvalue+GenValue;
      sumsqrVal  :=  sumsqrVal+sqr(GenValue);
      IF GenValue < SollowVal then
        SollowVal:= GenValue
      else
        IF GenValue > SolHighVal then
           SolHighVal := GenValue;
      dec(smpCnt);
      SolExArr[smpCnt] := GenValue;
    until smpCnt<= 0;
    SolMean := sumValue/SolSmpCnt;
    SolStdDiv := sqrt(sumsqrVal/SolSmpCnt-sqr(SolMean));
  end;
end;

//http://wiki.freepascal.org/Generating_Random_Numbers#Normal_.28Gaussian.29_Distribution
function rnorm (mean, sd: tTestData): tTestData;
 {Calculates Gaussian random numbers according to the Box-Müller approach}
  var
   u1, u2: extended;
 begin
   u1 := random;
   u2 := random;
   rnorm := mean * abs(1 + sqrt(-2 * (ln(u1))) * cos(2 * pi * u2) * sd);
  end;

procedure Histo(const sol:TSolution;Colcnt,ColLen :LongInt);
var
  CntHisto : array of integer;
  LoLmt,HiLmt,span : tTestData;
  i, j,cnt,maxCnt: LongInt;
  sCross : Ansistring;
Begin
  setlength(CntHisto,Colcnt);
  with Sol do
  Begin
    span := solHighVal-solLowVal;
    LoLmt := solLowVal;
    writeln('Count: ',SolSmpCnt:10,' Mean ',SolMean:10:6,' StdDiv ',SolStdDIv:10:6);
    writeln('span : ',span:10:5,' Low  ',solLowVal:10:6,'   high ',solHighVal:10:6);

  end;
  maxCnt := 0;
  For j := 0 to Colcnt-1 do
  Begin
    HiLmt:= LoLmt+span/Colcnt;
    cnt := 0;
    with sol do
      For i := 0 to High(SolExArr) do
         IF (HiLmt > SolExArr[i]) AND  (SolExArr[i]>= LoLmt) then
            inc(cnt);
    CntHisto[j] := cnt;
    IF maxCnt < cnt then
      maxCnt := cnt;
    LoLmt:=  HiLmt;
  end;
  inc(CntHisto[Colcnt]); // for HiLmt itself
  writeln;
  LoLmt := sol.solLowVal;
  For i := 0 to Colcnt-1 do
  Begin
    Writeln(LoLmt:8:4,': ');
    cnt:= Round(CntHisto[i]*ColLen/maxCnt);
    setlength(sCross,cnt+3);
    fillChar(sCross[1],3,' ');
    fillChar(sCross[4],cnt,'#');
    writeln(CntHisto[i]:10,sCross);
    LoLmt := LoLmt+span/Colcnt;
  end;
  Writeln(sol.solHighVal:8:4,': ');
end;

const
  cHistCnt = 11;
  cColLen = 65;

  cStdDiv = 0.25;
  cMean   = 20*cStdDiv;
var
  mySol : tSolution;
begin
  Randomize;
  // test of randg of unit math
  Writeln('function randg');
  mySol := getSol(@randg,cMean,cMean*cStdDiv,100000);
  Histo(mySol,cHistCnt,cColLen);
  writeln;
  // test of rnorm from wiki
  Writeln('function rnorm');
  mySol := getSol(@rnorm,cMean,cStdDiv,1000000);
  Histo(mySol,cHistCnt,cColLen);
end.


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

sub normdist {
    my($m, $sigma) = @_;
    my $r = sqrt -2 * log rand;
    my $theta = 2 * pi * rand;
    $r * cos($theta) * $sigma + $m;
}

$size = 100000; $mean = 50; $stddev = 4;

push @dataset, normdist($mean,$stddev) for 1..$size;

my $m = sum(@dataset) / $size;
print "m = $m\n";

my $sigma = sqrt( (reduce { $a + $b **2 } 0,@dataset) / $size - $m**2 );
print "sigma = $sigma\n";

    $hash{int $_}++ for @dataset;
    my $scale = 180 * $stddev / $size;
    my @subbar = < ⎸ ▏ ▎ ▍ ▌ ▋ ▊ ▉ █ >;
    for $i (min(@dataset)..max(@dataset)) {
        my $x = ($hash{$i} // 0) * $scale;
        my $full = int $x;
        my $part = 8 * ($x - $full);
        my $t1 = '█' x $full;
        my $t2 = $subbar[$part];
        print "$i\t$t1$t2\n";
    }


with javascript_semantics
procedure sample(integer n)
    -- show mean, standard deviation. Find max, min.
    sequence dat = repeat(0,n)
    for i=1 to n do
        dat[i] = sqrt(-2*log(rnd()))*cos(2*PI*rnd())
    end for
    printf(1,"%d data terms used.\n",{n})

    atom mean = sum(dat)/n,
         mx = max(dat),
         mn = min(dat),
         range = mx-mn
    printf(1,"Largest term was %g & smallest was %g\n",{mx,mn})
    printf(1,"Mean = %g\n",{mean})
    printf(1,"Stddev = %g\n",sqrt(sum(sq_mul(dat,dat))/n-mean*mean))

    -- show histogram
    integer nBins = 50
    sequence bins = repeat(0,nBins+1)
    for i=1 to n do
        integer bdx = floor((dat[i]-mn)/range*nBins)+1
        bins[bdx] += 1
    end for
    for b=1 to nBins do
        puts(1,repeat('#',floor(nBins*bins[b]/n*30))&"\n")
    end for
end procedure

sample(100000)


V states = [‘Alabama’, ‘Alaska’, ‘Arizona’, ‘Arkansas’,
‘California’, ‘Colorado’, ‘Connecticut’, ‘Delaware’, ‘Florida’,
‘Georgia’, ‘Hawaii’, ‘Idaho’, ‘Illinois’, ‘Indiana’, ‘Iowa’, ‘Kansas’,
‘Kentucky’, ‘Louisiana’, ‘Maine’, ‘Maryland’, ‘Massachusetts’,
‘Michigan’, ‘Minnesota’, ‘Mississippi’, ‘Missouri’, ‘Montana’,
‘Nebraska’, ‘Nevada’, ‘New Hampshire’, ‘New Jersey’, ‘New Mexico’,
‘New York’, ‘North Carolina’, ‘North Dakota’, ‘Ohio’, ‘Oklahoma’,
‘Oregon’, ‘Pennsylvania’, ‘Rhode Island’, ‘South Carolina’,
‘South Dakota’, ‘Tennessee’, ‘Texas’, ‘Utah’, ‘Vermont’, ‘Virginia’,
‘Washington’, ‘West Virginia’, ‘Wisconsin’, ‘Wyoming’]

states = sorted(states)

DefaultDict[String, [String]] smap
L(s1) states[0 .< (len)-1]
   V i = L.index
   L(s2) states[i+1..]
      smap[sorted(s1‘’s2).join(‘’)].append(s1‘ + ’s2)

L(pairs) sorted(smap.values())
   I pairs.len > 1
      print(pairs.join(‘ = ’))


Procedure.f randomf(resolution = 2147483647)
  ProcedureReturn Random(resolution) / resolution
EndProcedure

Procedure.f normalDist() ;Box Muller method
   ProcedureReturn Sqr(-2 * Log(randomf())) * Cos(2 * #PI * randomf())
EndProcedure

Procedure sample(n, nBins = 50)
  Protected i, maxBinValue, binNumber
  Protected.f d, mean, sum, sumSq, mx, mn, range

  Dim dat.f(n)
  For i = 1 To n
    dat(i) = normalDist()
  Next

  ;show mean, standard deviation, find max & min.
  mx  = -1000
  mn  =  1000
  sum = 0
  sumSq = 0
  For i = 1 To n
    d = dat(i)
    If d > mx: mx = d: EndIf
    If d < mn: mn = d: EndIf
    sum + d
    sumSq + d * d
  Next

  PrintN(Str(n) + " data terms used.")
  PrintN("Largest term was " + StrF(mx) + " & smallest was " + StrF(mn))
  mean = sum / n
  PrintN("Mean = " + StrF(mean))
  PrintN("Stddev = " + StrF((sumSq / n) - Sqr(mean * mean)))

  ;show histogram
  range = mx - mn
  Dim bins(nBins)
  For i = 1 To n
    binNumber = Int(nBins * (dat(i) - mn) / range)
    bins(binNumber) + 1
  Next

  maxBinValue = 1
  For i = 0 To nBins
    If bins(i) > maxBinValue
      maxBinValue = bins(i)
    EndIf
  Next

  #normalizedMaxValue = 70
  For binNumber = 0 To nBins
    tickMarks = Round(bins(binNumber) * #normalizedMaxValue / maxBinValue, #PB_Round_Nearest)
    PrintN(ReplaceString(Space(tickMarks), " ", "#"))
  Next
  PrintN("")
EndProcedure

If OpenConsole()
  sample(100000)

  Print(#CRLF$ + #CRLF$ + "Press ENTER to exit"): Input()
  CloseConsole()
EndIf