import java.time.Duration
import java.time.LocalDateTime
import kotlin.math.sqrt

class Term(var coeff: Long, var ix1: Byte, var ix2: Byte)

const val maxDigits = 16

fun toLong(digits: List<Byte>, reverse: Boolean): Long {
    var sum: Long = 0
    if (reverse) {
        var i = digits.size - 1
        while (i >= 0) {
            sum = sum * 10 + digits[i]
            i--
        }
    } else {
        var i = 0
        while (i < digits.size) {
            sum = sum * 10 + digits[i]
            i++
        }
    }
    return sum
}

fun isSquare(n: Long): Boolean {
    val root = sqrt(n.toDouble()).toLong()
    return root * root == n
}

fun seq(from: Byte, to: Byte, step: Byte): List<Byte> {
    val res = mutableListOf<Byte>()
    var i = from
    while (i <= to) {
        res.add(i)
        i = (i + step).toByte()
    }
    return res
}

fun commatize(n: Long): String {
    var s = n.toString()
    val le = s.length
    var i = le - 3
    while (i >= 1) {
        s = s.slice(0 until i) + "," + s.substring(i)
        i -= 3
    }
    return s
}

fun main() {
    val startTime = LocalDateTime.now()
    var pow = 1L
    println("Aggregate timings to process all numbers up to:")
    // terms of (n-r) expression for number of digits from 2 to maxDigits
    val allTerms = mutableListOf<MutableList<Term>>()
    for (i in 0 until maxDigits - 1) {
        allTerms.add(mutableListOf())
    }
    for (r in 2..maxDigits) {
        val terms = mutableListOf<Term>()
        pow *= 10
        var pow1 = pow
        var pow2 = 1L
        var i1: Byte = 0
        var i2 = (r - 1).toByte()
        while (i1 < i2) {
            terms.add(Term(pow1 - pow2, i1, i2))

            pow1 /= 10
            pow2 *= 10

            i1++
            i2--
        }
        allTerms[r - 2] = terms
    }
    //  map of first minus last digits for 'n' to pairs giving this value
    val fml = mapOf(
        0.toByte() to listOf(listOf<Byte>(2, 2), listOf<Byte>(8, 8)),
        1.toByte() to listOf(listOf<Byte>(6, 5), listOf<Byte>(8, 7)),
        4.toByte() to listOf(listOf<Byte>(4, 0)),
        6.toByte() to listOf(listOf<Byte>(6, 0), listOf<Byte>(8, 2))
    )
    // map of other digit differences for 'n' to pairs giving this value
    val dmd = mutableMapOf<Byte, MutableList<List<Byte>>>()
    for (i in 0 until 100) {
        val a = listOf((i / 10).toByte(), (i % 10).toByte())
        val d = a[0] - a[1]
        dmd.getOrPut(d.toByte(), { mutableListOf() }).add(a)
    }
    val fl = listOf<Byte>(0, 1, 4, 6)
    val dl = seq(-9, 9, 1)  // all differences
    val zl = listOf<Byte>(0)                 // zero differences only
    val el = seq(-8, 8, 2)  // even differences only
    val ol = seq(-9, 9, 2)  // odd differences only
    val il = seq(0, 9, 1)
    val rares = mutableListOf<Long>()
    val lists = mutableListOf<MutableList<List<Byte>>>()
    for (i in 0 until 4) {
        lists.add(mutableListOf())
    }
    for (i_f in fl.withIndex()) {
        lists[i_f.index] = mutableListOf(listOf(i_f.value))
    }
    var digits = mutableListOf<Byte>()
    var count = 0

    // Recursive closure to generate (n+r) candidates from (n-r) candidates
    // and hence find Rare numbers with a given number of digits.
    fun fnpr(
        cand: List<Byte>,
        di: MutableList<Byte>,
        dis: List<List<Byte>>,
        indicies: List<List<Byte>>,
        nmr: Long,
        nd: Int,
        level: Int
    ) {
        if (level == dis.size) {
            digits[indicies[0][0].toInt()] = fml[cand[0]]?.get(di[0].toInt())?.get(0)!!
            digits[indicies[0][1].toInt()] = fml[cand[0]]?.get(di[0].toInt())?.get(1)!!
            var le = di.size
            if (nd % 2 == 1) {
                le--
                digits[nd / 2] = di[le]
            }
            for (i_d in di.slice(1 until le).withIndex()) {
                digits[indicies[i_d.index + 1][0].toInt()] = dmd[cand[i_d.index + 1]]?.get(i_d.value.toInt())?.get(0)!!
                digits[indicies[i_d.index + 1][1].toInt()] = dmd[cand[i_d.index + 1]]?.get(i_d.value.toInt())?.get(1)!!
            }
            val r = toLong(digits, true)
            val npr = nmr + 2 * r
            if (!isSquare(npr)) {
                return
            }
            count++
            print("     R/N %2d:".format(count))
            val checkPoint = LocalDateTime.now()
            val elapsed = Duration.between(startTime, checkPoint).toMillis()
            print("  %9sms".format(elapsed))
            val n = toLong(digits, false)
            println("  (${commatize(n)})")
            rares.add(n)
        } else {
            for (num in dis[level]) {
                di[level] = num
                fnpr(cand, di, dis, indicies, nmr, nd, level + 1)
            }
        }
    }

    // Recursive closure to generate (n-r) candidates with a given number of digits.
    fun fnmr(cand: MutableList<Byte>, list: List<List<Byte>>, indicies: List<List<Byte>>, nd: Int, level: Int) {
        if (level == list.size) {
            var nmr = 0L
            var nmr2 = 0L
            for (i_t in allTerms[nd - 2].withIndex()) {
                if (cand[i_t.index] >= 0) {
                    nmr += i_t.value.coeff * cand[i_t.index]
                } else {
                    nmr2 += i_t.value.coeff * -cand[i_t.index]
                    if (nmr >= nmr2) {
                        nmr -= nmr2
                        nmr2 = 0
                    } else {
                        nmr2 -= nmr
                        nmr = 0
                    }
                }
            }
            if (nmr2 >= nmr) {
                return
            }
            nmr -= nmr2
            if (!isSquare(nmr)) {
                return
            }
            val dis = mutableListOf<List<Byte>>()
            dis.add(seq(0, ((fml[cand[0]] ?: error("oops")).size - 1).toByte(), 1))
            for (i in 1 until cand.size) {
                dis.add(seq(0, (dmd[cand[i]]!!.size - 1).toByte(), 1))
            }
            if (nd % 2 == 1) {
                dis.add(il)
            }
            val di = mutableListOf<Byte>()
            for (i in 0 until dis.size) {
                di.add(0)
            }
            fnpr(cand, di, dis, indicies, nmr, nd, 0)
        } else {
            for (num in list[level]) {
                cand[level] = num
                fnmr(cand, list, indicies, nd, level + 1)
            }
        }
    }

    for (nd in 2..maxDigits) {
        digits = mutableListOf()
        for (i in 0 until nd) {
            digits.add(0)
        }
        if (nd == 4) {
            lists[0].add(zl)
            lists[1].add(ol)
            lists[2].add(el)
            lists[3].add(ol)
        } else if (allTerms[nd - 2].size > lists[0].size) {
            for (i in 0 until 4) {
                lists[i].add(dl)
            }
        }
        val indicies = mutableListOf<List<Byte>>()
        for (t in allTerms[nd - 2]) {
            indicies.add(listOf(t.ix1, t.ix2))
        }
        for (list in lists) {
            val cand = mutableListOf<Byte>()
            for (i in 0 until list.size) {
                cand.add(0)
            }
            fnmr(cand, list, indicies, nd, 0)
        }
        val checkPoint = LocalDateTime.now()
        val elapsed = Duration.between(startTime, checkPoint).toMillis()
        println("  %2d digits:  %9sms".format(nd, elapsed))
    }

    rares.sort()
    println("\nThe rare numbers with up to $maxDigits digits are:")
    for (i_rare in rares.withIndex()) {
        println("  %2d:  %25s".format(i_rare.index + 1, commatize(i_rare.value)))
    }
}


val .perfectsquare = f isInteger .n ^/ 2

val .israre = f(.n) {
    val .r = reverse(.n)
    if .n == .r: return false
    val .sum = .n + .r
    val .diff = .n - .r
    .diff > 0 and .perfectsquare(.sum) and .perfectsquare(.diff)
}

val .findfirst = f(.max) {
    for[=[]] .i = 0; ; .i += 1 {
        if .israre(.i) {
            _for ~= [.i]
            if len(_for) == .max: break
        }
    }
}

# if you have the time...
writeln "the first 5 rare numbers: ", .findfirst(5)


c = Compile[{{k, _Integer}},
  Module[{out = {0}, start = 0, stop = 0, rlist = {0}, r = 0,
    sum = 0.0, diff = 0.0, imax = 8, step = 10},
   Do[
    If[j == k, imax = 2, imax = 8];
    Do[
     If[i == 2,
      start = i 10^j + 2;
      stop = (i + 1) 10^j - 1;
      step = 10;
      ,
      start = i 10^j;
      stop = (i + 1) 10^j - 1;
      step = 1;
      ];
     Do[
      rlist = IntegerDigits[n];
      r = 0;
      Do[
       r += rlist[[ri]] 10^(ri - 1)
       ,
       {ri, 1, Length[rlist]}
       ];
      If[r != n,
       sum = n + r;
       sum = Sqrt[sum];
       If[Floor[sum] == sum,
        diff = n - r;
        If[diff > 0,
         diff = Sqrt[diff];
         If[Floor[diff] == diff,
          AppendTo[out, n]
          ]
         ]
        ]
       ]
      ,
      {n, start, stop, step}
      ]
     ,
     {i, 2, imax, 2}
     ]
    ,
    {j, 0, k}
    ];
   out
   ]
  ];
Rest[c[9]] (*takes about 310 sec*)


import algorithm, math, strformat, times

type Llst = seq[seq[int]]

const
  # Powers of 10.
  P = block:
        var p: array[19, int64]
        p[0] = 1i64
        for i in 1..18: p[i] = 10 * p[i - 1]
        p

  # Digital root lookup array.
  Drar = block:
           var drar: array[19, int]
           for i in 0..18: drar[i] = i shl 1 mod 9
           drar

var
  d: seq[int]           # permutation working slice
  dac: seq[int]         # running digital root slice
  ac: seq[int64]        # accumulator slice
  pp: seq[int64]        # coefficient slice that combines with digits of working slice
  sr: seq[int64]        # temporary list of squares used for building

var
  odd = false     # flag for odd number of digits
  sum: int64      # calculated sum of terms (square candidate)
  cn = 0          # solution counter
  nd = 2          # number of digits
  nd1 = nd - 1    # 'nd' helper
  ln: int         # previous value of 'n' (in recurse())
  dl: int         # length of 'd' slice

func newIntSeq(f, t, s: int): seq[int] =
  ## Return a sequence of integers.
  result = newSeq[int]((t - f) div s + 1)
  var f = f
  for i in 0..result.high:
    result[i] = f
    inc f, s

const
  Tlo = @[0, 1, 4, 5, 6]                   # primary differences starting point
  All = newIntSeq(-9, 9, 1)                # all possible differences
  Odl = newIntSeq(-9, 9, 2)                # odd possible differences
  Evl = newIntSeq(-8, 8, 2)                # even possible differences
  Thi = @[4, 5, 6, 9, 10, 11, 14, 15, 16]  # primary sums starting point
  Alh = newIntSeq(0, 18, 1)                # all possible sums
  Odh = newIntSeq(1, 17, 2)                # odd possible sums
  Evh = newIntSeq(0, 18, 2)                # even possible sums
  Ten = newIntSeq(0, 9, 1)                 # used for odd number of digits
  Z   = newIntSeq(0, 0, 1)                 # no difference, avoids generating a bunch of negative square candidates
  T7  = @[-3, 7]                           # shortcut for low 5
  Nin = @[9]                               # shortcut for hi 10
  Tn  = @[10]                              # shortcut for hi 0 (unused, unneeded)
  T12 = @[2, 12]                           # shortcut for hi 5
  O11 = @[1, 11]                           # shortcut for hi 15
  Pos = @[0, 1, 4, 5, 6, 9]                # shortcut for 2nd lo 0

var
  lul: Llst = @[Z, Odl, @[], @[], Evl, T7, Odl]             # shortcut lookup lo primary
  luh: Llst = @[Tn, Evh, @[], @[], Evh, T12, Odh, @[], @[],
                Evh, Nin, Odh, @[], @[], Odh, O11, Evh]     # shortcut lookup hi primary
  l2l: Llst = @[Pos, @[], @[], @[], All, @[], All]          # shortcut lookup lo secondary
  l2h: Llst = @[@[], @[], @[], @[], Alh, @[], Alh, @[], @[],
                @[], Alh, @[], @[], @[], Alh, @[], Alh]     # shortcut lookup hi secondary
  chTen: Llst = @[@[0, 2, 5, 8, 9], @[0, 3, 4, 6, 9], @[1, 4, 7, 8],
                  @[2, 3, 5, 8], @[0, 3, 6, 7, 9], @[1, 2, 4, 7],
                  @[2, 5, 6, 8], @[0, 1, 3, 6, 9], @[1, 4, 5, 7]]
  chAH: Llst = @[@[0, 2, 5, 8, 9, 11, 14, 17, 18], @[0, 3, 4, 6, 9, 12, 13, 15, 18],
                 @[1, 4, 7, 8, 10, 13, 16, 17], @[2, 3, 5, 8, 11, 12, 14, 17],
                 @[0, 3, 6, 7, 9, 12, 15, 16, 18], @[1, 2, 4, 7, 10, 11, 13, 16],
                 @[2, 5, 6, 8, 11, 14, 15, 17], @[0, 1, 3, 6, 9, 10, 12, 15, 18],
                 @[1, 4, 5, 7, 10, 13, 14, 16]]

var lu, l2: Llst

func isr(s: int64): int64 {.inline.} =
  ## Return integer square root.
  int64(sqrt(float(s)))

proc isRev(nd: int; f, r: int64): bool =
  ## Recursively determines whether 'r' is the reverse of 'f'.
  let nd = nd - 1
  if f div P[nd] != r mod 10: return false
  if nd < 1: return true
  result = isRev(nd, f mod P[nd], r div 10)

proc recurseLE5(lst: Llst; lv: int) =
  ## Recursive function to evaluate the permutations, no shortcuts.
  if lv == dl:        # Check if on last stage of permutation.
    sum = ac[lv - 1]
    if sum > 0:
      let rt = int64(sqrt(float(sum)))
      if rt * rt == sum: sr.add sum
  else:
    for n in lst[lv]:     # Set up next permutation.
      d[lv] = n
      if lv == 0: ac[0] = pp[0] * n
      else: ac[lv] = ac[lv - 1] + pp[lv] * n   # Update accumulated sum.
      recurseLE5(lst, lv + 1)                  # Recursively call next level.

proc recursehi(lst: var Llst; lv: int) =
  ## Recursive function to evaluate the hi permutations.
  ## Shortcuts added to avoid generating many non-squares, digital root calc added.
  let lv1 = lv - 1
  if lv == dl:    # Check if on last stage of permutation.
    sum = ac[lv1]
    if (0x202021202030213 and (1 shl (sum and 63))) != 0:
      # Test accumulated sum, append to result if square.
      let rt = int64(sqrt(float64(sum)))
      if rt * rt == sum: sr.add sum
  else:
    for n in lst[lv]:     # Set up next permutation.
      d[lv] = n
      if lv == 0:
        ac[0] = pp[0] * n
        dac[0] = Drar[n]    # Update accumulated sum and running dr.
      else:
        ac[lv] = ac[lv1] + pp[lv] * n
        dac[lv] = dac[lv1] + Drar[n]
        if dac[lv] > 8: dec dac[lv], 9
      case lv     # Shortcuts to be performed on designated levels.
      of 0:       # Primary level: set shortcuts for secondary level.
        ln = n
        lst[1] = lu[ln]
        lst[2] = l2[n]
      of 1:       # Secondary level: set shortcuts for tertiary level.
        case ln   # For sums.
        of 5, 15: lst[2] = if n < 10: Evh else: Odh
        of 9: lst[2] = if (n shr 1 and 1) == 0: Evh else: Odh
        of 11: lst[2] = if (n shr 1 and 1) == 1: Evh else: Odh
        else: discard
      else: discard
      if lv == dl - 2:
        # Reduce last round according to dr calc.
        lst[dl - 1] = if odd: chTen[dac[dl - 2]] else: chAH[dac[dl - 2]]
      recursehi(lst, lv + 1)  # Recursively call next level.

proc recurselo(lst: var Llst; lv: int) =
  ## Recursive function to evaluate the lo permutations.
  ## Shortcuts added to avoid generating many non-squares.
  let lv1 = lv - 1
  if lv == dl:    # Check if on last stage of permutation.
    sum = ac[lv1]
    if sum > 0:
      let rt = int64(sqrt(float64(sum)))
      if rt * rt == sum: sr.add sum
  else:
    for n in lst[lv]:     # Set up next permutation.
      d[lv] = n
      if lv == 0: ac[0] = pp[0] * n
      else: ac[lv] = ac[lv1] + pp[lv] * n  # Update accumulated sum.
      case lv     # Shortcuts to be performed on designated levels.
      of 0:       # Primary level: set shortcuts for secondary level.
        ln = n
        lst[1] = lu[ln]
        lst[2] = l2[n]
      of 1:       # Secondary level: set shortcuts for tertiary level.
        case ln   # For difs.
        of 1: lst[2] = if ((n + 9) shr 1 and 1) == 0: Evl else: Odl
        of 5: lst[2] = if n < 0: Evl else: Odl
        else: discard
      else: discard
      recurselo(lst, lv + 1)    # Recursively call next level.

proc listEm(lst: var Llst; plu, pl2: Llst): seq[int64] =
  ## Produces a list of candidate square numbers.
  dl = lst.len
  d = newSeq[int](dl)
  sr.setLen(0)
  lu = plu
  l2 = pl2
  ac = newSeq[int64](dl)
  dac = newSeq[int](dl)
  pp = newSeq[int64](dl)
  # Build coefficients array.
  for i in 0..<dl:
    pp[i] = if lst[0].len > 6: P[nd1 - i] + P[i] else: P[nd1 - i] - P[i]
  # Call appropriate recursive function.
  if nd <= 5: recurseLE5(lst, 0)
  elif lst[0].len > 8: recursehi(lst, 0)
  else: recurselo(lst, 0)
  result = sr

proc reveal(lo, hi: openArray[int64]) =
  ## Reveal whether combining two lists of squares can produce a rare number.
  var s: seq[string]   # Temporary list of results.
  for l in lo:
    for h in hi:
      let r = (h - l) shr 1
      let f = h - r   # Generate all possible fwd & rev candidates from lists.
      if isRev(nd, f, r):
        s.add &"{f:20} {isr(h):11} {isr(l):10}  "
  s.sort()
  if s.len > 0:
    for t in s:
      inc cn
      let tt = if t != s[^1]: "\n" else: ""
      stdout.write &"{cn:2} {t}{tt}"
  else:
    stdout.write &"{\"\":48}"

func formatTime(d: Duration): string =
  var f = d.inMilliseconds
  var s = f div 1000
  f = f mod 1000
  var m = s div 60
  s = s mod 60
  let h = m div 60
  m = m mod 60
  result = &"{h:02}:{m:02}:{s:02}.{f:03}"

var
  lls: Llst = @[Tlo]
  hls: Llst = @[Thi]

var bstart, tstart = now()

echo &"""nth {"forward":>19} {"rt.sum":>11} {"rt.dif":>10}  digs {"block time":>11} {"total time":>13}"""

while nd <= 18:
  if nd > 2:
    if odd:
      hls.add Ten
    else:
      lls.add All
      hls[^1] = Alh
  reveal(listEm(lls, lul, l2l), listEm(hls, luh, l2h))
  if not odd and nd > 5:
    # Restore last element of hls, so that dr shortcut doesn't mess up next nd.
    hls[^1] = Alh
  let bTime = formatTime(now() - bstart)
  let tTime = formatTime(now() - tstart)
  echo &"{nd:2}: {bTime}  {tTime}"
  bstart = now()  # Restart block timing.
  nd1 = nd
  inc nd
  odd = not odd


#!/usr/bin/perl

use strict; # https://rosettacode.org/wiki/Rare_numbers
use warnings;
use integer;

my $count = 0;
my @squares;
for my $large ( 0 .. 1e5 )
  {
  my $largesquared = $squares[$large] = $large * $large; # $large ** 2;
  for my $small ( 0 .. $large - 1 )
    {
    my $n = $largesquared + $squares[$small];
    2 * $large * $small == reverse $n or next;
    printf "%12s %s\n", $n, scalar reverse $n;
    $n == reverse $n and die "oops!"; # palindrome check
    ++$count >= 5 and exit;
    }
  }


with javascript_semantics
function revn(atom n, integer nd)
    atom r = 0
    for i=1 to nd do
        r = r*10+remainder(n,10)
        n = floor(n/10)
    end for
    return r
end function

integer nd = 2, count = 0
atom lim = 99, n = 9, t0 = time()
while true do
    n += 1
    atom r = revn(n,nd)
    if r<n then
        atom s = n+r,
             d = n-r
        if s=power(floor(sqrt(s)),2)
        and d=power(floor(sqrt(d)),2) then
            count += 1
            printf(1,"%d: %d (%s)\n",{count,n,elapsed(time()-t0)})
            if count=3 then exit end if
        end if
    end if
    if n=lim then
--      ?{"lim",lim,elapsed(time()-t0)}
        lim = lim*10+9
        nd += 1
    end if
end while


# rare.py
# find rare numbers
# by kHz

from math import floor, sqrt
from datetime import datetime

def main():
	start = datetime.now()
	for i in xrange(1, 10 ** 11):
		if rare(i):
			print "found a rare:", i
	end = datetime.now()
	print "time elapsed:", end - start

def is_square(n):
	s = floor(sqrt(n + 0.5))
	return s * s == n

def reverse(n):
	return int(str(n)[::-1])

def is_palindrome(n):
	return n == reverse(n)

def rare(n):
	r = reverse(n)
	return (
		not is_palindrome(n) and
		n > r and
		is_square(n+r) and is_square(n-r)
	)

if __name__ == '__main__':
	main()


[ dup 1
    [ 2dup > while
      + 1 >>
      2dup / again ]
    drop nip ]                  is sqrt        (   n --> n )

[ dup sqrt 2 ** = not ]         is !square     (   n --> b )

[ number$ reverse
  $->n drop ]                    is revnumber   (   n --> n )

[ 0 swap
  [ base share /mod
    rot + swap
    dup 0 = until ]
  drop ]                        is digitalroot (   n --> n )

 [ true swap
   dup revnumber
   2dup > not iff
     [ 2drop not ] done
   2dup + !square iff
     [ 2drop not ] done
   2dup - !square iff
     [ 2drop not ] done
   2drop ]                     is rare         (   n --> b )

  [ 0
    [ 1+ dup rare if
        [ dup echo cr
          dip [ 1 - ] ]
      over 0 = until ]
    2drop ]                    is echorarenums (   n --> b )

5 echorarenums


# 20220315 Raku programming solution

sub rare (\target where ( target > 0 and target ~~ Int )) {

   my \digit          = $ = 2;
   my $count          = 0;
   my @numeric_digits = 0..9 Z, 0 xx *;
   my @diffs1         = 0,1,4,5,6;

   # all possible digits pairs to calculate potential diffs
   my @pairs     = 0..9 X 0..9;
   my @all_diffs = -9..9;

   # lookup table for the first diff
   my @lookup_1 = [ [[2, 2], [8, 8]],    # Diff = 0
                    [[8, 7], [6, 5]],    # Diff = 1
                    [],
                    [],
                    [[4, 0],       ],    # Diff = 4
                    [[8, 3],       ],    # Diff = 5
                    [[6, 0], [8, 2]], ]; # Diff = 6

   # lookup table for all the remaining diffs
   given my %lookup_n { for @pairs -> \pair { $_{ [-] pair.values }.push: pair } }

   loop {
      my @powers = 10 <<**<< (0..digit-1); #  powers like 1, 10, 100, 1000....

      #  for n-r (aka L) the required terms, like 9/ 99 / 999 & 90 / 99999 & 9999 & 900 etc
      my @terms = (@powers.reverse Z- @powers).grep: * > 0 ;

      # create a cartesian product for all potential diff numbers
      # for the first use the very short one, for all other the complete 19 element
      my @diff_list = digit == 2 ?? @diffs1 !! [X] @diffs1, |(@all_diffs xx digit div 2 - 1);

      my @diff_list_iter = gather for @diff_list -> \k {
         # remove invalid first diff/second diff combinations
         { take k andthen next } if k.elems == 1 ;
         given (my (\a,\b) = k.values) {
            when a == 0 && b != 0                                    { next }
            when a == 1 && b ∉ [ -7, -5, -3, -1,  1, 3, 5, 7       ] { next }
            when a == 4 && b ∉ [ -8, -6, -4, -2,  0, 2, 4, 6, 8    ] { next }
            when a == 5 && b ∉ [ -3,  7                            ] { next }
            when a == 6 && b ∉ [ -9, -7, -5, -3, -1, 1, 3, 5, 7, 9 ] { next }
            default { take k }
         }
      }

      for @diff_list_iter -> \diffs {
         # calculate difference of original n and its reverse (aka L = n-r)
         # which must be a perfect square
         if (my \L = [+] diffs <<*>> @terms) > 0 and { $_ == $_.Int }(L.sqrt) {
            # potential candiate, at least L is a perfect square
            # placeholder for the digits
            my \dig = @ = 0 xx digit;

            # generate a cartesian product for each identified diff using the lookup tables
            my @c_iter = digit == 2
               ?? @lookup_1[diffs[0]].map: { [ $_ ] }
               !! [X] @lookup_1[diffs[0]], |(1..(+diffs + (digit % 2 - 1))).map: -> \k {
                  k == diffs ?? @numeric_digits !! %lookup_n{diffs[k]} }

            # check each H (n+r) by using digit combination
            for @c_iter -> \elt {
               for elt.kv -> \i, \pair { dig[i,digit-1-i] = pair.values }
               # for numbers with odd # digits restore the middle digit
               # which has been overwritten at the end of the previous cycle
               dig[(digit - 1) div 2] = elt[+elt - 1][0] if digit % 2 == 1 ;

	       my \rev = ( my \num = [~] dig ).flip;

               if num > rev and { $_ == $_.Int }((num+rev).sqrt) {
                  printf "%d: %12d reverse %d\n", $count+1, num, rev;
		  exit if ++$count == target;
               }
            }
         }
      }
      digit++
   }
}

my $N = 5;
say "The first $N rare numbers are,";
rare $N;


load "stdlib.ring"

see "working..." + nl
see "the first 5 rare numbers are:" + nl

num = 0

for n = 1 to 2042832002
    strn = string(n)
    nrev = ""
    for m = len(strn) to 1 step -1
        nrev = nrev + strn[m]
    next
    nrev = number(nrev)
    sum = n + nrev
    diff = n - nrev
    if diff < 1
       loop
    ok
    sqrtsum = sqrt(sum)
    flagsum = (sqrtsum = floor(sqrtsum))
    sqrtdiff = sqrt(diff)
    flagdiff= (sqrtdiff = floor(sqrtdiff))
    if flagsum = 1 and flagdiff = 1
       num = num + 1
       see "" + num + ": " + n + nl
    ok
next
see "done..." + nl


Term = Struct.new(:coeff, :ix1, :ix2) do
end

MAX_DIGITS = 16

def toLong(digits, reverse)
    sum = 0
    if reverse then
        i = digits.length - 1
        while i >=0
            sum = sum  *10 + digits[i]
            i = i - 1
        end
    else
        i = 0
        while i < digits.length
            sum = sum * 10 + digits[i]
            i = i + 1
        end
    end
    return sum
end

def isSquare(n)
    root = Math.sqrt(n).to_i
    return root * root == n
end

def seq(from, to, step)
    res = []
    i = from
    while i <= to
        res << i
        i = i + step
    end
    return res
end

def format_number(number)
  number.to_s.reverse.gsub(/(\d{3})(?=\d)/, '\\1,').reverse
end

def main
    pow = 1
    allTerms = []
    for i in 0 .. MAX_DIGITS - 2
        allTerms << []
    end
    for r in 2 .. MAX_DIGITS
        terms = []
        pow = pow * 10
        pow1 = pow
        pow2 = 1
        i1 = 0
        i2 = r - 1
        while i1 < i2
            terms << Term.new(pow1 - pow2, i1, i2)
            pow1 = (pow1 / 10).to_i
            pow2 = pow2 * 10
            i1 = i1 + 1
            i2 = i2 - 1
        end
        allTerms[r - 2] = terms
    end
    # map of first minus last digits for 'n' to pairs giving this value
    fml = {
        0 =>[[2, 2], [8, 8]],
        1 =>[[6, 5], [8, 7]],
        4 =>[[4, 0]],
        6 =>[[6, 0], [8, 2]]
    }
    # map of other digit differences for 'n' to pairs giving this value
    dmd = {}
    for i in 0 .. 99
        a = [(i / 10).to_i, (i % 10)]
        d = a[0] - a[1]
        if dmd.include?(d) then
            dmd[d] << a
        else
            dmd[d] = [a]
        end
    end
    fl = [0, 1, 4, 6]
    dl = seq(-9, 9, 1) # all differences
    zl = [0]           # zero differences only
    el = seq(-8, 8, 2) # even differences
    ol = seq(-9, 9, 2) # odd differences only
    il = seq(0, 9, 1)
    rares = []
    lists = []
    for i in 0 .. 3
        lists << []
    end
    fl.each_with_index { |f, i|
        lists[i] = [[f]]
    }
    digits = []
    count = 0

    # Recursive closure to generate (n+r) candidates from (n-r) candidates
    # and hence find Rare numbers with a given number of digits.
    fnpr = lambda { |cand, di, dis, indices, nmr, nd, level|
        if level == dis.length then
            digits[indices[0][0]] = fml[cand[0]][di[0]][0]
            digits[indices[0][1]] = fml[cand[0]][di[0]][1]
            le = di.length
            if nd % 2 == 1 then
                le = le - 1
                digits[(nd / 2).to_i] = di[le]
            end
            di[1 .. le - 1].each_with_index { |d, i|
                digits[indices[i + 1][0]] = dmd[cand[i + 1]][d][0]
                digits[indices[i + 1][1]] = dmd[cand[i + 1]][d][1]
            }
            r = toLong(digits, true)
            npr = nmr + 2 * r
            if not isSquare(npr) then
                return
            end
            count = count + 1
            print "     R/N %2d:" % [count]
            n = toLong(digits, false)
            print "  (%s)\n" % [format_number(n)]
            rares << n
        else
            for num in dis[level]
                di[level] = num
                fnpr.call(cand, di, dis, indices, nmr, nd, level + 1)
            end
        end
    }

    # Recursive closure to generate (n-r) candidates with a given number of digits.
    fnmr = lambda { |cand, list, indices, nd, level|
        if level == list.length then
            nmr = 0
            nmr2 = 0
            allTerms[nd - 2].each_with_index { |t, i|
                if cand[i] >= 0 then
                    nmr = nmr + t.coeff * cand[i]
                else
                    nmr2 = nmr2 = t.coeff * -cand[i]
                    if nmr >= nmr2 then
                        nmr = nmr - nmr2
                        nmr2 = 0
                    else
                        nmr2 = nmr2 - nmr
                        nmr = 0
                    end
                end
            }
            if nmr2 >= nmr then
                return
            end
            nmr = nmr - nmr2
            if not isSquare(nmr) then
                return
            end
            dis = []
            dis << seq(0, fml[cand[0]].length - 1, 1)
            for i in 1 .. cand.length - 1
                dis << seq(0, dmd[cand[i]].length - 1, 1)
            end
            if nd % 2 == 1 then
                dis << il.dup
            end
            di = []
            for i in 0 .. dis.length - 1
                di << 0
            end
            fnpr.call(cand, di, dis, indices, nmr, nd, 0)
        else
            for num in list[level]
                cand[level] = num
                fnmr.call(cand, list, indices, nd, level + 1)
            end
        end
    }

    #for nd in 2 .. MAX_DIGITS - 1
    for nd in 2 .. 10
        digits = []
        for i in 0 .. nd - 1
            digits << 0
        end
        if nd == 4 then
            lists[0] << zl.dup
            lists[1] << ol.dup
            lists[2] << el.dup
            lists[3] << ol.dup
        elsif allTerms[nd - 2].length > lists[0].length then
            for i in 0 .. 3
                lists[i] << dl.dup
            end
        end
        indices = []
        for t in allTerms[nd - 2]
            indices << [t.ix1, t.ix2]
        end
        for list in lists
            cand = []
            for i in 0 .. list.length - 1
                cand << 0
            end
            fnmr.call(cand, list, indices, nd, 0)
        end
        print "  %2d digits\n" % [nd]
    end

    rares.sort()
    print "\nThe rare numbers with up to %d digits are:\n" % [MAX_DIGITS]
    rares.each_with_index { |rare, i|
        print "  %2d:  %25s\n" % [i + 1, format_number(rare)]
    }
end

main()


use itertools::Itertools;
use std::collections::HashMap;
use std::convert::TryInto;
use std::fmt;
use std::time::Instant;

#[derive(Debug)]
struct RareResults {
    digits: u8,
    time_to_find: u128,
    counter: u32,
    number: u64,
}

impl fmt::Display for RareResults {
    fn fmt(&self, f: &mut fmt::Formatter) -> fmt::Result {
        write!(
            f,
            "{:>6} {:>6} ms {:>2}. {}",
            self.digits, self.time_to_find, self.counter, self.number
        )
    }
}

fn print_results(results: Vec<RareResults>) {
    if results.len() != 0 {
        // println!("Results:");
        println!("digits      time  #. Rare number");
        for r in results {
            println!("{}", r);
        }
    }
}

fn isqrt(n: u64) -> u64 {
    let mut s = (n as f64).sqrt() as u64;
    s = (s + n / s) >> 1;
    if s * s > n {
        s - 1
    } else {
        s
    }
}

fn is_square(n: u64) -> bool {
    match n & 0xf {
        0 | 1 | 4 | 9 => {
            let t = isqrt(n);
            t * t == n
        }
        _ => false,
    }
}

fn get_reverse(number: &u64) -> u64 {
    number
        .to_string()
        .chars()
        .map(|c| c.to_digit(10).unwrap())
        .enumerate()
        .fold(0_u64, |a, (i, d)| a + 10_u64.pow(i as u32) * d as u64)
}
fn is_rare(number: u64) -> bool {
    let reverse = get_reverse(&number);

    reverse != number
        && number > reverse
        && is_square(number + reverse)
        && is_square(number - reverse)
}

/// This method is a very simple naive search, using brute-force to check a high amount of numbers
/// for satisfying the rare number criterias. As such it is rather slow, and above 10 digits it's
/// not really performant, release version takes ~30 secs to find the first 5 (max 10 digits)
fn naive(digit: u8) -> Vec<RareResults> {
    let bp_equal = (0_u8..=9).zip(0_u8..=9).collect::<Vec<(u8, u8)>>();
    let bp_zero_or_even = (0_u8..=9)
        .cartesian_product(0_u8..=9)
        .filter(|pair| (pair.0 == pair.1) || (pair.0 as i32 - pair.1 as i32).abs() % 2 == 0)
        .collect::<Vec<(u8, u8)>>();

    let bp_odd = (0_u8..=9)
        .cartesian_product(0_u8..=9)
        .filter(|pair| (pair.0 as i32 - pair.1 as i32).abs() % 2 == 1)
        .collect::<Vec<(u8, u8)>>();

    let bp_9 = (0_u8..=9)
        .cartesian_product(0_u8..=9)
        .filter(|pair| pair.0 + pair.1 == 9)
        .collect::<Vec<(u8, u8)>>();

    let bp_73 = (0_u8..=9)
        .cartesian_product(0_u8..=9)
        .filter(|pair| [7, 3].contains(&(pair.0 as i8 - pair.1 as i8)))
        .collect::<Vec<(u8, u8)>>();

    let bp_11 = (0_u8..=9)
        .cartesian_product(0_u8..=9)
        .filter(|pair| pair.0 + pair.1 == 11 || pair.1 + pair.0 == 1)
        .collect::<Vec<(u8, u8)>>();

    let aq_bp_setup: Vec<((u8, u8), &Vec<(u8, u8)>)> = vec![
        ((2, 2), &bp_equal),
        ((4, 0), &bp_zero_or_even),
        ((6, 0), &bp_odd),
        ((6, 5), &bp_odd),
        ((8, 2), &bp_9),
        ((8, 3), &bp_73),
        ((8, 7), &bp_11),
        ((8, 8), &bp_equal),
    ];

    //generate AB-PQ combinations
    let aq_bp = aq_bp_setup
        .iter()
        .map(|e| {
            e.1.iter().fold(vec![], |mut out, b| {
                out.push(vec![e.0 .0, b.0, b.1, e.0 .1]);
                out
            })
        })
        .flatten()
        .collect::<Vec<_>>();

    let mut results: Vec<RareResults> = Vec::new();
    let mut counter = 0_u32;
    let start_time = Instant::now();

    let d = digit;
    print!("Digits: {} ", d);

    if d < 4 {
        for n in 10_u64.pow((d - 1).into())..10_u64.pow(d.into()) {
            if is_rare(n) {
                counter += 1;
                results.push(RareResults {
                    digits: d,
                    time_to_find: start_time.elapsed().as_millis(),
                    counter,
                    number: n,
                });
            }
        }
    } else {
        aq_bp.iter().for_each(|abqp| {
            let start = abqp[0] as u64 * 10_u64.pow((d - 1).into())
                + abqp[1] as u64 * 10_u64.pow((d - 2).into())
                + 10_u64 * abqp[2] as u64
                + abqp[3] as u64;

            // brute-force checking all numbers which matches the pattern AB...PQ
            // very slow
            for n in (start..start + 10_u64.pow((d - 2).into())).step_by(100) {
                if is_rare(n) {
                    counter += 1;
                    results.push(RareResults {
                        digits: d,
                        time_to_find: start_time.elapsed().as_millis(),
                        counter,
                        number: n,
                    });
                }
            }
        });
    }

    println!(
        "Digits: {} done - Elapsed time(ms): {}",
        d,
        start_time.elapsed().as_millis()
    );

    results
}

/// This algorithm uses an advanced search strategy based on Nigel Galloway's approach,
/// and can find the first 40 rare numers (16 digits) within reasonable
/// time in release version
fn advanced(digit: u8) -> Vec<RareResults> {
    // setup
    let mut results: Vec<RareResults> = Vec::new();
    let mut counter = 0_u32;
    let start_time = Instant::now();

    let numeric_digits = (0..=9).map(|x| [x, 0]).collect::<Vec<_>>();
    let diffs1: Vec<i8> = vec![0, 1, 4, 5, 6];

    // all possible digits pairs to calculate potential diffs
    let pairs = (0_i8..=9)
        .cartesian_product(0_i8..=9)
        .map(|x| [x.0, x.1])
        .collect::<Vec<_>>();
    let all_diffs = (-9i8..=9).collect::<Vec<_>>();

    // lookup table for the first diff
    let lookup_1 = vec![
        vec![[2, 2], [8, 8]], //Diff = 0
        vec![[8, 7], [6, 5]], //Diff = 1
        vec![],
        vec![],
        vec![[4, 0]],         // Diff = 4
        vec![[8, 3]],         // Diff = 5
        vec![[6, 0], [8, 2]], // Diff = 6
    ];

    // lookup table for all the remaining diffs
    let lookup_n: HashMap<i8, Vec<_>> = pairs.into_iter().into_group_map_by(|elt| elt[0] - elt[1]);

    let d = digit;

    // powers like 1, 10, 100, 1000....
    let powers = (0..d).map(|x| 10_u64.pow(x.into())).collect::<Vec<u64>>();

    // for n-r (aka L) the required terms, like 9/ 99 / 999 & 90 / 99999 & 9999 & 900 etc
    let terms = powers
        .iter()
        .zip(powers.iter().rev())
        .map(|(a, b)| b.checked_sub(*a).unwrap_or(0))
        .filter(|x| *x != 0)
        .collect::<Vec<u64>>();

    // create a cartesian product for all potential diff numbers
    // for the first use the very short one, for all other the complete 19 element
    let diff_list_iter = (0_u8..(d / 2))
            .map(|i| match i {
                0 => diffs1.iter(),
                _ => all_diffs.iter(),
            })
            .multi_cartesian_product()
            // remove invalid first diff/second diff combinations - custom iterator would be probably better
            .filter(|x| {
                if x.len() == 1 {
                    return true;
                }
                match (*x[0], *x[1]) {
                    (a, b) if (a == 0 && b != 0) => false,
                    (a, b) if (a == 1 && ![-7, -5, -3, -1, 1, 3, 5, 7].contains(&b)) => false,
                    (a, b) if (a == 4 && ![-8, -6, -4, -2, 0, 2, 4, 6, 8].contains(&b)) => false,
                    (a, b) if (a == 5 && ![7, -3].contains(&b)) => false,
                    (a, b) if (a == 6 && ![-9, -7, -5, -3, -1, 1, 3, 5, 7, 9].contains(&b)) => {
                        false
                    }
                    _ => true,
                }
            });

    #[cfg(debug_assertions)]
    {
        println!("  powers: {:?}", powers);
        println!("  terms: {:?}", terms);
    }

    diff_list_iter.for_each(|diffs| {
        // calculate difference of original n and its reverse (aka L = n-r)
        // which must be a perfect square
        let l: i64 = diffs
            .iter()
            .zip(terms.iter())
            .map(|(diff, term)| **diff as i64 * *term as i64)
            .sum();

        if l > 0 && is_square(l.try_into().unwrap()) {
            // potential candiate, at least L is a perfect square
            #[cfg(debug_assertions)]
            println!("  square L: {}, diffs: {:?}", l, diffs);

            // placeholder for the digits
            let mut dig: Vec<i8> = vec![0_i8; d.into()];

            // generate a cartesian product for each identified diff using the lookup tables
            let c_iter = (0..(diffs.len() + d as usize % 2))
                .map(|i| match i {
                    0 => lookup_1[*diffs[0] as usize].iter(),
                    _ if i != diffs.len() => lookup_n.get(diffs[i]).unwrap().iter(),
                    _ => numeric_digits.iter(), // for the middle digits
                })
                .multi_cartesian_product();

            // check each H (n+r) by using digit combination
            c_iter.for_each(|elt| {
                // print!("    digits combinations: {:?}", elt);
                for (i, digit_pair) in elt.iter().enumerate() {
                    // print!("  digit pairs: {:?}, len: {}", digit_pair, l.len());
                    dig[i] = digit_pair[0];
                    dig[d as usize - 1 - i] = digit_pair[1]
                }

                // for numbers with odd # digits restore the middle digit
                // which has been overwritten at the end of the previous cycle
                if d % 2 == 1 {
                    dig[(d as usize - 1) / 2] = elt[elt.len() - 1][0];
                }

                let num = dig
                    .iter()
                    .rev()
                    .enumerate()
                    .fold(0_u64, |acc, (i, d)| acc + 10_u64.pow(i as u32) * *d as u64);

                let reverse = dig
                    .iter()
                    .enumerate()
                    .fold(0_u64, |acc, (i, d)| acc + 10_u64.pow(i as u32) * *d as u64);

                if num > reverse && is_square(num + reverse) {
                    println!("  FOUND: {}, reverse: {}", num, reverse);
                    counter += 1;
                    results.push(RareResults {
                        digits: d,
                        time_to_find: start_time.elapsed().as_millis(),
                        counter,
                        number: num,
                    });
                }
            });
        }
    });

    println!(
        "Digits: {} done - Elapsed time(ms): {}",
        d,
        start_time.elapsed().as_millis()
    );

    results
}
fn main() {
    println!("Run this program in release mode for measuring performance");
    println!("Naive version:");
    (1..=10).for_each(|x| print_results(naive(x)));

    println!("Advanced version:");
    (1..=15).for_each(|x| print_results(advanced(x)));
}


Imports System.Console
Imports DT = System.DateTime
Imports Lsb = System.Collections.Generic.List(Of SByte)
Imports Lst = System.Collections.Generic.List(Of System.Collections.Generic.List(Of SByte))
Imports UI = System.UInt64

Module Module1
    Const MxD As SByte = 15

    Public Structure term
        Public coeff As UI : Public a, b As SByte
        Public Sub New(ByVal c As UI, ByVal a_ As Integer, ByVal b_ As Integer)
            coeff = c : a = CSByte(a_) : b = CSByte(b_)
        End Sub
    End Structure

    Dim nd, nd2, count As Integer, digs, cnd, di As Integer()
    Dim res As List(Of UI), st As DT, tLst As List(Of List(Of term))
    Dim lists As List(Of Lst), fml, dmd As Dictionary(Of Integer, Lst)
    Dim dl, zl, el, ol, il As Lsb, odd As Boolean, ixs, dis As Lst, Dif As UI

    ' converts digs array to the "difference"
    Function ToDif() As UI
        Dim r As UI = 0 : For i As Integer = 0 To digs.Length - 1 : r = r * 10 + digs(i)
        Next : Return r
    End Function

    ' converts digs array to the "sum"
    Function ToSum() As UI
        Dim r As UI = 0 : For i As Integer = digs.Length - 1 To 0 Step -1 : r = r * 10 + digs(i)
        Next : Return Dif + (r << 1)
    End Function

    '  determines if the nmbr is square or not
    Function IsSquare(nmbr As UI) As Boolean
        If (&H202021202030213 And (1UL << (nmbr And 63))) <> 0 Then _
            Dim r As UI = Math.Sqrt(nmbr) : Return r * r = nmbr Else Return False
    End Function

    '// returns sequence of SBbytes
    Function Seq(from As SByte, upto As Integer, Optional stp As SByte = 1) As Lsb
        Dim res As Lsb = New Lsb()
        For item As SByte = from To upto Step stp : res.Add(item) : Next : Return res
    End Function

    ' Recursive closure to generate (n+r) candidates from (n-r) candidates
    Sub Fnpr(ByVal lev As Integer)
        If lev = dis.Count Then
            digs(ixs(0)(0)) = fml(cnd(0))(di(0))(0) : digs(ixs(0)(1)) = fml(cnd(0))(di(0))(1)
            Dim le As Integer = di.Length, i As Integer = 1
            If odd Then le -= 1 : digs(nd >> 1) = di(le)
            For Each d As SByte In di.Skip(1).Take(le - 1)
                digs(ixs(i)(0)) = dmd(cnd(i))(d)(0)
                digs(ixs(i)(1)) = dmd(cnd(i))(d)(1) : i += 1 : Next
            If Not IsSquare(ToSum()) Then Return
            res.Add(ToDif()) : count += 1
            WriteLine("{0,16:n0}{1,4}   ({2:n0})", (DT.Now - st).TotalMilliseconds, count, res.Last())
        Else
            For Each n In dis(lev) : di(lev) = n : Fnpr(lev + 1) : Next
        End If
    End Sub

    ' Recursive closure to generate (n-r) candidates with a given number of digits.
    Sub Fnmr(ByVal list As Lst, ByVal lev As Integer)
        If lev = list.Count Then
            Dif = 0 : Dim i As SByte = 0 : For Each t In tLst(nd2)
                If cnd(i) < 0 Then Dif -= t.coeff * CULng(-cnd(i)) _
                              Else Dif += t.coeff * CULng(cnd(i))
                i += 1 : Next
            If Dif <= 0 OrElse Not IsSquare(Dif) Then Return
            dis = New Lst From {Seq(0, fml(cnd(0)).Count - 1)}
            For Each i In cnd.Skip(1) : dis.Add(Seq(0, dmd(i).Count - 1)) : Next
            If odd Then dis.Add(il)
            di = New Integer(dis.Count - 1) {} : Fnpr(0)
        Else
            For Each n As SByte In list(lev) : cnd(lev) = n : Fnmr(list, lev + 1) : Next
        End If
    End Sub

    Sub init()
        Dim pow As UI = 1
        ' terms of (n-r) expression for number of digits from 2 to maxDigits
        tLst = New List(Of List(Of term))() : For Each r As Integer In Seq(2, MxD)
            Dim terms As List(Of term) = New List(Of term)()
            pow *= 10 : Dim p1 As UI = pow, p2 As UI = 1
            Dim i1 As Integer = 0, i2 As Integer = r - 1
            While i1 < i2 : terms.Add(New term(p1 - p2, i1, i2))
                p1 = p1 / 10 : p2 = p2 * 10 : i1 += 1 : i2 -= 1 : End While
            tLst.Add(terms) : Next
        ' map of first minus last digits for 'n' to pairs giving this value
        fml = New Dictionary(Of Integer, Lst)() From {
            {0, New Lst() From {New Lsb() From {2, 2}, New Lsb() From {8, 8}}},
            {1, New Lst() From {New Lsb() From {6, 5}, New Lsb() From {8, 7}}},
            {4, New Lst() From {New Lsb() From {4, 0}}},
            {6, New Lst() From {New Lsb() From {6, 0}, New Lsb() From {8, 2}}}}
        ' map of other digit differences for 'n' to pairs giving this value
        dmd = New Dictionary(Of Integer, Lst)()
        For i As SByte = 0 To 10 - 1 : Dim j As SByte = 0, d As SByte = i
            While j < 10 : If dmd.ContainsKey(d) Then dmd(d).Add(New Lsb From {i, j}) _
                Else dmd(d) = New Lst From {New Lsb From {i, j}}
                j += 1 : d -= 1 : End While : Next
        dl = Seq(-9, 9)    ' all  differences
        zl = Seq(0, 0)     ' zero difference
        el = Seq(-8, 8, 2) ' even differences
        ol = Seq(-9, 9, 2) ' odd  differences
        il = Seq(0, 9)
        lists = New List(Of Lst)()
        For Each f As SByte In fml.Keys : lists.Add(New Lst From {New Lsb From {f}}) : Next
    End Sub

    Sub Main(ByVal args As String())
        init() : res = New List(Of UI)() : st = DT.Now : count = 0
        WriteLine("{0,5}{1,12}{2,4}{3,14}", "digs", "elapsed(ms)", "R/N", "Rare Numbers")
        nd = 2 : nd2 = 0 : odd = False : While nd <= MxD
            digs = New Integer(nd - 1) {} : If nd = 4 Then
                lists(0).Add(zl) : lists(1).Add(ol) : lists(2).Add(el) : lists(3).Add(ol)
            ElseIf tLst(nd2).Count > lists(0).Count Then
                For Each list As Lst In lists : list.Add(dl) : Next : End If
            ixs = New Lst() : For Each t As term In tLst(nd2) : ixs.Add(New Lsb From {t.a, t.b}) : Next
            For Each list As Lst In lists : cnd = New Integer(list.Count - 1) {} : Fnmr(list, 0) : Next
            WriteLine("  {0,2}  {1,10:n0}", nd, (DT.Now - st).TotalMilliseconds)
            nd += 1 : nd2 += 1 : odd = Not odd : End While
        res.Sort() : WriteLine(vbLf & "The {0} rare numbers with up to {1} digits are:", res.Count, MxD)
        count = 0 : For Each rare In res : count += 1 : WriteLine("{0,2}:{1,27:n0}", count, rare) : Next
        If System.Diagnostics.Debugger.IsAttached Then ReadKey()
    End Sub
End Module


import "/sort" for Sort
import "/fmt" for Fmt

class Term {
    construct new(coeff, ix1, ix2) {
        _coeff = coeff
        _ix1 = ix1
        _ix2 = ix2
    }
    coeff { _coeff }
    ix1 { _ix1 }
    ix2 { _ix2 }
}

var maxDigits = 15

var toInt = Fn.new { |digits, reverse|
    var sum = 0
    if (!reverse) {
        for (i in 0...digits.count) sum = sum*10 + digits[i]
    } else {
        for (i in digits.count-1..0) sum = sum*10 + digits[i]
    }
    return sum
}

var isSquare = Fn.new { |n|
    var root = n.sqrt.floor
    return root*root == n
}

var seq = Fn.new { |from, to, step|
    var res = []
    var i = from
    while (i <= to) {
        res.add(i)
        i = i + step
    }
    return res
}

var start = System.clock
var pow = 1
System.print("Aggregate timings to process all numbers up to:")

// terms of (n-r) expression for number of digits from 2 to maxDigits
var allTerms = List.filled(maxDigits-1, null)
for (r in 2..maxDigits) {
    var terms = []
    pow = pow * 10
    var pow1 = pow
    var pow2 = 1
    var i1 = 0
    var i2 = r - 1
    while (i1 < i2) {
        terms.add(Term.new(pow1-pow2, i1, i2))
        pow1 = (pow1/10).floor
        pow2 = pow2 * 10
        i1 = i1 + 1
        i2 = i2 - 1
    }
    allTerms[r-2] = terms
}

//  map of first minus last digits for 'n' to pairs giving this value
var fml = {
    0: [[2, 2], [8, 8]],
    1: [[6, 5], [8, 7]],
    4: [[4, 0]],
    6: [[6, 0], [8, 2]]
}

// map of other digit differences for 'n' to pairs giving this value
var dmd = {}
for (i in 0...100) {
    var a = [(i/10).floor, i%10]
    var d = a[0] - a[1]
    if (dmd[d]) {
        dmd[d].add(a)
    } else {
        dmd[d] = [a]
    }
}
var fl = [0, 1, 4, 6]
var dl = seq.call(-9, 9, 1)  // all differences
var zl = [0]                 // zero differences only
var el = seq.call(-8, 8, 2)  // even differences only
var ol = seq.call(-9, 9, 2)  // odd differences only
var il = seq.call(0, 9, 1)
var rares = []
var lists = List.filled(4, null)
for (i in 0..3) lists[i] = [[fl[i]]]
var digits = []
var count = 0

// Recursive closure to generate (n+r) candidates from (n-r) candidates
// and hence find Rare numbers with a given number of digits.
var fnpr
fnpr = Fn.new { |cand, di, dis, indices, nmr, nd, level|
    if (level == dis.count) {
        digits[indices[0][0]] = fml[cand[0]][di[0]][0]
        digits[indices[0][1]] = fml[cand[0]][di[0]][1]
        var le = di.count
        if (nd%2 == 1) {
            le = le - 1
            digits[(nd/2).floor] = di[le]
        }
        var i = 0
        for (d in di[1...le]) {
            digits[indices[i+1][0]] = dmd[cand[i+1]][d][0]
            digits[indices[i+1][1]] = dmd[cand[i+1]][d][1]
            i = i + 1
        }
        var r = toInt.call(digits, true)
        var npr = nmr + 2*r
        if (!isSquare.call(npr)) return
        count = count + 1
        Fmt.write("     R/N $2d:", count)
        var ms = ((System.clock - start)*1000).round
        Fmt.write("  $,7d ms", ms)
        var n = toInt.call(digits, false)
        Fmt.print("  ($,d)", n)
        rares.add(n)
    } else {
        for (num in dis[level]) {
            di[level] = num
            fnpr.call(cand, di, dis, indices, nmr, nd, level+1)
        }
    }
}

// Recursive closure to generate (n-r) candidates with a given number of digits.
var fnmr
fnmr = Fn.new { |cand, list, indices, nd, level|
    if (level == list.count) {
        var nmr = 0
        var nmr2 = 0
        var i = 0
        for (t in allTerms[nd-2]) {
            if (cand[i] >= 0) {
                nmr = nmr + t.coeff*cand[i]
            } else {
                nmr2 = nmr2 - t.coeff*cand[i]
                if (nmr >= nmr2) {
                    nmr = nmr - nmr2
                    nmr2 = 0
                } else {
                    nmr2 = nmr2 - nmr
                    nmr = 0
                }
            }
            i = i + 1
        }
        if (nmr2 >= nmr) return
        nmr = nmr - nmr2
        if (!isSquare.call(nmr)) return
        var dis = []
        dis.add(seq.call(0, fml[cand[0]].count-1, 1))
        for (i in 1...cand.count) {
            dis.add(seq.call(0, dmd[cand[i]].count-1, 1))
        }
        if (nd%2 == 1) dis.add(il)
        var di = List.filled(dis.count, 0)
        fnpr.call(cand, di, dis, indices, nmr, nd, 0)
    } else {
        for (num in list[level]) {
            cand[level] = num
            fnmr.call(cand, list, indices, nd, level+1)
        }
    }
}

for (nd in 2..maxDigits) {
    digits = List.filled(nd, 0)
    if (nd == 4) {
        lists[0].add(zl)
        lists[1].add(ol)
        lists[2].add(el)
        lists[3].add(ol)
    } else if(allTerms[nd-2].count > lists[0].count) {
        for (i in 0..3) lists[i].add(dl)
    }
    var indices = []
    for (t in allTerms[nd-2]) indices.add([t.ix1, t.ix2])
    for (list in lists) {
        var cand = List.filled(list.count, 0)
        fnmr.call(cand, list, indices, nd, 0)
    }
    var ms = ((System.clock - start)*1000).round
    Fmt.print("  $2s digits:  $,7d ms", nd, ms)
}

Sort.quick(rares)
Fmt.print("\nThe rare numbers with up to $d digits are:\n", maxDigits)
var i = 0
for (rare in rares) {
    Fmt.print("  $2d:  $,21d", i+1, rare)
    i = i + 1
}


.equ STDOUT, 1
.equ SVC_WRITE, 64
.equ SVC_GETRANDOM, 278
.equ SVC_EXIT, 93

.text
.global _start

_start:
	stp x29, x30, [sp, -32]! // allocate buffer space at [sp]
	mov x29, sp
	mov x0, sp
	mov x1, #4
	bl _getrandom // getrandom(&tmp, 4);
	ldr w0, [sp]
	bl print_uint64 // print_uint64(tmp);
	ldp x29, x30, [sp], 32
	mov x0, #0
	b _exit // exit(0);

// void print_uint64(uint64_t x) - print an unsigned integer in base 10.
print_uint64:
	// x0 = remaining number to convert
	// x1 = pointer to most significant digit
	// x2 = 10
	// x3 = x0 / 10
	// x4 = x0 % 10
	// compute x0 divmod 10, store a digit, repeat if x0 > 0
	ldr x1, =strbuf_end
	mov x2, #10
1:	udiv x3, x0, x2
	msub x4, x3, x2, x0
	add x4, x4, #48
	mov x0, x3
	strb w4, [x1, #-1]!
	cbnz x0, 1b
	// compute the number of digits to print, then call write()
	ldr x3, =strbuf_end_newline
	sub x2, x3, x1
	mov x0, #STDOUT
	b _write

.data
strbuf:
	.space 31
strbuf_end:
	.ascii "\n"
strbuf_end_newline:
.align 4

.text
//////////////// system call wrappers
// ssize_t _write(int fd, void *buf, size_t count)
_write:
	mov x8, #SVC_WRITE
	svc #0
	ret

// ssize_t getrandom(void *buf, size_t buflen, unsigned int flags=0)
_getrandom:
	mov x2, #0
	mov x8, #SVC_GETRANDOM
	svc #0
	ret

// void _exit(int retval)
_exit:
	mov x8, #SVC_EXIT
	svc #0


with Ada.Streams.Stream_IO;
with Ada.Text_IO;
procedure Random is
   Number : Integer;
   Random_File : Ada.Streams.Stream_IO.File_Type;
begin
   Ada.Streams.Stream_IO.Open (File => Random_File,
                               Mode => Ada.Streams.Stream_IO.In_File,
                               Name => "/dev/random");
   Integer'Read (Ada.Streams.Stream_IO.Stream (Random_File), Number);
   Ada.Streams.Stream_IO.Close (Random_File);
   Ada.Text_IO.Put_Line ("Number:" & Integer'Image (Number));
end Random;


/* ARM assembly Raspberry PI  */
/*  program urandom.s   */

/* Constantes    */
.equ STDOUT, 1                           @ Linux output console
.equ EXIT,   1                           @ Linux syscall
.equ READ,   3
.equ WRITE,  4
.equ OPEN,   5
.equ CLOSE,  6

.equ O_RDONLY, 0                         @ open for reading only

.equ BUFFERSIZE,          4              @ random number 32 bits

/* Initialized data */
.data
szFileName:              .asciz "/dev/urandom"      @ see linux doc
szCarriageReturn:        .asciz "\n"
/* datas error display */
szMessErreur:        .asciz "Error detected.\n"
szMessErr:           .ascii "Error code hexa : "
sHexa:               .space 9,' '
                     .ascii "  decimal :  "
sDeci:               .space 15,' '
                     .asciz "\n"
/* datas message display */
szMessResult:        .ascii "Random number :"
sValue:              .space 12,' '
                     .asciz "\n"
/* UnInitialized data */
.bss
sBuffer:             .skip BUFFERSIZE             @ buffer result

/*  code section */
.text
.global main
main:
    ldr r0,iAdrszFileName               @ File name
    mov r1,#O_RDONLY                    @  flags
    mov r2,#0                           @ mode
    mov r7,#OPEN                        @ open file
    svc #0
    cmp r0,#0                           @ error ?
    ble error
    mov r8,r0                           @ save FD
    mov r4,#0                           @ loop counter
1:
    mov r0,r8                           @ File Descriptor
    ldr r1,iAdrsBuffer                  @ buffer address
    mov r2,#BUFFERSIZE                  @ buffer size
    mov r7,#READ                        @ call system read file
    svc 0
    cmp r0,#0                           @ read error ?
    ble error
    ldr r1,iAdrsBuffer                  @ buffer address
    ldr r0,[r1]                         @ display buffer value
    ldr r1,iAdrsValue
    bl conversion10
    ldr r0,iAdrszMessResult
    bl affichageMess
    add r4,#1                           @ increment counter
    cmp r4,#10                          @ maxi ?
    blt 1b                              @ no -> loop

end:
    mov r0,r8
    mov r7, #CLOSE                      @ call system close file
    svc #0
    cmp r0,#0
    blt error
    mov r0,#0                           @ return code
    b 100f
error:
    ldr r1,iAdrszMessErreur             @ error message
    bl   displayError
    mov r0,#1                           @ return error code
100:                                    @ standard end of the program
    mov r7, #EXIT                       @ request to exit program
    svc 0                               @ perform system call
iAdrsBuffer:               .int sBuffer
iAdrsValue:                .int sValue
iAdrszMessResult:          .int szMessResult
iAdrszFileName:            .int szFileName
iAdrszMessErreur:          .int szMessErreur
iAdrszCarriageReturn:      .int szCarriageReturn

/******************************************************************/
/*     display text with size calculation                         */
/******************************************************************/
/* r0 contains the address of the message */
affichageMess:
    push {r0,r1,r2,r7,lr}                       @ save  registers
    mov r2,#0                                   @ counter length */
1:                                              @ loop length calculation
    ldrb r1,[r0,r2]                             @ read octet start position + index
    cmp r1,#0                                   @ if 0 its over
    addne r2,r2,#1                              @ else add 1 in the length
    bne 1b                                      @ and loop
                                                @ so here r2 contains the length of the message
    mov r1,r0                                   @ address message in r1
    mov r0,#STDOUT                              @ code to write to the standard output Linux
    mov r7, #WRITE                              @ code call system "write"
    svc #0                                      @ call system
    pop {r0,r1,r2,r7,lr}                        @ restaur registers
    bx lr                                       @ return
/***************************************************/
/*   display error message                         */
/***************************************************/
/* r0 contains error code  r1 : message address */
displayError:
    push {r0-r2,lr}                         @ save registers
    mov r2,r0                               @ save error code
    mov r0,r1
    bl affichageMess
    mov r0,r2                               @ error code
    ldr r1,iAdrsHexa
    bl conversion16                         @ conversion hexa
    mov r0,r2                               @ error code
    ldr r1,iAdrsDeci                        @ result address
    bl conversion10S                        @ conversion decimale
    ldr r0,iAdrszMessErr                    @ display error message
    bl affichageMess
100:
    pop {r0-r2,lr}                          @ restaur registers
    bx lr                                   @ return
iAdrszMessErr:                 .int szMessErr
iAdrsHexa:                     .int sHexa
iAdrsDeci:                     .int sDeci
/******************************************************************/
/*     Converting a register to hexadecimal                      */
/******************************************************************/
/* r0 contains value and r1 address area   */
conversion16:
    push {r1-r4,lr}                          @ save registers
    mov r2,#28                               @ start bit position
    mov r4,#0xF0000000                       @ mask
    mov r3,r0                                @ save entry value
1:                                           @ start loop
    and r0,r3,r4                             @ value register and mask
    lsr r0,r2                                @ move right
    cmp r0,#10                               @ compare value
    addlt r0,#48                             @ <10  ->digit
    addge r0,#55                             @ >10  ->letter A-F
    strb r0,[r1],#1                          @ store digit on area and + 1 in area address
    lsr r4,#4                                @ shift mask 4 positions
    subs r2,#4                               @ counter bits - 4 <= zero  ?
    bge 1b                                   @ no -> loop

100:
    pop {r1-r4,lr}                                     @ restaur registers
    bx lr
/***************************************************/
/*  Converting a register to a signed decimal      */
/***************************************************/
/* r0 contains value and r1 area address    */
conversion10S:
    push {r0-r4,lr}       @ save registers
    mov r2,r1             @ debut zone stockage
    mov r3,#'+'           @ par defaut le signe est +
    cmp r0,#0             @ negative number ?
    movlt r3,#'-'         @ yes
    mvnlt r0,r0           @ number inversion
    addlt r0,#1
    mov r4,#10            @ length area
1:                        @ start loop
    bl divisionpar10U
    add r1,#48            @ digit
    strb r1,[r2,r4]       @ store digit on area
    sub r4,r4,#1          @ previous position
    cmp r0,#0             @ stop if quotient = 0
    bne 1b

    strb r3,[r2,r4]       @ store signe
    subs r4,r4,#1         @ previous position
    blt  100f             @ if r4 < 0 -> end

    mov r1,#' '           @ space
2:
    strb r1,[r2,r4]       @store byte space
    subs r4,r4,#1         @ previous position
    bge 2b                @ loop if r4 > 0
100:
    pop {r0-r4,lr}        @ restaur registers
    bx lr
/***************************************************/
/*   division par 10   unsigned                    */
/***************************************************/
/* r0 dividende   */
/* r0 quotient    */
/* r1 remainder   */
divisionpar10U:
    push {r2,r3,r4, lr}
    mov r4,r0                                          @ save value
    //mov r3,#0xCCCD                                   @ r3 <- magic_number lower  raspberry 3
    //movt r3,#0xCCCC                                  @ r3 <- magic_number higter raspberry 3
    ldr r3,iMagicNumber                                @ r3 <- magic_number    raspberry 1 2
    umull r1, r2, r3, r0                               @ r1<- Lower32Bits(r1*r0) r2<- Upper32Bits(r1*r0)
    mov r0, r2, LSR #3                                 @ r2 <- r2 >> shift 3
    add r2,r0,r0, lsl #2                               @ r2 <- r0 * 5
    sub r1,r4,r2, lsl #1                               @ r1 <- r4 - (r2 * 2)  = r4 - (r0 * 10)
    pop {r2,r3,r4,lr}
    bx lr                                              @ leave function
iMagicNumber:  	.int 0xCCCCCCCD


      SYS "SystemFunction036", ^random%, 4
      PRINT ~random%


#include <stdio.h>
#include <stdlib.h>

#define RANDOM_PATH "/dev/urandom"

int main(void)
{
        unsigned char buf[4];
        unsigned long v;
        FILE *fin;

        if ((fin = fopen(RANDOM_PATH, "r")) == NULL) {
                fprintf(stderr, "%s: unable to open file\n", RANDOM_PATH);
                return EXIT_FAILURE;
        }
        if (fread(buf, 1, sizeof buf, fin) != sizeof buf) {
                fprintf(stderr, "%s: not enough bytes (expected %u)\n",
                        RANDOM_PATH, (unsigned) sizeof buf);
                return EXIT_FAILURE;
        }
        fclose(fin);
        v = buf[0] | buf[1] << 8UL | buf[2] << 16UL | buf[3] << 24UL;
        printf("%lu\n", v);
        return 0;
}


#include <iostream>
#include <random>

int main()
{
    std::random_device rd;
    std::uniform_int_distribution<long> dist; // long is guaranteed to be 32 bits

    std::cout << "Random Number: " << dist(rd) << std::endl;
}


using System;
using System.Security.Cryptography;

private static int GetRandomInt()
{
  int result = 0;
  var rng = new RNGCryptoServiceProvider();
  var buffer = new byte[4];

  rng.GetBytes(buffer);
  result = BitConverter.ToInt32(buffer, 0);

  return result;
}


(defun random-int32 ()
  (with-open-file (s "/dev/random" :element-type '(unsigned-byte 32))
    (read-byte s)))


import std.stdio;
import std.random;

void main()
{
  Mt19937 gen;
  gen.seed(unpredictableSeed);
  auto n = gen.front;
  writeln(n);
}


program Random_number_generator;

{$APPTYPE CONSOLE}

uses
  System.SysUtils,
  Winapi.WinCrypt;

var
  hCryptProv: NativeUInt;
  i: Byte;
  UserName: PChar;

function Random: UInt64;
var
  pbData: array[0..7] of byte;
  i: integer;
begin
  if not CryptGenRandom(hCryptProv, 8, @pbData[0]) then
    exit(0);
  Result := 0;
  for i := 0 to 7 do
    Result := Result + (pbData[i] shl (8 * i));
end;

procedure Randomize;
begin
  CryptAcquireContext(hCryptProv, UserName, nil, PROV_RSA_FULL, 0);
end;

begin
  Randomize;
  for i := 0 to 9 do
    Writeln(Random);
  Readln;
end.


(random-seed "simon")
(random (expt 2 32)) → 2275215386
(random-seed "simon")
(random (expt 2 32)) → 2275215386 ;; the same

(random-seed (current-time-milliseconds ))
(random (expt 2 32)) → 4061857345
(random-seed (current-time-milliseconds ))
(random (expt 2 32)) → 1322611152


USE: random
[ random-32 ] with-system-random .


variable rnd

: randoms ( n -- )
  s" /dev/random" r/o open-file throw
  swap 0 do
    dup rnd 1 cells rot read-file throw drop
    rnd @ .
  loop
  close-file throw ;


!-----------------------------------------------------------------------
! Test Linux urandom in Fortran
!-----------------------------------------------------------------------
program    urandom_test
  use iso_c_binding, only : c_long
  implicit none

  character(len=*), parameter :: RANDOM_PATH = "/dev/urandom"
  integer :: funit, ios
  integer(c_long) :: buf

  open(newunit=funit, file=RANDOM_PATH, access="stream", form="UNFORMATTED", &
       iostat=ios, status="old", action="read")
  if ( ios /= 0 ) stop "Error opening file: "//RANDOM_PATH

  read(funit) buf

  close(funit)

  write(*,'(A,I64)') "Integer:     ", buf
  write(*,'(A,B64)') "Binary:      ", buf
  write(*,'(A,Z64)') "Hexadecimal: ", buf

end program urandom_test


' FB 1.05.0 Win64

Randomize , 5

'generate 10 cryptographic random integers in the range 1 To 100
For i As Integer = 1 To 10
  Print Int(Rnd * 100) + 1
Next

Sleep


package main

import (
    "crypto/rand"
    "encoding/binary"
    "fmt"
    "io"
    "os"
)

func main() {
    testRandom("crypto/rand", rand.Reader)
    testRandom("dev/random", newDevRandom())
}

func newDevRandom() (f *os.File) {
    var err error
    if f, err = os.Open("/dev/random"); err != nil {
        panic(err)
    }
    return
}

func testRandom(label string, src io.Reader) {
    fmt.Printf("%s:\n", label)
    var r int32
    for i := 0; i < 10; i++ {
        if err := binary.Read(src, binary.LittleEndian, &r); err != nil {
            panic(err)
        }
        fmt.Print(r, " ")
    }
    fmt.Println()
}


def rng = new java.security.SecureRandom()


#!/usr/bin/env runhaskell

import System.Entropy
import Data.Binary.Get
import qualified Data.ByteString.Lazy as B

main = do
  bytes <- getEntropy 4
  print (runGet getWord32be $ B.fromChunks [bytes])


procedure main(A)
    n := integer(A[1])|5
    every !n do write(rand(4))
end

procedure rand(n)
    f := open("/dev/urandom") | stop("Cannot get to urandom!")
    x := 0
    every !n do x := x*256 + ord(reads(f,1))
    close(f)
    return x
end


import java.security.SecureRandom;

public class RandomExample {
  public static void main(String[] args) {
    SecureRandom rng = new SecureRandom();

    /* Prints a random signed 32-bit integer. */
    System.out.println(rng.nextInt());
  }
}


od -t x -An /dev/urandom | tr -d " " | fold -w 8 | jq -R -f uniform.jq


const rdev = "/dev/random"
rstream = try
    open(rdev, "r")
catch
    false
end

if isa(rstream, IOStream)
    b = readbytes(rstream, 4)
    close(rstream)
    i = reinterpret(Int32, b)[1]
    println("A hardware random number is:  ", i)
else
    println("The hardware random number stream, ", rdev, ", was unavailable.")
end


// version 1.1.2

import java.security.SecureRandom

fun main(args: Array<String>) {
    val rng = SecureRandom()
    val rn1 = rng.nextInt()
    val rn2 = rng.nextInt()
    val newSeed = rn1.toLong() * rn2
    rng.setSeed(newSeed)    // reseed using the previous 2 random numbers
    println(rng.nextInt())  // get random 32-bit number and print it
}


Module checkit {
      Declare random1 lib "advapi32.SystemFunction036" {long lpbuffer, long length}
      Buffer Clear Alfa as long*2
      Print Eval(Alfa,0)
      Print Eval(Alfa,1)
      call void random1(alfa(0), 8)
      Print Eval(Alfa,0)
      Print Eval(Alfa,1)
}
checkit


:- module random_number_device.
:- interface.

:- import_module io.
:- pred main(io::di, io::uo) is det.

:- implementation.
:- import_module maybe, random, random.system_rng, require.

main(!IO) :-
   open_system_rng(MaybeRNG, !IO),
   (
      MaybeRNG = ok(RNG),
      random.generate_uint32(RNG, U32, !IO),
      io.print_line(U32, !IO),
      close_system_rng(RNG, !IO)
   ;
      MaybeRNG = error(ErrorMsg),
      io.stderr_stream(Stderr, !IO),
      io.print_line(Stderr, ErrorMsg, !IO),
      io.set_exit_status(1, !IO)
   ).


/* NetRexx */
options replace format comments java crossref savelog symbols binary

import java.math.BigInteger

randomDevNameFile = File
randomDevNameList = ['/dev/random', '/dev/urandom'] -- list of random data source devices
randomDevIStream = InputStream
do
  loop dn = 0 to randomDevNameList.length - 1
    randomDevNameFile = File(randomDevNameList[dn])
    if randomDevNameFile.exists() then leave dn -- We're done! Use this device
    randomDevNameFile = null -- ensure we don't use a non-existant device
    end dn
  if randomDevNameFile == null then signal FileNotFoundException('Cannot locate a random data source device on this system')

  -- read 8 bytes from the random data source device, convert it into a BigInteger then display the result
  randomBytes = byte[8]
  randomDevIStream = BufferedInputStream(FileInputStream(randomDevNameFile))
  randomDevIStream.read(randomBytes, 0, randomBytes.length)
  randomDevIStream.close()
  randomNum = BigInteger(randomBytes)
  say Rexx(randomNum.longValue()).right(24) '0x'Rexx(Long.toHexString(randomNum.longValue())).right(16, 0)
catch ex = IOException
  ex.printStackTrace()
end
return

/*
To run the program in a loop 10 times from a bash shell prompt use:
for ((i=0; i<10; ++i)); do java <program_name>; done # Shell loop to run the command 10 times
*/


var f = open("/dev/urandom")
var r: int32
discard f.readBuffer(addr r, 4)
close(f)
echo r


let input_rand_int ic =
  let i1 = int_of_char (input_char ic)
  and i2 = int_of_char (input_char ic)
  and i3 = int_of_char (input_char ic)
  and i4 = int_of_char (input_char ic) in
  i1 lor (i2 lsl 8) lor (i3 lsl 16) lor (i4 lsl 24)

let () =
  let ic = open_in "/dev/urandom" in
  let ri31 = input_rand_int ic in
  close_in ic;
  Printf.printf "%d\n" ri31;
;;


rnd(n=10)=extern("cat /dev/urandom|tr -dc '[:digit:]'|fold -w"n"|head -1")


program RandomNumberDevice;
var
  byteFile: file of byte;
  randomByte: byte;
begin
  assign(byteFile, '/dev/urandom');
  reset (byteFile);
  read  (byteFile, randomByte);
  close (byteFile);
  writeln('The random byte is: ', randomByte);
end.


use Crypt::Random::Seed;
my $source = Crypt::Random::Seed->new( NonBlocking => 1 ); # Allow non-blocking sources like /dev/urandom
print "$_\n" for $source->random_values(10);               # A method returning an array of 32-bit values


integer res  -- 1=failure, 0=success
atom rint = 0   -- random 32-bit int

#ilASM{
        mov eax,1
        cpuid
        bt ecx,30
        mov edi,1 -- exit code: failure
        jnc :exit

        -- rdrand sets CF=0 if no random number
        -- was available. Intel documentation
        -- recommends 10 retries in a tight loop
        mov ecx,11
    ::loop1
        sub ecx, 1
        jz :exit -- exit code is set already
        rdrand eax
        -- (the above generates exception #C000001D if not supported)
--      rdtsc
        jnc :loop1

        lea edi,[rint]
        call :%pStoreMint
        xor edi,edi

    ::exit
        mov [res],edi
        xor ebx,ebx     -- important!
      }

?{res,rint}

if res=0 then   -- (success)

    --
    -- To convert a signed 32-bit int to an unsigned one:
    --
    --  method 1
--  atom urint1 = rint
--  if urint1<0 then urint1+=#100000000 end if
    atom urint1 = rint+iff(rint<0?#100000000:0)

    --  method 2
    atom pMem = allocate(4)
    poke4(pMem,rint)
    atom urint2 = peek4u(pMem)
    free(pMem)

    --  method 3
    atom urint3 = bytes_to_int(int_to_bytes(rint,4),signed:=false)

    ?{urint1,urint2,urint3}

end if


function Get-RandomInteger
{
    Param
    (
        [Parameter(Mandatory=$false,
                   ValueFromPipeline=$true,
                   ValueFromPipelineByPropertyName=$true,
                   Position=0)]
        [ValidateScript({$_ -ge 4})]
        [int[]]
        $InputObject = 64
    )

    Begin
    {
        $rng = New-Object -TypeName System.Security.Cryptography.RNGCryptoServiceProvider
    }
    Process
    {
        foreach($count in $InputObject)
        {
            $bytes = New-Object -TypeName Byte[] -Argument $count
            $rng.GetBytes($bytes)
            [System.BitConverter]::ToInt32($bytes,0)
        }
    }
    End
    {
        Remove-Variable -Name rng -Scope Local
    }
}


If OpenCryptRandom()
  MyRandom = CryptRandom(#MAXLONG)
  CloseCryptRandom()
EndIf


import random
rand = random.SystemRandom()
rand.randint(1,10)


#lang racket
;; Assuming a device to provide random bits:
(call-with-input-file* "/dev/random"
  (λ(i) (integer-bytes->integer (read-bytes 4 i) #f)))


use experimental :pack;
my $UR = open("/dev/urandom", :bin) orelse .die;
my @random-spigot = $UR.read(1024).unpack("L*") ... *;

.say for @random-spigot[^10];


/*REXX program  generates and displays a random  32-bit  number  using the  RANDOM  BIF.*/
numeric digits 10                                /*ensure REXX has enough decimal digits*/
_=2**16                                          /*a handy─dandy constant to have around*/
r#= random(0, _-1) * _    +    random(0, _-1)    /*generate an unsigned 32-bit random #.*/
say r#                                           /*stick a fork in it,  we're all done. */


nr = 10
for i = 1 to nr
    see random(i) + nl
next


require 'securerandom'
SecureRandom.random_number(1 << 32)

#or specifying SecureRandom as the desired RNG:
p (1..10).to_a.sample(3, random: SecureRandom) # =>[1, 4, 5]


extern crate rand;

use rand::{OsRng, Rng};

fn main() {
    // because `OsRng` opens files, it may fail
    let mut rng = match OsRng::new() {
        Ok(v) => v,
        Err(e) => panic!("Failed to obtain OS RNG: {}", e)
    };

    let rand_num: u32 = rng.gen();
    println!("{}", rand_num);
}


import java.security.SecureRandom

object RandomExample extends App {
  new SecureRandom {
    val newSeed: Long = this.nextInt().toLong * this.nextInt()
    this.setSeed(newSeed) // reseed using the previous 2 random numbers
    println(this.nextInt()) // get random 32-bit number and print it
  }
}


func urandom() {
    const device = %f'/dev/urandom';

    device.open('<:raw', \var fh, \var err) ->
        || die "Can't open `#{device}': #{err}";

    fh.sysread(\var noise, 4);
    'L'.unpack(noise);
}

say urandom();    # sample: 3517432564


fun sysRand32 () =
  let
    val strm = BinIO.openIn "/dev/urandom"
  in
    PackWord32Big.subVec (BinIO.inputN (strm, 4), 0) before BinIO.closeIn strm
  end

val () = print (LargeWord.fmt StringCvt.DEC (sysRand32 ()) ^ "\n")


package require Tcl 8.5

# Allow override of device name
proc systemRandomInteger {{device "/dev/random"}} {
    set f [open $device "rb"]
    binary scan [read $f 4] "I" x
    close $f
    return $x
}


let keycode=0
let number=1
print 1 "Press any key to generate a random number from 1 to 10.
while keycode=0
let number=number+1
let keycode=key()
rem The maximum number is the number in the "if number=" line with 1 taken away. For example, if this number was 11, the maximum number would be 10. *
if number=11
let number=1
endif
wend
print 1 number
end


import "io" for File

File.open("/dev/urandom") { |file|
    var b = file.readBytes(4).bytes.toList
    var n = b[0] | b[1] << 8 | b[2] << 16 | b[3] << 24
    System.print(n)
}


const RANDOM_PATH="/dev/urandom";

fin,buf:=File(RANDOM_PATH,"r"), fin.read(4);
fin.close();  // GC would also close the file
println(buf.toBigEndian(0,4));  // 4 bytes @ offset 0


F rangeexpand(txt)
   [Int] lst
   L(r) txt.split(‘,’)
      I ‘-’ C r[1..]
         V rr = r[1..].split(‘-’, 2)
         lst [+]= Int(r[0]‘’rr[0]) .. Int(rr[1])
      E
         lst.append(Int(r))
   R lst

print(rangeexpand(‘-6,-3--1,3-5,7-11,14,15,17-20’))


\ Given a low and high limit, create an array containing the numbers in the
\ range, inclusive:
: n:gen-range \ low hi -- a
  \ make sure they are in order:
  2dup n:> if swap then
  \ fill the array with the values:
  [] ' a:push
  2swap loop ;

\ Take a string, either "X" or "X-Y", and correctly return either a number (if
\ "X") or an array of numbers (if "X-Y"):
: n:expand-one \ s -- n | a[n,..m]
  \ First see if we can parse a number.  This works in the "X" case:
  dup >n null? if
    \ Failed >n because it's (possibly) "X-Y"
    drop
    \ not a valid number, might be a range
    \ We'll use a capturing regex to handle the different cases correctly:
    /(-?[0-9]+)-(-?[0-9]+)/ tuck r:match

    \ If the regex matches three (the whole string, plus the two captured
    \ expressions) then it's a valid "X-Y":
    3 n:= if
      1 r:@ >n swap 2 r:@ >n nip
      \ generate the range:
      n:gen-range
    else
      \ The regex didn't match, so we got garbage.  Therefore, return a 'null':
      drop null
    then
  else
    \ It was a "X", just drop the original string:
    nip
  then
  ;

\ Take an array (possibly) containing other arrays, and flatten any contained
\ arrays so the result is a simple array:
: a:flatten \ a1 -- a2
  [] >r
  (
    nip
    array?  if
      a:flatten r> swap a:+ >r
    else
      r> swap a:push >r
    then
  ) a:each drop r> ;

\ Take a comma-delimited string of ranges, and expand it into an array of
\ numbers:
: n:range-expand \ str -- a
  "," s:/
  ' n:expand-one a:map
  a:flatten ;

\ Process a list:
"-6,-3--1,3-5,7-11,14,15,17-20"
n:range-expand
\ print the expanded list:
. cr bye


BYTE FUNC Find(CHAR ARRAY text CHAR c BYTE start)
  BYTE i

  i=start
  WHILE i<=text(0)
  DO
    IF text(i)=c THEN
      RETURN (i)
    FI
    i==+1
  OD
RETURN (0)

PROC ProcessItem(CHAR ARRAY text INT ARRAY res INT POINTER size)
  BYTE pos
  INT start,end,i
  CHAR ARRAY tmp(200)

  pos=Find(text,'-,2)
  IF pos=0 THEN
    res(size^)=ValI(text)
    size^==+1
  ELSE
    SCopyS(tmp,text,1,pos-1)
    start=ValI(tmp)
    SCopyS(tmp,text,pos+1,text(0))
    end=ValI(tmp)
    FOR i=start TO end
    DO
      res(size^)=i
      size^==+1
    OD
  FI
RETURN

PROC RangeExtraction(CHAR ARRAY text INT ARRAY res INT POINTER size)
  BYTE i,pos
  CHAR ARRAY tmp(200)

  i=1 size^=0
  WHILE i<=text(0)
  DO
    pos=Find(text,',,i)
    IF pos=0 THEN
      SCopyS(tmp,text,i,text(0))
      i=text(0)+1
    ELSE
      SCopyS(tmp,text,i,pos-1)
      i=pos+1
    FI
    ProcessItem(tmp,res,size)
  OD
RETURN

PROC PrintArray(INT ARRAY a INT size)
  INT i

  Put('[)
  FOR i=0 TO size-1
  DO
    IF i>0 THEN Put(' ) FI
    PrintI(a(i))
  OD
  Put(']) PutE()
RETURN

PROC Main()
  INT ARRAY res(100)
  INT size
  RangeExtraction("-6,-3--1,3-5,7-11,14,15,17-20",res,@size)
  PrintArray(res,size)
RETURN


with Ada.Text_IO; use Ada.Text_IO;
procedure Test_Range_Expansion is
   type Sequence is array (Positive range <>) of Integer;
   function Expand (Text : String) return Sequence is
      To    : Integer := Text'First;
      Count : Natural := 0;
      Low   : Integer;
      function Get return Integer is
         From : Integer := To;
      begin
         if Text (To) = '-' then
            To := To + 1;
         end if;
         while To <= Text'Last loop
            case Text (To) is
               when ',' | '-' => exit;
               when others => To := To + 1;
            end case;
         end loop;
         return Integer'Value (Text (From..To - 1));
      end Get;
   begin
      while To <= Text'Last loop -- Counting items of the list
         Low := Get;
         if To > Text'Last or else Text (To) = ',' then
            Count := Count + 1;
         else
            To := To + 1;
            Count := Count + Get - Low + 1;
         end if;
         To := To + 1;
      end loop;
      return Result : Sequence (1..Count) do
         Count := 0;
         To := Text'First;
         while To <= Text'Last loop -- Filling the list
            Low := Get;
            if To > Text'Last or else Text (To) = ',' then
               Count := Count + 1;
               Result (Count) := Low;
            else
               To := To + 1;
               for Item in Low..Get loop
                  Count := Count + 1;
                  Result (Count) := Item;
               end loop;
            end if;
            To := To + 1;
         end loop;
      end return;
   end Expand;
   procedure Put (S : Sequence) is
      First : Boolean := True;
   begin
      for I in S'Range loop
         if First then
            First := False;
         else
            Put (',');
         end if;
         Put (Integer'Image (S (I)));
      end loop;
   end Put;
begin
   Put (Expand ("-6,-3--1,3-5,7-11,14,15,17-20"));
end Test_Range_Expansion;


MODE YIELDINT = PROC(INT)VOID;

MODE RANGE = STRUCT(INT lwb, upb);
MODE RANGEINT = UNION(RANGE, INT);

OP SIZEOF = ([]RANGEINT list)INT: (
# determine the length of the output array #
  INT upb := LWB list - 1;
  FOR key FROM LWB list TO UPB list DO
    CASE list[key] IN
      (RANGE value): upb +:= upb OF value - lwb OF value + 1,
      (INT): upb +:= 1
    ESAC
  OD;
  upb
);

PROC gen range expand = ([]RANGEINT list, YIELDINT yield)VOID:
  FOR key FROM LWB list TO UPB list DO
    CASE list[key] IN
      (RANGE range): FOR value FROM lwb OF range TO upb OF range DO yield(value) OD,
      (INT int): yield(int)
    ESAC
  OD;

PROC range expand = ([]RANGEINT list)[]INT: (
  [LWB list: LWB list + SIZEOF list - 1]INT out;
  INT upb := LWB out - 1;
# FOR INT value IN # gen range expand(list, # ) DO #
##   (INT value)VOID:
    out[upb +:= 1] := value
# OD #);
  out
);

#
test:(
  []RANGEINT list = (-6, RANGE(-3, -1), RANGE(3, 5),  RANGE(7, 11), 14, 15, RANGE(17, 20));
  print((range expand(list), new line))
)
#

# converts string containing a comma-separated list of ranges and values to a []RANGEINT #
OP TORANGE = ( STRING s )[]RANGEINT:
BEGIN

    # counts the number of elements - one more than the number of commas #
    # and so assumes there is always at least one element                #
    PROC count elements = INT:
    BEGIN

        INT    elements := 1;

        FOR pos FROM LWB s TO UPB s
        DO
            IF s[ pos ] = ","
            THEN
                elements +:= 1
            FI
        OD;

    # RESULT #
        elements
    END; # count elements #

    REF[]RANGEINT result = HEAP [ 1 : count elements ]RANGEINT;

    # does the actual parsing - assumes the string is syntatically valid and doesn't check for errors #
    # - in particular, a string with no elements will cause problems, as will space characters in the string #
    PROC parse range string = []RANGEINT:
    BEGIN

        INT  element := 0;
        INT  str pos := 1;

        PROC next       = VOID: str pos +:= 1;
        PROC curr char  = CHAR: IF str pos > UPB s THEN "?" ELSE s[ str pos ] FI;
        PROC have minus = BOOL: curr char = "-";
        PROC have digit = BOOL: curr char >= "0" AND curr char <= "9";

        # parses a number out of the string #
        # the number must be a sequence of digits with an optional leading minus sign #
        PROC get number = INT:
        BEGIN

            INT number := 0;

            INT sign multiplier = IF have minus
                                  THEN
                                      # negaive number #
                                      # skip the sign #
                                      next;
                                      -1
                                  ELSE
                                      # positive number #
                                      1
                                  FI;

            WHILE curr char >= "0" AND curr char <= "9"
            DO
                number *:= 10;
                number +:= ( ABS curr char - ABS "0" );
                next
            OD;

        # RESULT #
            number * sign multiplier
        END; # get number #

        # main parsing #
        WHILE str pos <= UPB s
        DO
            CHAR c = curr char;

            IF have minus OR have digit
            THEN
                # have the start of a number #
                INT from value = get number;
                element +:= 1;
                IF NOT have minus
                THEN
                    # not a range #
                    result[ element ] := from value
                ELSE
                    # have a range #
                    next;
                    INT to value = get number;
                    result[ element ] := RANGE( from value, to value )
                FI
            ELSE
                # should be a comma #
                next
            FI
        OD;

    # RESULT #
        result
    END; # parse range string #

# RESULT #
    parse range string
END; # TORANGE #

# converts a []INT to a comma separated string of the elements #
OP TOSTRING = ( []INT values )STRING:
BEGIN

    STRING result    := "";
    STRING separator := "";

    FOR pos FROM LWB values TO UPB values
    DO
        result +:= ( separator + whole( values[ pos ], 0 ) );
        separator := ","
    OD;

# RESULT #
    result
END; # TOSTRING #

test:(
    print( ( TOSTRING range expand( TORANGE "-6,-3--1,3-5,7-11,14,15,17-20" ), newline ) )
)


range←{
    aplnum←{⍎('¯',⎕D)[('-',⎕D)⍳⍵]}
    ∊{  0::('Invalid range: ''',⍵,'''')⎕SIGNAL 11
        n←aplnum¨(~<\(⊢≠∨\)⍵∊⎕D)⊆⍵
        1=≢n:n
        s e←n
        (s+(⍳e-s-1))-1
    }¨(⍵≠',')⊆⍵
}


-- Each comma-delimited string is mapped to a list of integers,
-- and these integer lists are concatenated together into a single list

---------------------- RANGE EXPANSION ---------------------

-- expansion :: String -> [Int]
on expansion(strExpr)
    -- The string (between commas) is split on hyphens,
    -- and this segmentation is rewritten to ranges or minus signs
    -- and evaluated to lists of integer values

    -- signedRange :: String -> [Int]
    script signedRange
        -- After the first character, numbers preceded by an
        -- empty string (resulting from splitting on hyphens)
        -- and interpreted as negative

        -- signedIntegerAppended:: [Int] -> String -> Int -> [Int] -> [Int]
        on signedIntegerAppended(acc, strNum, iPosn, xs)
            if strNum ≠ "" then
                if iPosn > 1 then
                    set strSign to |λ|(0 < length of (item (iPosn - 1) of xs)) ¬
                        of bool("", "-")
                else
                    set strSign to "+"
                end if

                acc & ((strSign & strNum) as integer)
            else
                acc
            end if
        end signedIntegerAppended

        on |λ|(strHyphenated)
            tupleRange(foldl(signedIntegerAppended, {}, ¬
                splitOn("-", strHyphenated)))
        end |λ|
    end script

    concatMap(signedRange, splitOn(",", strExpr))
end expansion

---------------------------- TEST --------------------------
on run

    expansion("-6,-3--1,3-5,7-11,14,15,17-20")

    --> {-6, -3, -2, -1, 3, 4, 5, 7, 8, 9, 10, 11, 14, 15, 17, 18, 19, 20}
end run

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

-- bool :: a -> a -> Bool -> a
on bool(tf, ff)
    -- The evaluation of either tf or ff,
    -- depending on a boolean value.
    script
        on |λ|(bln)
            if bln then
                set e to tf
            else
                set e to ff
            end if
            set c to class of e
            if {script, handler} contains c then
                |λ|() of mReturn(e)
            else
                e
            end if
        end |λ|
    end script
end bool

-- concatMap :: (a -> [b]) -> [a] -> [b]
on concatMap(f, xs)
    script append
        on |λ|(a, b)
            a & b
        end |λ|
    end script

    foldl(append, {}, map(f, xs))
end concatMap

-- enumFromTo :: Int -> Int -> [Int]
on enumFromTo(m, n)
    if n < m then
        set d to -1
    else
        set d to 1
    end if
    set lst to {}
    repeat with i from m to n by d
        set end of lst to i
    end repeat
    return lst
end enumFromTo

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

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

-- Lift 2nd class handler function into 1st class script wrapper
-- mReturn :: Handler -> Script
on mReturn(f)
    if class of f is script then
        f
    else
        script
            property |λ| : f
        end script
    end if
end mReturn

-- splitOn :: Text -> Text -> [Text]
on splitOn(strDelim, strMain)
    set {dlm, my text item delimiters} to {my text item delimiters, strDelim}
    set xs to text items of strMain
    set my text item delimiters to dlm
    return xs
end splitOn

-- range :: (Int, Int) -> [Int]
on tupleRange(tuple)
    if tuple = {} then
        {}
    else if length of tuple > 1 then
        enumFromTo(item 1 of tuple, item 2 of tuple)
    else
        item 1 of tuple
    end if
end tupleRange


expandRange: function [rng][
    flatten @ to :block
        join.with:" " map split.by:"," rng 'x ->
            replace replace replace x
                {/^\-(\d+)/} "(neg $1)" {/\-\-(\d+)/}
                "-(neg $1)" "-" ".."
]

print expandRange {-6,-3--1,3-5,7-11,14,15,17-20}


#!/usr/bin/awk -f
BEGIN {	FS=","; }

{	s="";
	for (i=1; i<=NF; i++) { expand($i); }
	print substr(s,2);
}

function expand(a) {
	idx = match(a,/[0-9]-/);
	if (idx==0) {
		s = s","a;
		return;
	}

	start= substr(a,1, idx)+0;
	stop = substr(a,idx+2)+0;
	for (m = start; m <= stop; m++) {
		s = s","m;
	}
	return;
}


      PRINT FNrangeexpand("-6,-3--1,3-5,7-11,14,15,17-20")
      END

      DEF FNrangeexpand(r$)
      LOCAL i%, j%, k%, t$
      REPEAT
        i% = INSTR(r$, "-", i%+1)
        IF i% THEN
          j% = i%
          WHILE MID$(r$,j%-1,1)<>"," AND j%<>1
            j% -= 1
          ENDWHILE
          IF i%>j% IF MID$(r$,j%,i%-j%)<>STRING$(i%-j%," ") THEN
            t$ = ""
            FOR k% = VALMID$(r$,j%) TO VALMID$(r$,i%+1)-1
              t$ += STR$(k%) + ","
            NEXT
            r$ = LEFT$(r$,j%-1) + t$ + MID$(r$,i%+1)
            i% = j% + LEN(t$) + 2
          ENDIF
        ENDIF
      UNTIL i% = 0
      = r$


#include <stdio.h>
#include <stdlib.h>
#include <ctype.h>

/* BNFesque
	rangelist := (range | number) [',' rangelist]
	range := number '-' number	*/

int get_list(const char *, char **);
int get_rnge(const char *, char **);

/* parser only parses; what to do with parsed items is up to
* the add_number and and_range functions */
void add_number(int x);
int add_range(int x, int y);

#define skip_space while(isspace(*s)) s++
#define get_number(x, s, e) (x = strtol(s, e, 10), *e != s)
int get_list(const char *s, char **e)
{
	int x;
	while (1) {
		skip_space;
		if (!get_rnge(s, e) && !get_number(x, s, e)) break;
		s = *e;

		skip_space;
		if ((*s) == '\0') { putchar('\n'); return 1; }
		if ((*s) == ',')  { s++; continue; }
		break;
	}
	*(const char **)e = s;
	printf("\nSyntax error at %s\n", s);
	return 0;
}

int get_rnge(const char *s, char **e)
{
	int x, y;
	char *ee;
	if (!get_number(x, s, &ee)) return 0;
	s = ee;

	skip_space;
	if (*s != '-') {
		*(const char **)e = s;
		return 0;
	}
	s++;
	if(!get_number(y, s, e)) return 0;
	return add_range(x, y);
}

void add_number(int x)
{
	printf("%d ", x);
}

int add_range(int x, int y)
{
	if (y <= x) return 0;
	while (x <= y) printf("%d ", x++);
	return 1;
}

int main()
{
	char *end;

	/* this is correct */
	if (get_list("-6,-3--1,3-5,7-11,14,15,17-20", &end)) puts("Ok");

	/* this is not.  note the subtle error: "-6 -3" is parsed
	 * as range(-6, 3), so synax error comes after that */
	get_list("-6 -3--1,3-5,7-11,14,15,17-20", &end);

	return 0;
}


using System;
using System.Collections.Generic;
using System.Linq;
using System.Text.RegularExpressions;

class Program
{
    static void Main(string[] args)
    {
        var rangeString = "-6,-3--1,3-5,7-11,14,15,17-20";
        var matches = Regex.Matches(rangeString, @"(?<f>-?\d+)-(?<s>-?\d+)|(-?\d+)");
        var values = new List<string>();

        foreach (var m in matches.OfType<Match>())
        {
            if (m.Groups[1].Success)
            {
                values.Add(m.Value);
                continue;
            }

            var start = Convert.ToInt32(m.Groups["f"].Value);
            var end = Convert.ToInt32(m.Groups["s"].Value) + 1;

            values.AddRange(Enumerable.Range(start, end - start).Select(v => v.ToString()));
        }

        Console.WriteLine(string.Join(", ", values));
    }
}


#include <iostream>
#include <sstream>
#include <iterator>
#include <climits>
#include <deque>

// parse a list of numbers with ranges
//
// arguments:
//  is:  the stream to parse
//  out: the output iterator the parsed list is written to.
//
// returns true if the parse was successful. false otherwise
template<typename OutIter>
 bool parse_number_list_with_ranges(std::istream& is, OutIter out)
{
  int number;
  // the list always has to start with a number
  while (is >> number)
  {
    *out++ = number;

    char c;
    if (is >> c)
      switch(c)
      {
      case ',':
        continue;
      case '-':
        {
          int number2;
          if (is >> number2)
          {
            if (number2 < number)
              return false;
            while (number < number2)
              *out++ = ++number;
            char c2;
            if (is >> c2)
              if (c2 == ',')
                continue;
              else
                return false;
            else
              return is.eof();
          }
          else
            return false;
        }
      default:
        return is.eof();
      }
    else
      return is.eof();
  }
  // if we get here, something went wrong (otherwise we would have
  // returned from inside the loop)
  return false;
}

int main()
{
  std::istringstream example("-6,-3--1,3-5,7-11,14,15,17-20");
  std::deque<int> v;
  bool success = parse_number_list_with_ranges(example, std::back_inserter(v));
  if (success)
  {
    std::copy(v.begin(), v.end()-1,
              std::ostream_iterator<int>(std::cout, ","));
    std::cout << v.back() << "\n";
  }
  else
    std::cout << "an error occured.";
}


(defn split [s sep]
      (defn skipFirst [[x & xs :as s]]
	(cond (empty? s) [nil nil]
	      (= x sep)  [x xs]
	      true       [nil s]))
      (loop [lst '(), s s]
	 (if (empty? s) (reverse lst)
	     (let [[hd trunc] (skipFirst s)
	           [word news] (split-with #(not= % sep) trunc)
		   cWord (cons hd word)]
		     (recur (cons (apply str cWord) lst)
		      	  (apply str (rest news)))))))

(defn parseRange [[x & xs :as s]]
       (if (some #(= % \-) xs)
	   (let [[r0 r1] (split s \-)]
		(range (read-string r0) (inc (read-string r1))))
	   (list (read-string (str s))))))

(defn rangeexpand [s]
  (flatten (map parseRange (split s \,))))

> (rangeexpand "-6,-3--1,3-5,7-11,14,15,17-20")
(-6 -3 -2 -1 3 4 5 7 8 9 10 11 14 15 17 18 19 20)


       >>SOURCE FREE
IDENTIFICATION DIVISION.
PROGRAM-ID. expand-range.

DATA DIVISION.
WORKING-STORAGE SECTION.
01  comma-pos                           PIC 99 COMP VALUE 1.
01  dash-pos                            PIC 99 COMP.
01  end-num                             PIC S9(3).
01  Max-Part-Len                        CONSTANT 10.
01  num                                 PIC S9(3).
01  edited-num                          PIC -(3)9.
01  part                                PIC X(10).

01  part-flag                           PIC X.
    88 last-part                        VALUE "Y".

01  range-str                           PIC X(80).
01  Range-Str-Len                       CONSTANT 80.
01  start-pos                           PIC 99 COMP.
01  start-num                           PIC S9(3).

PROCEDURE DIVISION.
    ACCEPT range-str

    PERFORM WITH TEST AFTER UNTIL last-part
        UNSTRING range-str DELIMITED BY "," INTO part WITH POINTER comma-pos
        PERFORM check-if-last

        PERFORM find-range-dash

        IF dash-pos > Max-Part-Len
            PERFORM display-num
        ELSE
            PERFORM display-range
        END-IF
    END-PERFORM

    DISPLAY SPACES

    GOBACK
    .
check-if-last SECTION.
    IF comma-pos > Range-Str-Len
        SET last-part TO TRUE
    END-IF
    .
find-range-dash SECTION.
    IF part (1:1) <> "-"
        MOVE 1 TO start-pos
    ELSE
        MOVE 2 TO start-pos
    END-IF

    MOVE 1 TO dash-pos
    INSPECT part (start-pos:) TALLYING dash-pos FOR CHARACTERS BEFORE "-"
    COMPUTE dash-pos = dash-pos + start-pos - 1
    .
display-num SECTION.
    MOVE part TO edited-num
    CALL "display-edited-num" USING CONTENT part-flag, edited-num
    .
display-range SECTION.
    MOVE part (1:dash-pos - 1) TO start-num
    MOVE part (dash-pos + 1:) TO end-num

    PERFORM VARYING num FROM start-num BY 1 UNTIL num = end-num
        MOVE num TO edited-num
        CALL "display-edited-num" USING CONTENT "N", edited-num
    END-PERFORM

    MOVE end-num TO edited-num
    CALL "display-edited-num" USING CONTENT part-flag, edited-num
    .
END PROGRAM expand-range.

IDENTIFICATION DIVISION.
PROGRAM-ID. display-edited-num.

DATA DIVISION.
LINKAGE SECTION.
01  hide-comma-flag                     PIC X.
    88  hide-comma                      VALUE "Y".
01  edited-num                          PIC -(3)9.

PROCEDURE DIVISION USING hide-comma-flag, edited-num.
    DISPLAY FUNCTION TRIM(edited-num) NO ADVANCING
    IF NOT hide-comma
        DISPLAY ", " NO ADVANCING
    END-IF
    .
END PROGRAM display-edited-num.