' ***********************************************
'subject: p-adic square roots, Hensel lifting.
'tested : FreeBasic 1.07.0

'The root is squared, approximated by a
'rational, and compared with radicand a/b.

const emx = 48
'exponent maximum

const amx = 700000
'tentative argument maximum

'------------------------------------------------
const Mxd = cdbl(2)^53 - 1
'max. float64 integer

const Pmax = 32749
'max. prime < 2^15

type ratio
   as longint a, b
end type

type padic
declare function sqrt (byref q as ratio, byval sw as integer) as integer
'p-adic square root of q = a/b, set sw to print
declare sub printf (byval sw as integer)
'print expansion, set sw to print rational
declare function crat (byval sw as integer) as ratio
'rational reconstruction

declare sub cmpt (byref a as padic)
'let self:= complement_a
declare sub sqr (byref a as padic)
'let self:= a ^ 2

   as long d(-emx to emx - 1)
   as integer v
end type

'global variables
dim shared as long p1, p = 7
'default prime
dim shared as integer k = 11
'precision

#define min(a, b) iif((a) > (b), b, a)

'------------------------------------------------
'p-adic square root of g = a/b
function padic.sqrt (byref g as ratio, byval sw as integer) as integer
dim as longint a = g.a, b = g.b
dim as longint q, x, pk, pm
dim as long f1, r, s, t
dim i as integer, f as double
sqrt = 0

   if b = 0 then return 1
   if b < 0 then b = -b: a = -a
   if p < 2 or k < 1 then return 1

   'max. short prime
   p = min(p, Pmax)

   if sw then
      'echo numerator, denominator,
      print a;"/";str(b);" + ";
      'prime and precision
      print "O(";str(p);"^";str(k);")"
   end if

   'initialize
   v = 0
   p1 = p - 1
   for i = -emx to emx - 1
      d(i) = 0: next

   if a = 0 then return 0

   'valuation
   do until b mod p
      b \= p: v -= 1
   loop
   do until a mod p
      a \= p: v += 1
   loop

   if (v and 1) = 1 then
      'odd valuation
      print "non-residue mod"; p
      return -1
   end if

   'max. array length
   k = min(k + v, emx - 1)
   k -= v: v shr= 1

   if abs(a) > amx or b > amx then return -1

   if p = 2 then
      '1 / b = b (mod 8)
      'a / b = 1 (mod 8)
      t = a * b
      if (t and 7) - 1 then
         print "non-residue mod 8"
         return -1
      end if

   else
      'find root for small p
      for r = 1 to p1
         q = b * r * r - a
         if q mod p = 0 then exit for
      next r

      if r = p then
         print "non-residue mod"; p
         return -1
      end if

      'f'(r) = 2br
      t = b * r shl 1

      s = 0
      t mod= p
      'modular inverse for small p
      for f1 = 1 to p1
         s += t
         if s > p1 then s -= p
         if s = 1 then exit for
      next f1

      if f1 = p then
         print "impossible inverse mod"
         return -1
      end if
   end if

   'evaluate f(x)
   #macro evalf(x)
      f = b * x * cdbl(x / pk)
      f -= cdbl(a / pk)
      'overflow
      if f > Mxd then exit for
      q = clngint(f)
   #endmacro

   if p = 2 then
      'initialize
      x = 1
      d(v) = 1
      d(v + 1) = 0

      pk = 4
      for i = v + 2 to k - 1 + v
         pk shl= 1
         '2-power overflow
         if pk < 1 then exit for
         evalf(x)
         'next digit
         d(i) = iif(q and 1, 1, 0)
         'lift x
         x += d(i) * (pk shr 1)
      next i

   else
      '-1 / f'(x) mod p
      f1 = p - f1
      x = r
      d(v) = x

      pk = 1
      for i = v + 1 to k - 1 + v
         pm = pk: pk *= p
         if pk \ pm - p then exit for
         evalf(x)
         d(i) = q * f1 mod p
         if d(i) < 0 then d(i) += p
         x += d(i) * pk
      next i
   end if
   k = i - v

   if sw then print "lift:";x;" mod";p;"^";str(k)
end function

'------------------------------------------------
'rational reconstruction
function padic.crat (byval sw as integer) as ratio
dim as integer i, j, t = min(v, 0)
dim as longint s, pk, pm
dim as long q, x, y
dim as double f, h
dim r as ratio

   'weighted digit sum
   s = 0: pk = 1
   for i = t to k - 1 + v
      pm = pk: pk *= p

      if pk \ pm - p then
         'overflow
         pk = pm: exit for
      end if

      s += d(i) * pm '(mod pk)
   next i

   'lattice basis reduction
   dim as longint m(1) = {pk, s}
   dim as longint n(1) = {0, 1}
   'norm(v)^2
   h = cdbl(s) * s + 1
   i = 0: j = 1

   'Lagrange's algorithm
   do
      f = m(i) * (m(j) / h)
      f += n(i) * (n(j) / h)

      'Euclidean step
      q = int(f +.5)
      m(i) -= q * m(j)
      n(i) -= q * n(j)

      f = h
      h = cdbl(m(i)) * m(i)
      h += cdbl(n(i)) * n(i)
      'compare norms
      if h < f then
        'interchange vectors
         swap i, j
      else
         exit do
      end if
   loop

   x = m(j): y = n(j)
   if y < 0 then y = -y: x = -x

   'check determinant
   t = abs(m(i) * y - x * n(i)) = pk

   if t = 0 then
      print "crat: fail"
      x = 0: y = 1

   else
      'negative powers
      for i = v to -1
         y *= p: next

      if sw then
         print x;
         if y > 1 then print "/";str(y);
         print
      end if
   end if

   r.a = x: r.b = y
return r
end function

'print expansion
sub padic.printf (byval sw as integer)
dim as integer i, t = min(v, 0)

   for i = k - 1 + t to t step -1
      print d(i);
      if i = 0 andalso v < 0 then print ".";
   next i
   print

   'rational approximation
   if sw then crat(sw)
end sub

'------------------------------------------------
'let self:= complement_a
sub padic.cmpt (byref a as padic)
dim i as integer, r as padic
dim as long c = 1
with r
  .v = a.v

   for i = .v to k +.v
      c += p1 - a.d(i)
      'carry
      if c > p1 then
        .d(i) = c - p: c = 1
      else
        .d(i) = c: c = 0
      end if
   next i
end with
this = r
end sub

'let self:= a ^ 2
sub padic.sqr (byref a as padic)
dim as long ptr rp, ap = @a.d(a.v)
dim as longint q, c = 0
dim as integer i, j
dim r as padic
with r
  .v = a.v shl 1
   rp = @.d(.v)

   for i = 0 to k
      for j = 0 to i
         c += ap[j] * ap[i - j]
      next j
      'Euclidean step
      q = c \ p
      rp[i] = c - q * p
      c = q
   next i
end with
this = r
end sub

'main
'------------------------------------------------
dim as integer sw
dim as padic a, c
dim as ratio q, r

width 64, 30
cls

'   -7 + O(2^7)
data -7,1, 2,7
data 9,1, 2,8
data 17,1, 2,9
data 497,10496, 2,18
data 10496,497, 2,19

data -577215,664901, 3,23
data 15403,26685, 3,18

data -1,1, 5,8
data 86,25, 5,8
data 2150,1, 5,8

data 2,1, 7,8
data 11696,621467, 7,11
data -27764,11521, 7,11
data -27584,12953, 7,11

data -166420,135131, 11,11
data 14142,135623, 5,15
data -255,256, 257,3

data 0,0, 0,0

print
do
   read q.a,q.b, p,k

   sw = a.sqrt(q, 1)
   if sw = 1 then exit do
   if sw then ? : continue do

   print "sqrt +/-"
   print "...";
   a.printf(0)
   a.cmpt(a)
   print "...";
   a.printf(0)

   c.sqr(a)
   print "sqrt^2"
   print "   ";
   c.printf(0)
   r = c.crat(1)

   '{r = q}
   if q.a * r.b - r.a * q.b then
      print "fail: sqrt^2"
   end if

   print : ?
loop

end


{-# LANGUAGE KindSignatures, DataKinds  #-}

import Data.Ratio
import Data.List (find)
import GHC.TypeLits
import Padic

pSqrt :: KnownNat p => Rational -> Padic p
pSqrt r = res
  where
    res = maybe Null mkUnit series
    (a, b) = (numerator r, denominator r)
    series = case modulo res of

      2 | eqMod 4 a 3 -> Nothing
        | not (eqMod 8 a 1) -> Nothing
        | otherwise -> Just $ 1 : 0 : go 8 1
        where
          go pk x =
            let q = ((b*x*x - a) `div` pk) `mod` 2
            in q : go (2*pk) (x + q * (pk `div` 2))

      p -> do
        y <- find (\x -> eqMod p (b*x*x) a) [1..p-1]
        df <- recipMod p (2*b*y)
        let go pk x =
              let f = (b*x*x - a) `div` pk
                  d = (f * (p - df)) `mod` p
              in x `div` (pk `div` p) : go (p*pk) (x + d*pk)
        Just $ go p y

eqMod :: Integral a => a -> a -> a -> Bool
eqMod p a b = a `mod` p == b `mod` p


using Nemo, LinearAlgebra

set_printing_mode(FlintPadicField, :terse)

""" convert to Rational (rational reconstruction) """
function toRational(pa::padic)
    rat = lift(QQ, pa)
    r, den = BigInt(numerator(rat)), Int(denominator(rat))
    p, k = Int(prime(parent(pa))), Int(precision(pa))
    N = BigInt(p^k)
    a1, a2 = [N, 0], [r, 1]
    while dot(a1, a1) > dot(a2, a2)
        q = dot(a1, a2) // dot(a2, a2)
        a1, a2 = a2, a1 - round(q) * a2
    end
    if dot(a1, a1) < N
        return (Rational{Int}(a1[1]) // Rational{Int}(a1[2])) // Int(den)
    else
        return Int(r) // den
    end
end

function dstring(pa::padic)
    u, v, n, p, k = pa.u, pa.v, pa.N, pa.parent.p, pa.parent.prec_max
    d = digits(v > 0 ? u * p^v : u, base=p, pad=k)
    return prod([i == k + v && v != 0 ? "$x . " : "$x " for (i, x) in enumerate(reverse(d))])
end

const DATA = [
    [-7, 1, 2, 7],
    [9, 1, 2, 8],
    [17, 1, 2, 9],
    [-1,  1,  5, 8],
    [86, 25,  5, 8],
    [2150, 1,  5, 8],
    [2, 1, 7, 8],
    [3029, 4821, 7, 9],
    [379, 449, 7, 8],
    [717, 8, 11, 7],
    [1414, 213, 41, 5],
    [-255, 256, 257, 3]
]

for (num1, den1, P, K) in DATA
    Qp = PadicField(P, K)
    a = Qp(QQ(num1 // den1))
    c = sqrt(a)
    r = toRational(c * c)
    println(a, "\nsqrt +/-\n", dstring(c), "\n", dstring(-c), "\nCheck sqrt^2:\n", dstring(c * c), "\n", r, "\n")
end


import strformat

const
  Emx = 64        # Exponent maximum.
  Amx = 6000      # Argument maximum.
  PMax = 32749    # Prime maximum.

type

  Ratio = tuple[a, b: int]

  Padic = object
    p: int                        # Prime.
    k: int                        # Precision.
    v: int
    d: array[-Emx..(Emx-1), int]

  PadicError = object of ValueError

proc sqrt(pa: var Padic; q: Ratio; sw: bool) =
  ## Return the p-adic square root of q = a/b. Set sw to print.

  var (a, b) = q
  var i, x: int

  if b == 0:
    raise newException(PadicError, &"Wrong rational: {a}/{b}" )
  if b < 0:
    b = -b
    a = -a
  if pa.p  < 2:
    raise newException(PadicError, &"Wrong value for p: {pa.p}")
  if pa.k < 1:
    raise newException(PadicError, &"Wrong value for k: {pa.k}")
  pa.p = min(pa.p, PMax)      # Maximum short prime.

  if sw: echo &"{a}/{b} + 0({pa.p}^{pa.k})"

  # Initialize.
  pa.v = 0
  pa.d.reset()
  if a == 0: return

  # Valuation.
  while b mod pa.p == 0:
    b = b div pa.p
    dec pa.v
  while a mod pa.p == 0:
    a = a div pa.p
    inc pa.v
  if (pa.v and 1) != 0:
    # Odd valuation.
    raise newException(PadicError, &"Non-residue mod {pa.p}.")

  # Maximum array length.
  pa.k = min(pa.k + pa.v, Emx - 1) - pa.v
  pa.v = pa.v shr 1

  if abs(a) > Amx or b > Amx:
    raise newException(PadicError, &"Rational exceeding limits: {a}/{b}.")

  if pa.p == 2:
    # 1 / b = b (mod 8); a / b = 1 (mod 8).
    if (a * b and 7) - 1 != 0:
      raise newException(PadicError, "Non-residue mod 8.")

    # Initialize.
    x = 1
    pa.d[pa.v] = 1
    pa.d[pa.v + 1] = 0
    var pk = 4
    i = pa.v + 2
    while i < pa.k + pa.v:
      pk *= 2
      let f = b * x * x - a
      let q = f div pk
      if f != q * pk: break   # Overflow.
      # Next digit.
      pa.d[i] = if (q and 1) != 0: 1 else: 0
      # Lift "x".
      x += pa.d[i] * (pk shr 1)
      inc i

  else:
    # Find root for small "p".
    var r = 1
    while r < pa.p:
      if (b * r * r - a) mod pa.p == 0: break
      inc r
    if r == pa.p:
      raise newException(PadicError, &"Non-residue mod {pa.p}.")
    let t = (b * r shl 1) mod pa.p
    var s = 0

    # Modular inverse for small "p".
    var f1 = 1
    while f1 < pa.p:
      inc s, t
      if s >= pa.p: dec s, pa.p
      if s == 1: break
      inc f1
    if f1 == pa.p:
      raise newException(PadicError, "Impossible to compute inverse modulo")

    f1 = pa.p - f1
    x = r
    pa.d[pa.v] = x

    var pk = 1
    i = pa.v + 1
    while i < pa.k + pa.v:
      pk *= pa.p
      let f = b * x * x - a
      let q = f div pk
      if f != q * pk: break   # Overflow.
      pa.d[i] = q * f1 mod pa.p
      if pa.d[i] < 0: pa.d[i] += pa.p
      x += pa.d[i] * pk
      inc i

  pa.k = i - pa.v
  if sw: echo &"lift: {x} mod {pa.p}^{pa.k}"

proc crat(pa: Padic; sw: bool): Ratio =
  ## Rational reconstruction.

  # Weighted digit sum.
  var
    s = 0
    pk = 1
  for i in min(pa.v, 0)..<(pa.k + pa.v):
    let pm = pk
    pk *= pa.p
    if pk div pm - pa.p != 0:
      # Overflow.
      pk = pm
      break
    s += pa.d[i] * pm

  # Lattice basis reduction.
  var
    m = [pk, s]
    n = [0, 1]
    i = 0
    j = 1
  s = s * s + 1
  # Lagrange's algorithm.
  while true:
    # Euclidean step.
    var q = ((m[i] * m[j] + n[i] * n[j]) / s).toInt
    m[i] -= q * m[j]
    n[i] -= q * n[j]
    q = s
    s = m[i] * m[i] + n[i] * n[i]
    # Compare norms.
    if s < q: swap i, j   # Interchange vectors.
    else: break

  var x = m[j]
  var y = n[j]
  if y < 0:
    y = -y
    x = -x

  # Check determinant.
  if abs(m[i] * y - x * n[i]) != pk:
    raise newException(PadicError, "Rational reconstruction failed.")

  # Negative powers.
  for i in pa.v..(-1): y *= pa.p

  if sw: echo x, if y > 1: '/' & $y else: ""
  result = (x, y)

func cmpt(pa: Padic): Padic =
  ## Return the complement.
  result = Padic(p: pa.p, k: pa.k, v: pa.v)
  var c = 1
  for i in pa.v..(pa.k + pa.v):
    inc c, pa.p - 1 - pa.d[i]
    if c >= pa.p:
      result.d[i] = c - pa.p
      c = 1
    else:
      result.d[i] = c
      c = 0

func sqr(pa: Padic): Padic =
  ## Return the square of a P-adic number.
  result = Padic(p: pa.p, k: pa.k, v: pa.v * 2)
  var c = 0
  for i in 0..pa.k:
    for j in 0..i:
      c += pa.d[pa.v + j] * pa.d[pa.v + i - j]
    # Euclidean step.
    let q = c div pa.p
    result.d[result.v + i] = c - q * pa.p
    c = q

func `$`(pa: Padic): string =
  ## String representation.
  let t = min(pa.v, 0)
  for i in countdown(pa.k - 1 + t, t):
    result.add $pa.d[i]
    if i == 0 and pa.v < 0: result.add "."
    result.add " "

when isMainModule:

  const Data = [[-7, 1, 2, 7],
                [9, 1, 2, 8],
                [17, 1, 2, 9],
                [497, 10496, 2, 18],
                [10496, 497, 2, 19],
                [3141, 5926, 3, 15],
                [2718,  281, 3, 13],
                [-1,  1,  5, 8],
                [86, 25,  5, 8],
                [2150, 1,  5, 8],
                [2,1, 7, 8],
                [-2645, 28518, 7, 9],
                [3029, 4821, 7, 9],
                [379, 449, 7, 8],
                [717, 8, 11, 7],
                [1414, 213, 41, 5],
                [-255, 256, 257, 3]]

  for d in Data:
    try:
      let q: Ratio = (d[0], d[1])
      var a = Padic(p: d[2], k: d[3])
      a.sqrt(q, true)
      echo "sqrt +/-"
      echo "...", a
      a = a.cmpt()
      echo "...", a
      let c = sqr(a)
      echo "sqrt^2"
      echo "   ", c
      let r = c.crat(true)
      if q.a * r.b - r.a * q.b != 0:
        echo "fail: sqrt^2"
      echo ""
    except PadicError:
      echo getCurrentExceptionMsg()


constant EMX  = 48       // exponent maximum (if indexing starts at -EMX)
constant DMX  = 1e5     // approximation loop maximum
constant AMX  = 700000 // argument maximum
constant PMAX = 32749   // prime maximum

// global variables
integer p1 = 0
integer p  = 7    // default prime
integer k  = 11   // precision

type Ratio(sequence r)
    return length(r)=2 and integer(r[1]) and integer(r[2])
end type

class Padic
    integer v = 0
    sequence d = repeat(0,EMX*2)

    function square_root(Ratio g, integer sw)
        -- p-adic square root of g = a/b
        integer {a,b} = g
        atom f, q, pk, x
        integer f1, r, s, t, i, res = 0

        if b = 0 then return 1 end if
        if b < 0 then
            b = -b
            a = -a
        end if
        if p < 2 or k < 1 then return 1 end if

        -- max. short prime
        p = min(p, PMAX)
        if sw then
            -- numerator, denominator, prime, precision
            printf(1,"%d/%d + O(%d^%d)\n",{a,b,p,k})
        end if

        -- initialize
        v = 0
        p1 = p - 1
        sequence ntd = repeat(0,2*EMX) -- (new this.d)
        if a = 0 then return 0 end if

        -- valuation
        while remainder(b,p)=0 do
            b /= p
            v -= 1
        end while
        while remainder(a,p)=0 do
            a /= p
            v += 1
        end while

        if remainder(v,2) then
            -- odd valuation
            printf(1,"(1)non-residue mod %d\n",p)
            return -1
        end if

        -- max. array length
        k = min(k + v, EMX - 1) - v
        v = floor(v/2)

        if abs(a) > AMX or b > AMX then return -1 end if

        if p = 2 then
            --1 / b = b (mod 8)
            --a / b = 1 (mod 8)
            t = a * b
            if mod(t,8)-1 then
                printf(1,"(2)non-residue mod 8\n")
                return -1
             end if

        else
            -- find root for small p
            for r = 1 to p1 do
                f = b * r * r - a
                if mod(f,p) = 0 then exit end if
            end for

            if r = p then
                printf(1,"(3)non-residue mod %d\n", p)
                return -1
            end if

            -- f'(r) = 2br
            t = b * r * 2

            s = 0
            t = mod(t,p)
            -- modular inverse for small p
            for f1 = 1 to p1 do
                s += t
                if s > p1 then s -= p end if
                if s = 1 then exit end if
            end for

            if f1 = p then
                printf(1,"impossible inverse mod\n")
                return -1
            end if
        end if

        if p = 2 then
            -- initialize
            x = 1
            ntd[v+EMX+1] = 1
            ntd[v+EMX+2] = 0

            pk = 4
            for i = v+2 to k-1+v do
                pk *= 2
                f = b * x * x - a
                q = floor(f/pk)
                -- overflow
                if f != q * pk then exit end if
                -- next digit
                ntd[i+EMX+1] = and_bits(q,1)
                -- lift x
                x += ntd[i+EMX+1] * floor(pk/2)
            end for

        else
            -- -1 / f'(x) mod p
            f1 = p - f1
            x = r
            ntd[v+EMX+1] = x

            pk = 1
            for i = v+1 to k-1 do
                pk *= p
                f = b * x * x - a
                q = floor(f/pk)
                -- overflow
                if f - q * pk then exit end if
                r = mod(q*f1,p)
                if r < 0 then r += p end if
                ntd[i+EMX+1] = r
                x += r * pk
            end for
        end if
        this.d = ntd
        k = i-v

        if sw then
            printf(1,"lift: %d mod %d^%d\n",{x,p,k})
        end if
        return 0
    end function

    function square()
        integer c = 0
        Padic r = new()
        r.v = this.v * 2
        sequence td = this.d,
                 rd = r.d
        for i=0 to k do
            for j=0 to i do
                c += td[v+j+EMX+1] * td[v+i-j+EMX+1]
            end for
            // Euclidean step
            integer q = floor(c/p)
            rd[r.v+i+EMX+1] = c - q*p
            c = q
        end for
        r.d = rd
        return r
    end function

    function complement()
        integer c = 1
        Padic r = new({v})
        sequence rd = r.d
        for i=v to k+v do
            integer dx = i+EMX+1
            c += p1 - this.d[dx]
            if c>p1 then
                rd[dx] = c - p
                c = 1
            else
                rd[dx] = c
                c = 0
            end if
        end for
        r.d = rd
        return r
    end function

    function crat(integer sw)
        -- rational reconstruction
        integer i, j, t = min(v, 0)
        Ratio r
        atom f
        integer x, y
        atom p1,pk, q, s

        -- weighted digit sum
        s = 0
        pk = 1
        for i = t to k-1+v do
            p1 = pk
            pk *= p
            if floor(pk/p1) - p then
                -- overflow
                pk = p1
                exit
            end if
            s += d[i+EMX+1] * p1 --(mod pk)
        end for

        -- lattice basis reduction
        sequence m = {pk, s},
                 n = {0, 1}
        i = 1
        j = 2
        s = s * s + 1 -- norm(v)^2

        -- Lagrange's algorithm
        while true do
            f = (m[i] * m[j] + n[i] * n[j]) / s

            -- Euclidean step
            q = floor(f +.5)
            m[i] -= q * m[j]
            n[i] -= q * n[j]

            q = s
            s = m[i] * m[i] + n[i] * n[i]
            -- compare norms
            if s < q then
                -- interchange vectors
                {i,j} = {j,i}
            else
                exit
            end if
        end while

        x = m[j]
        y = n[j]
        if y < 0 then
            y = -y
            x = -x
        end if

        -- check determinant
        t = abs(m[i] * y - x * n[i]) == pk

        if not t then
            printf(1,"crat: fail\n")
            x = 0
            y = 1
        else
            -- negative powers
            for i = v to -1 do
                y *= p
            end for

            if sw then
--              printf(1,iff(y=1?"%d":"%d/%d"),{x*sgn,y})
                printf(1,iff(y=1?"%d\n":"%d/%d\n"),{x,y})
            end if
        end if

        r = {x,y}
        return r
    end function

    procedure prntf(bool sw)
        -- print expansion
        integer t = min(v, 0)
        for i=k-1+t to t by -1 do
            printf(1,"%d",d[i+EMX+1])
            printf(1,iff(i=0 and v<0?". ":" "))
        end for
        printf(1,"\n")
        // rational approximation
        if sw then crat(sw) end if
    end procedure
end class

constant tests = {
    {{-7,1},2,7},
--/*
    {{9,1},2,8},
    {{17,1},2,9},
    {{497,10496},2,18},
    {{10496,497},2,19},

    {{3141,5926},3,17},
    {{2718,281},3,15},

    {{-1,1},5,8},
    {{86,25},5,8},
    {{2150,1},5,10},

    {{2,1},7,8},
    {{-2645,28518},7,9},
    {{3029,4821},7,9},
    {{379,449},7,8},

    {{717,8},11,7},
    {{1414,213},41,5},
--*/
    {{-255,256},257,3}
}

Padic a = new(), c
Ratio q, r

for i=1 to length(tests) do
   {q,p,k} = tests[i]

   integer sw = a.square_root(q, 1)
   if sw=1 then exit end if
   if sw=0 then
       printf(1,"square_root +/-\n")
       printf(1,"... ")
       a.prntf(0)
       a = a.complement()
       printf(1,"... ")
       a.prntf(0)

       c = a.square()
       printf(1,"square_root^2\n")
       printf(1,"    ")
       c.prntf(0)
       r = c.crat(1)

       if q[1] * r[2] - r[1] * q[2] then
          printf(1,"fail: square_root^2\n")
       end if
   end if
   printf(1,"\n")
end for


import "/dynamic" for Struct
import "/big" for BigInt

// constants
var EMX  = 64       // exponent maximum (if indexing starts at -EMX)
var AMX  = 6000     // argument maximum
var PMAX = 32749    // prime maximum

// global variables
var P1 = 0
var P  = 7    // default prime
var K  = 11   // precision

var Ratio = Struct.create("Ratio", ["a", "b"])

class Padic {
    // uninitialized
    construct new() {
        _v = 0
        _d = List.filled(2 * EMX, 0) // add EMX to index to be consistent wih FB
    }

    // properties
    v { _v }
    v=(o) { _v = o }
    d { _d }

    // (re)initialize 'this' to the square root of a Ratio, set 'sw' to print
    sqrt(g, sw) {
        var a = g.a
        var b = g.b
        if (b == 0) return 1
        if (b < 0) {
            b = -b
            a = -a
        }
        if (P < 2 || K < 1) return 1
        P = P.min(PMAX)  // maximum short prime
        if (sw != 0) {
            System.write("%(a)/%(b) + ")  // numerator, denominator
            System.print("0(%(P)^%(K))")  // prime, precision
        }

        // (re)initialize
        _v = 0
        P1 = P - 1
        _d = List.filled(2 * EMX, 0)
        if (a == 0) return 0

        //valuation
        while (b%P== 0) {
            b = (b/P).truncate
            _v = _v - 1
        }

        while (a%P == 0) {
            a = (a/P).truncate
            _v = _v + 1
        }

        if ((_v & 1) == 1) {
            // odd valuation
            System.print("non-residue mod %(P)")
            return -1
        }
        K = (K + _v).min(EMX - 1) - _v  // maximum array length
        _v = (_v/2).truncate

        if (a.abs > AMX || b > AMX) return -1
        var bb = BigInt.new(b) // to avoid overflowing 'f(x) = b * x * x – a'
        var r
        var s
        var t
        var f
        var f1
        if (P == 2) {
            t = a * b
            if ((t & 7) - 1 != 0) {
                System.print("non-residue mod 8")
                return -1
            }
        } else {
            // find root for small P
            r = 1
            while (r <= P1) {
                f = bb * r * r - a
                if ((f % P) == 0) break
                r = r + 1
            }
            if (r == P) {
                System.print("non-residue mod %(P)")
                return -1
            }
            t = 2 * b * r
            s = 0
            t = t % P

            // modular inverse for small P
            f1 = 1
            while (f1 <= P1) {
                s = s + t
                if (s > P1) s = s - P
                if (s == 1) break
                f1 = f1 + 1
            }
            if (f1 == P) {
                System.print("impossible inverse mod")
                return -1
            }
        }
        var x
        var pk
        var q
        var i
        if (P == 2) {
            // initialize
            x = 1
            _d[_v+EMX] = 1
            _d[_v+1+EMX] = 0
            pk = 4
            i = _v + 2
            while (i <= K - 1 + _v) {
                pk = pk * 2
                f = bb * x * x - a
                q = f / pk
                // overflow
                if (f != q * pk) break
                // next digit
                _d[i+EMX] = ((q & 1) != 0) ? 1 : 0
                // lift x
                x = x + _d[i+EMX]*(pk >> 1)
                i = i + 1
            }

        } else {
            f1 = P - f1
            x = r
            _d[_v+EMX] = x
            pk = 1
            i = _v + 1
            while (i <= K - 1 + _v) {
                pk = pk * P
                f = bb * x * x - a
                q = f / pk
                // overflow
                if (f != q * pk) break
                _d[i+EMX] = q.toSmall * f1 % P
                if (_d[i+EMX] < 0) _d[i+EMX] = _d[i+EMX] + P
                x = x + _d[i+EMX]*pk
                i = i + 1
            }
        }
        K = i - _v
        if (sw != 0) System.print("lift: %(x) mod %(P)^%(K)")
        return 0
    }

    // rational reconstruction
    crat(sw) {
        var t = _v.min(0)
        // weighted digit sum
        var s = 0
        var pk = 1
        for (i in t..K-1+_v) {
            P1 = pk
            pk = pk * P
            if (((pk/P1).truncate - P) != 0) {
                // overflow
                pk = p1
                break
            }
            s = s + _d[i+EMX]*P1
        }

        // lattice basis reduction
        var m = [pk, s]
        var n = [0, 1]
        var i = 0
        var j = 1
        s = s * s + 1
        // Lagrange's algorithm
        while (true) {
            var f = (m[i] * m[j] + n[i] * n[j]) / s
            // Euclidean step
            var q = (f + 0.5).floor
            m[i] = m[i] - q*m[j]
            n[i] = n[i] - q*n[j]
            q = s
            s = m[i] * m[i] + n[i] * n[i]
            // compare norms
            if (s < q) {
                // interchange vectors
                var z = i
                i = j
                j = z
            } else {
                break
            }
        }
        var x = m[j]
        var y = n[j]
        if (y < 0) {
            y = -y
            x = -x
        }

        // check determinant
        t = (m[i]*y - x*n[i]).abs == pk
        if (!t) {
            System.print("crat: fail")
            x = 0
            y = 1
        } else {
            // negative powers
            var i = _v
            while (i <= -1) {
                y = y * P
                i = i + 1
            }
            if (sw != 0) {
                System.write(x)
                if (y > 1) System.write("/%(y)")
                System.print()
            }
        }

        return Ratio.new(x, y)
    }

    // print expansion
    printf(sw) {
        var t = _v.min(0)
        for (i in K - 1 + t..t) {
            System.write(_d[i + EMX])
            if (i == 0 && _v < 0) System.write(".")
            System.write(" ")
        }
        System.print()
        // rational approximation
        if (sw != 0) crat(sw)
    }

    // complement
    cmpt {
        var c = 1
        var r = Padic.new()
        r.v = _v
        for (i in r.v..K + r.v) {
            c = c + P1 - _d[i+EMX]
            if (c > P1) {
                r.d[i+EMX] = c - P
                c = 1
            } else {
                r.d[i+EMX] = c
                c = 0
            }
        }
        return r
    }

    // square
    sqr {
        var c = 0
        var r = Padic.new()
        r.v = _v * 2
        for (i in 0..K) {
            for (j in 0..i) c = c + _d[_v+j+EMX] * _d[_v+i-j+EMX]
            // Euclidean step
            var q = (c/P).truncate
            r.d[r.v+i+EMX] = c - q*P
            c = q
        }
        return r
    }
}

var data = [
    [-7, 1, 2, 7],
    [9, 1, 2, 8],
    [17, 1, 2, 9],
    [497, 10496, 2, 18],
    [10496, 497, 2, 19],
    [3141, 5926, 3, 15],
    [2718,  281, 3, 13],
    [-1,  1,  5, 8],
    [86, 25,  5, 8],
    [2150, 1,  5, 8],
    [2,1, 7, 8],
    [-2645, 28518, 7, 9],
    [3029, 4821, 7, 9],
    [379, 449, 7, 8],
    [717, 8, 11, 7],
    [1414, 213, 41, 5],
    [-255, 256, 257, 3]
]

var sw = 0
var a = Padic.new()
var c = Padic.new()

for (d in data) {
    var q = Ratio.new(d[0], d[1])
    P = d[2]
    K = d[3]
    sw = a.sqrt(q, 1)
    if (sw == 1) break
    if (sw == 0) {
        System.print("sqrt +/-")
        System.write("...")
        a.printf(0)
        a = a.cmpt
        System.write("...")
        a.printf(0)
        c = a.sqr
        System.print("sqrt^2")
        System.write("   ")
        c.printf(0)
        var r = c.crat(1)
        if (q.a * r.b - r.a * q.b != 0) {
            System.print("fail: sqrt^2")
        }
        System.print()
    }
}


on doTask()
    set part1 to {"First 20 palindromic gapful numbers > 100 ending with each digit from 1 to 9:"}
    set part2 to {"86th to 100th such:"}
    set part3 to {"991st to 1000th:"}
    set astid to AppleScript's text item delimiters
    set AppleScript's text item delimiters to "  "
    repeat with endDigit from 1 to 9
        set {collector1, collector2, collector3} to {{}, {}, {}}
        set outerNumber to endDigit * 11 -- Number formed from the palindromes' first and last digits.
        set oddDigitCount to true -- Starting with palindromes in the hundreds.
        set baseHi to endDigit * 10 -- Number formed from just the "high end" digits, initially endDigit and a middle 0.
        set hi to baseHi
        set carryCheck to hi + 10 -- Number reached when incrementing the "high end" number changes its first digit.
        set inc to 10 -- Incrementor for the middle digit(s) of the palindromes themselves.
        set counter to 0
        set maxNeeded to 1000
        set done to false
        repeat until (done)
            -- Work out every 10th palindrome (middle digit = 0) from the current "high end" number.
            set pal to hi
            if (oddDigitCount) then
                set temp to hi div 10
            else
                set temp to hi
            end if
            repeat until (temp is 0)
                set pal to pal * 10 + temp mod 10
                set temp to temp div 10
            end repeat
            -- Check the result and the following 9 palindromes (derived by incrementing the middle digit(s))
            -- and store as text any which are both gapful and the ones required.
            repeat 10 times
                if (pal mod outerNumber is 0) then
                    set counter to counter + 1
                    if (counter ≤ 20) then
                        set end of collector1 to intText(pal)
                    else if (counter < 86) then
                    else if (counter ≤ 100) then
                        set end of collector2 to intText(pal)
                    else if (counter < 991) then
                    else --if (counter ≤ 1000) then
                        set end of collector3 to intText(pal)
                        set done to (counter = maxNeeded)
                        if (done) then exit repeat
                    end if
                end if
                set pal to pal + inc
            end repeat
            -- Increment the high end number's penultimate digit after every 10th palindrome.
            -- If a carry changes its first digit, reset for longer palindromes.
            set hi to hi + 10
            if (hi = carryCheck) then
                set oddDigitCount to (not oddDigitCount)
                if (oddDigitCount) then
                    set baseHi to baseHi * 10
                    set carryCheck to carryCheck * 10
                    set inc to inc div 11 * 10
                else
                    set inc to inc * 11
                end if
                set hi to baseHi
            end if
        end repeat
        set {end of part1, end of part2, end of part3} to {collector1 as text, collector2 as text, collector3 as text}
    end repeat
    set AppleScript's text item delimiters to linefeed
    set output to {part1, "", part2, "", part3} as text
    set AppleScript's text item delimiters to astid

    return output
end doTask

on intText(n)
    if (n < 100000000) then return n as text
    set txt to text 2 thru end of ((100000000 + (n mod 100000000 as integer)) as text)
    set n to n div 100000000
    repeat
        set lo to n mod 100000000 as integer
        set n to n div 100000000
        if (n is 0) then return (lo as text) & txt
        set txt to (text 2 thru end of ((100000000 + lo) as text)) & txt
    end repeat
end intText

return doTask()


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

typedef uint64_t integer;

integer reverse(integer n) {
    integer rev = 0;
    while (n > 0) {
        rev = rev * 10 + (n % 10);
        n /= 10;
    }
    return rev;
}

typedef struct palgen_tag {
    integer power;
    integer next;
    int digit;
    bool even;
} palgen_t;

void init_palgen(palgen_t* palgen, int digit) {
    palgen->power = 10;
    palgen->next = digit * palgen->power - 1;
    palgen->digit = digit;
    palgen->even = false;
}

integer next_palindrome(palgen_t* p) {
    ++p->next;
    if (p->next == p->power * (p->digit + 1)) {
        if (p->even)
            p->power *= 10;
        p->next = p->digit * p->power;
        p->even = !p->even;
    }
    return p->next * (p->even ? 10 * p->power : p->power)
        + reverse(p->even ? p->next : p->next/10);
}

bool gapful(integer n) {
    integer m = n;
    while (m >= 10)
        m /= 10;
    return n % (n % 10 + 10 * m) == 0;
}

void print(int len, integer array[][len]) {
    for (int digit = 1; digit < 10; ++digit) {
        printf("%d: ", digit);
        for (int i = 0; i < len; ++i)
            printf(" %llu", array[digit - 1][i]);
        printf("\n");
    }
}

int main() {
    const int n1 = 20, n2 = 15, n3 = 10;
    const int m1 = 100, m2 = 1000;

    integer pg1[9][n1];
    integer pg2[9][n2];
    integer pg3[9][n3];

    for (int digit = 1; digit < 10; ++digit) {
        palgen_t pgen;
        init_palgen(&pgen, digit);
        for (int i = 0; i < m2; ) {
            integer n = next_palindrome(&pgen);
            if (!gapful(n))
                continue;
            if (i < n1)
                pg1[digit - 1][i] = n;
            else if (i < m1 && i >= m1 - n2)
                pg2[digit - 1][i - (m1 - n2)] = n;
            else if (i >= m2 - n3)
                pg3[digit - 1][i - (m2 - n3)] = n;
            ++i;
        }
    }

    printf("First %d palindromic gapful numbers ending in:\n", n1);
    print(n1, pg1);

    printf("\nLast %d of first %d palindromic gapful numbers ending in:\n", n2, m1);
    print(n2, pg2);

    printf("\nLast %d of first %d palindromic gapful numbers ending in:\n", n3, m2);
    print(n3, pg3);

    return 0;
}


#include <iostream>
#include <cstdint>

typedef uint64_t integer;

integer reverse(integer n) {
    integer rev = 0;
    while (n > 0) {
        rev = rev * 10 + (n % 10);
        n /= 10;
    }
    return rev;
}

// generates base 10 palindromes greater than 100 starting
// with the specified digit
class palindrome_generator {
public:
    palindrome_generator(int digit) : power_(10), next_(digit * power_ - 1),
        digit_(digit), even_(false) {}
    integer next_palindrome() {
        ++next_;
        if (next_ == power_ * (digit_ + 1)) {
            if (even_)
                power_ *= 10;
            next_ = digit_ * power_;
            even_ = !even_;
        }
        return next_ * (even_ ? 10 * power_ : power_)
            + reverse(even_ ? next_ : next_/10);
    }
private:
    integer power_;
    integer next_;
    int digit_;
    bool even_;
};

bool gapful(integer n) {
    integer m = n;
    while (m >= 10)
        m /= 10;
    return n % (n % 10 + 10 * m) == 0;
}

template<size_t len>
void print(integer (&array)[9][len]) {
    for (int digit = 1; digit < 10; ++digit) {
        std::cout << digit << ":";
        for (int i = 0; i < len; ++i)
            std::cout << ' ' << array[digit - 1][i];
        std::cout << '\n';
    }
}

int main() {
    const int n1 = 20, n2 = 15, n3 = 10;
    const int m1 = 100, m2 = 1000;

    integer pg1[9][n1];
    integer pg2[9][n2];
    integer pg3[9][n3];

    for (int digit = 1; digit < 10; ++digit) {
        palindrome_generator pgen(digit);
        for (int i = 0; i < m2; ) {
            integer n = pgen.next_palindrome();
            if (!gapful(n))
                continue;
            if (i < n1)
                pg1[digit - 1][i] = n;
            else if (i < m1 && i >= m1 - n2)
                pg2[digit - 1][i - (m1 - n2)] = n;
            else if (i >= m2 - n3)
                pg3[digit - 1][i - (m2 - n3)] = n;
            ++i;
        }
    }

    std::cout << "First " << n1 << " palindromic gapful numbers ending in:\n";
    print(pg1);

    std::cout << "\nLast " << n2 << " of first " << m1 << " palindromic gapful numbers ending in:\n";
    print(pg2);

    std::cout << "\nLast " << n3 << " of first " << m2 << " palindromic gapful numbers ending in:\n";
    print(pg3);

    return 0;
}


def palindromesgapful(digit, pow)
  r1 = (10_u64**pow + 1) * digit
  r2 = 10_u64**pow * (digit + 1)
  nn = digit * 11
  (r1...r2).select { |i| n = i.to_s; n == n.reverse && i.divisible_by?(nn) }
end

def digitscount(digit, count)
  pow  = 2
  nums = [] of UInt64
  while nums.size < count
    nums += palindromesgapful(digit, pow)
    pow += 1
  end
  nums[0...count]
end

count = 20
puts "First 20 palindromic gapful numbers ending with:"
(1..9).each { |digit| print "#{digit} : #{digitscount(digit, count)}\n" }

count = 100
puts "\nLast 15 of first 100 palindromic gapful numbers ending in:"
(1..9).each { |digit| print "#{digit} : #{digitscount(digit, count).last(15)}\n" }

count = 1000
puts "\nLast 10 of first 1000 palindromic gapful numbers ending in:"
(1..9).each { |digit| print "#{digit} : #{digitscount(digit, count).last(10)}\n" }


// Palindromic Gapful Numbers . Nigel Galloway: December 3rd., 2020
let rec fN g l=seq{match l with 3->yield! seq{for n in 0L..9L->g*100L+g+n*10L}
                               |4->yield! seq{for n in 0L..9L->g*1000L+g+n*110L}
                               |_->yield! seq{for n in 0L..9L do for i in fN n (l-2)->i*10L+g+g*(pown 10L (l-1))}}

let rcGf n=let rec rcGf g=seq{yield! fN n g|>Seq.filter(fun g->g%(10L*n+n)=0L); yield! rcGf(g+1)} in rcGf 3

[1L..9L]|>Seq.iter(fun n->rcGf n|>Seq.take 20|>Seq.iter(printf "%d ");printfn "");printfn "#####"
[1L..9L]|>Seq.iter(fun n->rcGf n|>Seq.skip 85|>Seq.take 15|>Seq.iter(printf "%d ");printfn "");printfn "#####"
[1L..9L]|>Seq.iter(fun n->rcGf n|>Seq.skip 990|>Seq.take 10|>Seq.iter(printf "%d ");printfn "");printfn "#####"


USING: formatting fry io kernel lists lists.lazy locals math
math.functions math.ranges math.text.utils prettyprint sequences ;
IN: rosetta-code.palindromic-gapful-numbers

! Palindromic numbers are relatively rare compared to gapful
! numbers, so our strategy for finding palindromic gapful
! numbers is to filter gapful numbers from palindromic numbers.

! Palindromic numbers can be generated directly rather than
! filtered or identified from the natural numbers. This is a
! significant speedup since palindromic numbers are relatively
! rare in the natural numbers.

! Here I have used a generation method similar to
! https://www.geeksforgeeks.org/generate-palindromic-numbers-less-n/

! Create a palindrome from its base natural number.
! e.g.  321 t -> 32123
!       321 f -> 321123
: create-palindrome ( n odd? -- m )
    dupd [ 10 /i ] when swap [ over 0 > ]
    [ 10 * [ 10 /mod ] [ + ] bi* ] while nip ;

! Create an infinite lazy list of palindromic numbers starting
! at 100.
: palindromes ( -- l )
    1 lfrom [
        10 swap ^ dup 10 * [a,b)
        [ [ t create-palindrome ] map ]
        [ [ f create-palindrome ] map ] bi
        [ sequence>list ] [email protected] lappend
    ] lmap-lazy lconcat ;

! Is an integer gapful?
: gapful? ( n -- ? )
    dup 1 digit-groups [ first ] [ last 10 * + ] bi divisor? ;

! Create an infinite lazy list of gapful palindromes.
: gapful-palindromes ( -- l ) palindromes [ gapful? ] lfilter ;

:: show-palindromic-gapfuls ( last of -- )
    gapful-palindromes :> nums
    last of
    "~~==[ Last  %d  of  %d  palindromic gapful numbers starting at 100 ]==~~\n"
    printf 9 [1,b] [| d |
        of nums [ 10 mod d = ] lfilter ltake list>array
        last tail* d pprint ": " write [ pprint bl ] each nl
    ] each nl ;

20 20    ! part 1
15 100   ! part 2
10 1000  ! part 3  (Optional)
[ show-palindromic-gapfuls ] [email protected]


function is_gapful( n as uinteger ) as boolean
    if n<100 then return false
    dim as string ns = str(n)
    dim as uinteger gap = 10*val(mid(ns,1,1)) + val(mid(ns,len(ns),1))
    if n mod gap = 0 then return true else return false
end function

function is_palindrome( n as uinteger ) as boolean
    dim as string ns = str(n)
    for i as uinteger = 1 to len(ns)\2
        if mid(ns,i,1) <> mid(ns,len(ns)+1-i,1) then return false
    next i
    return true
end function

function padto( n as uinteger, s as integer ) as string
    dim as string outstr=""
    dim as integer k = len(str(n))
    for i as integer = 1 to s-k
        outstr = " " + outstr
    next i
    return outstr + str(n)
end function

sub print_range( yays() as uinteger, first as uinteger, last as uinteger)
    dim as string outstr
    for i as uinteger = first to last
        outstr = padto(i,4)+"  :  "
        for d as uinteger = 1 to 9
            outstr += padto(yays(d,i), 11)
        next d
        print outstr
    next i
end sub

#define is_yay(n) (is_gapful(n) and is_palindrome(n))
#define log10(n) log(n)*0.43429448190325182765112891891660508229

dim as uinteger yays(1 to 9, 1 to 1000), nyays(1 to 9), num = 99, fd
do
    num += 1 : fd = val(left(str(num),1))
    if fd = 0 then continue do   'no paligap will have 0 as leading digit
    if nyays(fd) = 1000 then
        num = (fd+1)*10^int(log10(num))
    end if
    if is_yay(num) then
        nyays(fd) += 1
        yays(fd, nyays(fd)) = num
    end if
    for y as uinteger = 1 to 9
        if nyays(y) < 1000 then  continue do
    next y
    exit do
loop

'excessive output requirements for such a simple task
print_range(yays(), 1, 20)
print_range(yays(), 86, 100)
print_range(yays(), 991, 1000)


package main

import "fmt"

func reverse(s uint64) uint64 {
    e := uint64(0)
    for s > 0 {
        e = e*10 + (s % 10)
        s /= 10
    }
    return e
}

func commatize(n uint) string {
    s := fmt.Sprintf("%d", n)
    le := len(s)
    for i := le - 3; i >= 1; i -= 3 {
        s = s[0:i] + "," + s[i:]
    }
    return s
}

func ord(n uint) string {
    var suffix string
    if n > 10 && ((n-11)%100 == 0 || (n-12)%100 == 0 || (n-13)%100 == 0) {
        suffix = "th"
    } else {
        switch n % 10 {
        case 1:
            suffix = "st"
        case 2:
            suffix = "nd"
        case 3:
            suffix = "rd"
        default:
            suffix = "th"
        }
    }
    return fmt.Sprintf("%s%s", commatize(n), suffix)
}

func main() {
    const max = 10_000_000
    data := [][3]uint{{1, 20, 7}, {86, 100, 8}, {991, 1000, 10}, {9995, 10000, 12}, {1e5, 1e5, 14},
        {1e6, 1e6, 16}, {1e7, 1e7, 18}}
    results := make(map[uint][]uint64)
    for _, d := range data {
        for i := d[0]; i <= d[1]; i++ {
            results[i] = make([]uint64, 9)
        }
    }
    var p uint64
outer:
    for d := uint64(1); d < 10; d++ {
        count := uint(0)
        pow := uint64(1)
        fl := d * 11
        for nd := 3; nd < 20; nd++ {
            slim := (d + 1) * pow
            for s := d * pow; s < slim; s++ {
                e := reverse(s)
                mlim := uint64(1)
                if nd%2 == 1 {
                    mlim = 10
                }
                for m := uint64(0); m < mlim; m++ {
                    if nd%2 == 0 {
                        p = s*pow*10 + e
                    } else {
                        p = s*pow*100 + m*pow*10 + e
                    }
                    if p%fl == 0 {
                        count++
                        if _, ok := results[count]; ok {
                            results[count][d-1] = p
                        }
                        if count == max {
                            continue outer
                        }
                    }
                }
            }
            if nd%2 == 1 {
                pow *= 10
            }
        }
    }

    for _, d := range data {
        if d[0] != d[1] {
            fmt.Printf("%s to %s palindromic gapful numbers (> 100) ending with:\n", ord(d[0]), ord(d[1]))
        } else {
            fmt.Printf("%s palindromic gapful number (> 100) ending with:\n", ord(d[0]))
        }
        for i := 1; i <= 9; i++ {
            fmt.Printf("%d: ", i)
            for j := d[0]; j <= d[1]; j++ {
                fmt.Printf("%*d ", d[2], results[j][i-1])
            }
            fmt.Println()
        }
        fmt.Println()
    }
}


import Control.Monad (guard)

palindromic :: Int -> Bool
palindromic n = d == reverse d
 where
  d = show n

gapful :: Int -> Bool
gapful n = n `rem` firstLastDigit == 0
 where
  firstLastDigit = read [head asDigits, last asDigits]
  asDigits = show n

result :: Int -> [Int]
result d = do
  x <- [(d+100),(d+110)..]
  guard $ palindromic x && gapful x
  pure x

showSets :: (Int -> String) -> IO ()
showSets r = go 1
 where
  go n = if n <= 9 then do
    putStrLn (show n ++ ": " ++ r n)
    go (succ n)
    else pure ()

main :: IO ()
main = do
  putStrLn "\nFirst 20 palindromic gapful numbers ending in:"
  showSets (show . take 20 . result)
  putStrLn "\nLast 15 of first 100 palindromic gapful numbers ending in:"
  showSets (show . drop 85 . take 100 . result)
  putStrLn "\nLast 10 of first 1000 palindromic gapful numbers ending in:"
  showSets (show . drop 990 . take 1000 . result)
  putStrLn "\ndone."


import java.util.ArrayList;
import java.util.HashMap;
import java.util.List;
import java.util.Map;

public class PalindromicGapfulNumbers {

    public static void main(String[] args) {
        System.out.println("First 20 palindromic gapful numbers ending in:");
        displayMap(getPalindromicGapfulEnding(20, 20));

        System.out.printf("%nLast 15 of first 100 palindromic gapful numbers ending in:%n");
        displayMap(getPalindromicGapfulEnding(15, 100));

        System.out.printf("%nLast 10 of first 1000 palindromic gapful numbers ending in:%n");
        displayMap(getPalindromicGapfulEnding(10, 1000));
    }

    private static void displayMap(Map<Integer,List<Long>> map) {
        for ( int key = 1 ; key <= 9 ; key++ ) {
            System.out.println(key + " : " + map.get(key));
        }
    }

    public static Map<Integer,List<Long>> getPalindromicGapfulEnding(int countReturned, int firstHowMany) {
        Map<Integer,List<Long>> map = new HashMap<>();
        Map<Integer,Integer> mapCount = new HashMap<>();
        for ( int i = 1 ; i <= 9 ; i++ ) {
            map.put(i, new ArrayList<>());
            mapCount.put(i, 0);
        }
        boolean notPopulated = true;
        for ( long n = 101 ; notPopulated ; n = nextPalindrome(n) ) {
            if ( isGapful(n) ) {
                int index = (int) (n % 10);
                if ( mapCount.get(index) < firstHowMany ) {
                    map.get(index).add(n);
                    mapCount.put(index, mapCount.get(index) + 1);
                    if ( map.get(index).size() > countReturned ) {
                        map.get(index).remove(0);
                    }
                }
                boolean finished = true;
                for ( int i = 1 ; i <= 9 ; i++ ) {
                    if ( mapCount.get(i) < firstHowMany ) {
                        finished = false;
                        break;
                    }
                }
                if ( finished ) {
                    notPopulated = false;
                }
            }
        }
        return map;
    }

    public static boolean isGapful(long n) {
        String s = Long.toString(n);
        return n % Long.parseLong("" + s.charAt(0) + s.charAt(s.length()-1)) == 0;
    }

    public static int length(long n) {
        int length = 0;
        while ( n > 0 ) {
            length += 1;
            n /= 10;
        }
        return length;
    }

    public static long nextPalindrome(long n) {
        int length = length(n);
        if ( length % 2 == 0 ) {
            length /= 2;
            while ( length > 0 ) {
                n /= 10;
                length--;
            }
            n += 1;
            if ( powerTen(n) ) {
                return Long.parseLong(n + reverse(n/10));
            }
            return Long.parseLong(n + reverse(n));
        }
        length = (length - 1) / 2;
        while ( length > 0 ) {
            n /= 10;
            length--;
        }
        n += 1;
        if ( powerTen(n) ) {
            return Long.parseLong(n + reverse(n/100));
        }
        return Long.parseLong(n + reverse(n/10));
    }

    private static boolean powerTen(long n) {
        while ( n > 9 && n % 10 == 0 ) {
            n /= 10;
        }
        return n == 1;
    }

    private static String reverse(long n) {
        return (new StringBuilder(n + "")).reverse().toString();
    }

}


import Base.iterate, Base.IteratorSize, Base.IteratorEltype

struct Palindrome x1::UInt8; x2::UInt8; outer::UInt8; end
Base.IteratorSize(p::Palindrome) = Base.IsInfinite()
Base.IteratorEltype(g::Palindrome) = Vector{Int8}

function Base.iterate(p::Palindrome, state=(UInt8[p.x1]))
    arr, len = [p.outer; state; p.outer], length(state)
    if all(c -> c == p.x2, state)
        return arr, fill(p.x1, len + 1)
    end
    for i in (len+1)÷2:-1:1
        if state[i] < p.x2
            state[len - i + 1] = state[i] = state[i] + one(UInt8)
            return arr, state
        else
            state[len - i + 1] = state[i] = p.x1
        end
    end
    state[1] += one(UInt8)
    push!(state, state[1])
    return arr, state
end

asint(s) = foldl((i, j) -> 10i + j, s)
isgapful(a) = mod(asint(a), a[1] * 11) == 0
GapfulPalindrome(i) = Iterators.filter(isgapful, Iterators.take(Palindrome(0, 9, i), 100000000000))

function testpal()
    for (lastones, outof) in [(20, 20), (15, 100), (10, 1000), (10, 10000), (10, 100000), (10, 1000000), (10, 10000000)]
        @time begin
            println("\nLast digit | Last $lastones of $outof palindromic gapful numbers from 100\n",
                "-----------|----------------------------------------------------------------------------------------------------------------")
            output = fill("", 9)
            [email protected] for i in 1:9
                gplist = sort!(asint.(collect(Iterators.take(GapfulPalindrome(i), outof))))
                output[i] = "     $i        " * string(gplist[end-lastones+1:end]) * "\n"
            end
            foreach(print, output)
        end
    end
end

testpal()


ClearAll[GapfulQ, GetFirstPalindromicGapfulNumbers]
GapfulQ[n_Integer] := Divisible[n, FromDigits[IntegerDigits[n][[{1, -1}]]]]
GetFirstPalindromicGapfulNumbers[startend_, n_Integer] :=
 Module[{out = {}, i, new, digs, id},
  digs = 1;
  While[Length[out] < n,
   Do[
    id = IntegerDigits[i, 10, Ceiling[digs/2]];
    If[OddQ[digs],
     new = Join[{startend}, id, [email protected][id], {startend}]
     ,
     new = Join[{startend}, id, Reverse[id], {startend}]
     ];
    new //= FromDigits;
    If[GapfulQ[new],
     AppendTo[out, new]
     ];
    i++;
    ,
    {i, 0, 10^Ceiling[digs/2] - 1}
    ];
   digs += 1;
   ];
  Take[out, n]
  ]
Print["First 20 palindromic gapful numbers >100 ending with each digit from 1 to 9:"]
Print[GetFirstPalindromicGapfulNumbers[#, 20]] & /@ Range[9];
Print["86th to 100th:"]
Print[GetFirstPalindromicGapfulNumbers[#, 100][[86 ;; 100]]] & /@ Range[9];
Print["991st to 1000th:"]
Print[GetFirstPalindromicGapfulNumbers[#, 1000][[991 ;; 1000]]] & /@ Range[9];


Forms palindromes using number<->string conversions.


use strict;
use warnings;
use feature 'say';

use constant Inf  => 1e10;

sub is_p_gapful {
    my($d,$n) = @_;
    return '' unless 0 == $n % 11;
    my @digits = split //, $n;
    $d eq $digits[0] and (0 == $n % ($digits[0].$digits[-1])) and $n eq join '', reverse @digits;
}

for ([1, 20], [86, 15]) {
    my($offset, $count) = @$_;
    say "Palindromic gapful numbers starting at $offset:";
    for my $d ('1'..'9') {
        my $n = 0; my $out = "$d: ";
        $out .= do { $n+1 < $count+$offset ? (is_p_gapful($d,$_) and ++$n and $n >= $offset and "$_ ") : last } for 100 .. Inf;
        say $out
    }
    say ''
}


with javascript_semantics
function reverse_n(atom s)
    atom e = 0
    while s>0 do
        e = e*10 + remainder(s,10)
        s = floor(s/10)
    end while
    return e
end function

constant mx = 1000,
         data = {{1, 20, "%7d "}, {86, 100, "%8d "}, {991, 1000, "%10d "}}

include builtins\ordinal.e

function digit(sequence results, integer d)
    integer count = 0, pow = 1, fl = d*11
    for nd=3 to 15 do -- (number of digits, usually quits early)
        -- (obvs. 64-bit phix is fine with 19 digits, but 32-bit ain't)
        bool odd = (remainder(nd,2)==1)
        for s=d*pow to (d+1)*pow-1 do   -- (eg 300 to 399)
            integer e = reverse_n(s)
            for m=0 to iff(odd?9:0) do  -- (1 or 10 iterations)
                atom p = e + iff(odd ? s*pow*100+m*pow*10
                                     : s*pow*10)
                if remainder(p,fl)==0 then  -- gapful!
                    count += 1
                    results[count][d] = p
                    if count==mx then return results end if
                end if
            end for
        end for
        if odd then pow *= 10 end if
    end for
    if count<mx then ?9/0 end if -- oh dear...
    return results
end function

procedure main()
    sequence results = repeat(repeat({},9),mx)
    for d=1 to 9 do -- (the start/end digit)
        results = digit(results,d)
    end for

    for i=1 to length(data) do
        {integer s, integer e, string fmt} = data[i]
        printf(1,"%,d%s to %,d%s palindromic gapful numbers (> 100) ending with:\n", {s,ord(s),e,ord(e)})
        for d=1 to 9 do
            printf(1,"%d: ",d)
            for j=s to e do
                printf(1,fmt,results[j][d])
            end for
            printf(1,"\n")
        end for
        printf(1,"\n")
    end for
end procedure
main()


init_palindrome(Digit, p(10, Next, 0)):-
    Next is Digit * 10 - 1.

next_palindrome(Digit, p(Power, Next, Even), p(Power1, Next2, Even1), Palindrome):-
    Next1 is Next + 1,
    (Next1 is Power * (Digit + 1) ->
        (Even == 1 -> Power1 is Power * 10 ; Power1 = Power),
        Next2 is Digit * Power1,
        Even1 is 1 - Even
        ;
        Power1 = Power,
        Next2 = Next1,
        Even1 = Even
    ),
    (Even1 == 1 ->
        X is 10 * Power1, Y = Next2
        ;
        X = Power1, Y is Next2 // 10
    ),
    reverse_number(Y, Z),
    Palindrome is Next2 * X + Z.

reverse_number(N, R):-
    reverse_number(N, 0, R).

reverse_number(0, Result, Result):-
    !.
reverse_number(N, R, Result):-
    R1 is R * 10 + N mod 10,
    N1 is N // 10,
    reverse_number(N1, R1, Result).

is_gapful(N):-
    is_gapful(N, N).

is_gapful(N, M):-
    M < 10,
    !,
    0 is N mod (N mod 10 + 10 * (M mod 10)).
is_gapful(N, M):-
    M1 is M // 10,
    is_gapful(N, M1).

find_palindromic_gapful_numbers(N, List):-
    find_palindromic_gapful_numbers(N, 1, List).

find_palindromic_gapful_numbers(_, 10, []):-
    !.
find_palindromic_gapful_numbers(N, Digit, [Numbers|Rest]):-
    find_palindromic_gapful_numbers1(Digit, N, Numbers),
    Next_digit is Digit + 1,
    find_palindromic_gapful_numbers(N, Next_digit, Rest).

find_palindromic_gapful_numbers1(Digit, N, List):-
    init_palindrome(Digit, P),
    find_palindromic_gapful_numbers1(Digit, P, N, 0, List).

find_palindromic_gapful_numbers1(_, _, N, N, []):-
    !.
find_palindromic_gapful_numbers1(Digit, P, N, Count, List):-
    next_palindrome(Digit, P, P_next, Palindrome),
    (is_gapful(Palindrome) ->
        Count1 is Count + 1,
        List = [Palindrome|Rest]
        ;
        Count1 = Count,
        List = Rest
    ),
    find_palindromic_gapful_numbers1(Digit, P_next, N, Count1, Rest).

print_numbers(First, Last, Numbers):-
    (First == 1 ->
        writef("First %w palindromic gapful numbers ending in:\n", [Last])
        ;
        Count is Last - First + 1,
        writef("Last %w of first %w palindromic gapful numbers ending in:\n", [Count, Last])
    ),
    print_numbers(First, Last, 1, Numbers),
    nl.

print_numbers(_, _, 10, _):-
    !.
print_numbers(First, Last, Digit, [N|Numbers]):-
    writef("%w:", [Digit]),
    print_numbers1(First, Last, 1, N),
    Next_digit is Digit + 1,
    print_numbers(First, Last, Next_digit, Numbers).

print_numbers1(_, Last, I, _):-
    I > Last,
    nl,
    !.
print_numbers1(First, Last, I, [_|Numbers]):-
    I < First,
    !,
    J is I + 1,
    print_numbers1(First, Last, J, Numbers).
print_numbers1(First, Last, I, [N|Numbers]):-
    writef(" %w", [N]),
    J is I + 1,
    print_numbers1(First, Last, J, Numbers).

main:-
    find_palindromic_gapful_numbers(1000, Numbers),
    print_numbers(1, 20, Numbers),
    print_numbers(86, 100, Numbers),
    print_numbers(991, 1000, Numbers).


from itertools import count
from pprint import pformat
import re
import heapq

def pal_part_gen(odd=True):
    for i in count(1):
        fwd = str(i)
        rev = fwd[::-1][1:] if odd else fwd[::-1]
        yield int(fwd + rev)

def pal_ordered_gen():
    yield from heapq.merge(pal_part_gen(odd=True), pal_part_gen(odd=False))

def is_gapful(x):
    return (x % (int(str(x)[0]) * 10 + (x % 10)) == 0)

if __name__ == '__main__':
    start = 100
    for mx, last in [(20, 20), (100, 15), (1_000, 10)]:
        print(f"\nLast {last} of the first {mx} binned-by-last digit "
              f"gapful numbers >= {start}")
        bin = {i: [] for i in range(1, 10)}
        gen = (i for i in pal_ordered_gen() if i >= start and is_gapful(i))
        while any(len(val) < mx for val in bin.values()):
            g = next(gen)
            val = bin[g % 10]
            if len(val) < mx:
                val.append(g)
        b = {k:v[-last:] for k, v in bin.items()}
        txt = pformat(b, width=220)
        print('', re.sub(r"[{},\[\]]", '', txt))


constant @digits = '0','1','2','3','4','5','6','7','8','9';

# Infinite lazy iterator to generate palindromic "gap" numbers
my @npal = flat [ @digits ], [ '00','11','22','33','44','55','66','77','88','99' ],
  {
    sink @^previous, @^penultimate;
    [ flat @digits.map: -> \digit { @penultimate.map: digit ~ * ~ digit  } ]
  } … *;

# Individual lazy palindromic gapful number iterators for each start/end digit
my @gappal = (1..9).map: -> \digit {
    my \divisor = digit + 10 * digit;
    @npal.map: -> \this { next unless (my \test = digit ~ this ~ digit) %% divisor; test }
}

# Display
( "(Required) First 20 gapful palindromes:",              ^20, 7
  ,"\n(Required) 86th through 100th:",                 85..99, 8
  ,"\n(Optional) 991st through 1,000th:",            990..999, 10
  ,"\n(Extra stretchy) 9,995th through 10,000th:", 9994..9999, 12
  ,"\n(Meh) 100,000th:",                                99999, 14
).hyper(:1batch).map: -> $caption, $range, $fmt {
    my $now = now;
    say $caption;
    put "$_: " ~ @gappal[$_-1][|$range].fmt("%{$fmt}s") for 1..9;
    say round( now - $now, .001 ), " seconds";
}


/*REXX program computes and displays palindromic gapful numbers, it also can show those */
/*─────────────────────── palindromic gapful numbers listed by their last decimal digit.*/
numeric digits 20                                /*ensure enough decimal digits gapfuls.*/
parse arg palGaps                                /*obtain optional arguments from the CL*/
if palGaps=''  then palGaps= 20 100@@15 1000@@10 /*Not specified?  Then use the defaults*/

        do until palGaps='';      parse var palGaps  stuff palGaps;      call palGap stuff
        end   /*until*/
exit 0                                           /*stick a fork in it,  we're all done. */
/*──────────────────────────────────────────────────────────────────────────────────────*/
palGap: procedure; parse arg n '@' sp "@" z;    #= 0;    if sp==''  then sp= 100
        @ending= '  (ending in a specific digit) ';      if  z==''  then  z=   n
        @which= ' last ';                                if  z==n   then @which= " first "
        @palGap#Start= ' palindromic gapful numbers starting at: '
        say center(@which   z    ' of '     n   @palGap#Start   sp" "   @ending, 140, "═")
        #.= 0                                    /*array of result counts for each digit*/
        newSP= max(110, sp%11*11)                /*calculate the new starting point.    */
        tot= n * 9                               /*total # of results that are wanted.  */
        $.=;                           sum= 0    /*blank lists;  digit results (so far).*/
              do j=newSP  by 11  until sum==tot  /*loop 'til all digit counters filled. */
              if reverse(j)  \==j  then iterate  /*Not a palindrome?       Then skip it.*/
              parse var   j   a  2  ''  -1  b    /*obtain the first and last dec. digit.*/
              if #.b          ==n  then iterate  /*Digit quota filled?     Then skip it.*/
              if j // (a||b) \==0  then iterate  /*Not divisible by A||B?    "    "   " */
              sum= sum + 1;        #.b= #.b + 1  /*bump the sum counter & digit counter.*/
              $.b= $.b  j                        /*append   J   to the correct list.    */
              end   /*j*/
                                                 /* [↓]  just show the last  Z  numbers.*/
              do k=1  for 9;   say  k':'   strip( subword($.k, 1 + n - z) )
              end   /*k*/;     say
        return


load "stdlib.ring"

see "First 20 palindromic gapful numbers > 100 ending with each digit from 1 to 9:" + nl

limit = 9606069

for n = 1 to 9
    sum = 0
    for x = 101 to limit
        flag = 0
        strx = string(x)
        xbegin = left(strx,1)
        xend = right(strx,1)
        xnew = number(xbegin+xend)
        for y = 2 to ceil(x/2)+1
            if ispalindrome(strx)
               if y != xnew and x % y != 0
                  if x % xnew = 0 and number(xend) = n
                     flag = 1
                  else
                     flag = 0
                     exit
                  ok
               ok
            ok
        next
        if flag = 1
           sum = sum + 1
           if sum < 21
              see "x = " + x + nl
           else
              exit
           ok
        ok
    next
    see nl
next

see "done..." + nl


def palindromesgapful(digit, pow)
  r1 = digit * (10**pow + 1)
  r2 = 10**pow * (digit + 1)
  nn = digit * 11
  (r1...r2).select { |i| n = i.to_s; n == n.reverse && i % nn == 0 }
end

def digitscount(digit, count)
  pow  = 2
  nums = []
  while nums.size < count
    nums += palindromesgapful(digit, pow)
    pow += 1
  end
  nums[0...count]
end

count = 20
puts "First 20 palindromic gapful numbers ending with:"
(1..9).each { |digit| print "#{digit} : #{digitscount(digit, count)}\n" }

count = 100
puts "\nLast 15 of first 100 palindromic gapful numbers ending in:"
(1..9).each { |digit| print "#{digit} : #{digitscount(digit, count).last(15)}\n" }

count = 1000
puts "\nLast 10 of first 1000 palindromic gapful numbers ending in:"
(1..9).each { |digit| print "#{digit} : #{digitscount(digit, count).last(10)}\n" }


This version uses number->string then string->number conversions to create palindromes.


class PalindromeGenerator (digit, base=10) {

    has power = base
    has after = (digit*power - 1)
    has even  = false

    method next {

        if (++after == power*(digit+1)) {
            power *= base if even
            after = digit*power
            even.not!
        }

        even ? (after*power*base + reverse(after, base))
             : (after*power + reverse(after/base, base))
    }
}

var task = [
    "(Required) First 20 gapful palindromes:",       { .first(20) }, 7,
    ,"\n(Required) 86th through 100th:",             { .first(1e2).last(15) }, 8,
    ,"\n(Optional) 991st through 1,000th:",          { .first(1e3).last(10) }, 10,
    ,"\n(Extra stretchy) 9,995th through 10,000th:", { .first(1e4).last(6) }, 12,
]

task.each_slice(3, {|title, f, w|
    say title
    for d in (1..9) {
        var k    = 11*d
        var iter = PalindromeGenerator(d)
        var arr  = f(^Inf->lazy.map { iter.next }.grep {|n| k `divides` n })
        say ("#{d}: ", arr.map{ "%*s" % (w, _) }.join(' '))
    }
})


import "/fmt" for Conv, Fmt

var reverse = Fn.new { |s|
    var e = 0
    while (s > 0) {
        e = e * 10 + (s % 10)
        s = (s/10).floor
    }
    return e
}

var MAX = 100000
var data = [ [1, 20, 7], [86, 100, 8], [991, 1000, 10], [9995, 10000, 12], [99996, 100000, 14] ]
var results = {}
for (d in data) {
    for (i in d[0]..d[1]) results[i] = List.filled(9, 0)
}
var p
for (d in 1..9) {
    var next_d = false
    var count = 0
    var pow = 1
    var fl = d * 11
    for (nd in 3..19) {
        var slim = (d + 1) * pow
        for (s in d*pow...slim) {
            var e = reverse.call(s)
            var mlim = (nd%2 != 1) ? 1 : 10
            for (m in 0...mlim) {
                if (nd%2 == 0) {
                    p = s*pow*10 + e
                } else {
                    p = s*pow*100 + m*pow*10 + e
                }
                if (p%fl == 0) {
                    count = count + 1
                    var rc = results[count]
                    if (rc != null) rc[d-1] = p
                    if (count == MAX) next_d = true
                }
                if (next_d) break
            }
            if (next_d) break
        }
        if (next_d) break
        if (nd%2 == 1) pow = pow * 10
    }
}

for (d in data) {
    var s1 = Fmt.ordinalize(d[0])
    var s2 = Fmt.ordinalize(d[1])
    System.print("%(s1) to %(s2) palindromic gapful numbers (> 100) ending with:")
    for (i in 1..9) {
        System.write("%(i): ")
        for (j in d[0]..d[1]) System.write("%(Fmt.d(d[2], results[j][i-1])) ")
        System.print()
    }
    System.print()
}


// 10,True  --> 101,111,121,131,141,151,161,171,181,191,202, ..
// 10,False --> 1001,1111,1221,1331,1441,1551,1661,1771,1881,..
fcn createPalindromeW(start,oddLength){	//--> iterator
   [start..].tweak('wrap(z){
      p,n := z,z;
      if(oddLength) n/=10;
      while(n>0){ p,n = p*10 + (n%10), n/10; }
      p
   })
}
fcn palindromicGapfulW(endsWith){	//--> iterator
   po,pe := createPalindromeW(10,True), createPalindromeW(10,False);
   div:=endsWith*10 + endsWith;
   Walker.zero().tweak('wrap{
      p:=( if(pe.peek()<po.peek()) pe.next() else po.next() );
      if(p%10==endsWith and (p%div)==0) p else Void.Skip
   })
}


' ***********************************************
'subject: convert two rationals to p-adic numbers,
'         add them up and show the result.
'tested : FreeBasic 1.07.0

'you can change this:

const emx = 64
'exponent maximum

const dmx = 100000
'approximation loop maximum

'better not change
'------------------------------------------------
const amx = 1048576
'argument maximum

const Pmax = 32749
'max. prime < 2^15

type ratio
   as longint a, b
end type

type padic
declare function r2pa (byref q as ratio, byval sw as integer) as integer
'convert q = a/b to p-adic number, set sw to print
declare sub printf (byval sw as integer)
'print expansion, set sw to print rational
declare sub crat ()
'rational reconstruction

declare sub add (byref a as padic, byref b as padic)
'let self:= a + b
declare sub cmpt (byref a as padic)
'let self:= complement_a

declare function dsum () as long
'weighted digit sum

   as long d(-emx to emx - 1)
   as integer v
end type

'global variables
dim shared as long p1, p = 7
'default prime
dim shared as integer k = 11
'precision

#define min(a, b) iif((a) > (b), b, a)

'------------------------------------------------
'convert rational a/b to p-adic number
function padic.r2pa (byref q as ratio, byval sw as integer) as integer
dim as longint a = q.a, b = q.b
dim as long r, s, b1
dim i as integer
r2pa = 0

   if b = 0 then return 1
   if b < 0 then b = -b: a = -a
   if abs(a) > amx or b > amx then return -1
   if p < 2 or k < 1 then return 1

   'max. short prime
   p = min(p, Pmax)
   'max. array length
   k = min(k, emx - 1)

   if sw then
      'echo numerator, denominator,
      print a;"/";str(b);" + ";
      'prime and precision
      print "O(";str(p);"^";str(k);")"
   end if

   'initialize
   v = 0
   p1 = p - 1
   for i = -emx to emx - 1
      d(i) = 0: next

   if a = 0 then return 0

   i = 0
   'find -exponent of p in b
   do until b mod p
      b \= p: i -= 1
   loop

   s = 0
   r = b mod p
   'modular inverse for small p
   for b1 = 1 to p1
      s += r
      if s > p1 then s -= p
      if s = 1 then exit for
   next b1

   if b1 = p then
      print "r2pa: impossible inverse mod"
      return -1
   end if

   v = emx
   do
      'find exponent of p in a
      do until a mod p
         a \= p: i += 1
      loop

      'valuation
      if v = emx then v = i

      'upper bound
      if i >= emx then exit do
      'check precision
      if (i - v) > k then exit do

      'next digit
      d(i) = a * b1 mod p
      if d(i) < 0 then d(i) += p

      'remainder - digit * divisor
      a -= d(i) * b
   loop while a
end function

'------------------------------------------------
'Horner's rule
function padic.dsum () as long
dim as integer i, t = min(v, 0)
dim as long r, s = 0

   for i = k - 1 + t to t step -1
      r = s: s *= p
      if r andalso s \ r - p then
        'overflow
         s = -1: exit for
      end if
      s += d(i)
   next i

return s
end function

#macro pint(cp)
   for j = k - 1 + v to v step -1
      if cp then exit for
   next j
   fl = ((j - v) shl 1) < k
#endmacro

'rational reconstruction
sub padic.crat ()
dim as integer i, j, fl
dim as padic s = this
dim as long x, y

   'denominator count
   for i = 1 to dmx
      'check for integer
      pint(s.d(j))
      if fl then fl = 0: exit for

      'check negative integer
      pint(p1 - s.d(j))
      if fl then exit for

      'repeatedly add self to s
      s.add(s, this)
   next i

   if fl then s.cmpt(s)

   'numerator: weighted digit sum
   x = s.dsum: y = i

   if x < 0 or y > dmx then
      print "crat: fail"

   else
      'negative powers
      for i = v to -1
         y *= p: next

      'negative rational
      if fl then x = -x

      print x;
      if y > 1 then print "/";str(y);
      print
   end if
end sub

'print expansion
sub padic.printf (byval sw as integer)
dim as integer i, t = min(v, 0)

   for i = k - 1 + t to t step -1
      print d(i);
      if i = 0 andalso v < 0 then print ".";
   next i
   print

   'rational approximation
   if sw then crat
end sub

'------------------------------------------------
'carry
#macro cstep(dt)
   if c > p1 then
      dt = c - p: c = 1
   else
      dt = c: c = 0
   end if
#endmacro

'let self:= a + b
sub padic.add (byref a as padic, byref b as padic)
dim i as integer, r as padic
dim as long c = 0
with r
  .v = min(a.v, b.v)

   for i = .v to k +.v
      c += a.d(i) + b.d(i)
      cstep(.d(i))
   next i
end with
this = r
end sub

'let self:= complement_a
sub padic.cmpt (byref a as padic)
dim i as integer, r as padic
dim as long c = 1
with r
  .v = a.v

   for i = .v to k +.v
      c += p1 - a.d(i)
      cstep(.d(i))
   next i
end with
this = r
end sub

'main
'------------------------------------------------
dim as integer sw
dim as padic a, b, c
dim q as ratio

width 64, 30
cls

'rational reconstruction
'depends on the precision -
'until the dsum-loop overflows.
data 2,1, 2,4
data 1,1

data 4,1, 2,4
data 3,1

data 4,1, 2,5
data 3,1

' 4/9 + O(5^4)
data 4,9, 5,4
data 8,9

data 26,25, 5,4
data -109,125

data 49,2, 7,6
data -4851,2

data -9,5, 3,8
data 27,7

data 5,19, 2,12
data -101,384

'two 'decadic' pairs
data 2,7, 10,7
data -1,7

data 34,21, 10,9
data -39034,791

'familiar digits
data 11,4, 2,43
data 679001,207

data -8,9, 23,9
data 302113,92

data -22,7, 3,23
data 46071,379

data -22,7, 32749,3
data 46071,379

data 35,61, 5,20
data 9400,109

data -101,109, 61,7
data 583376,6649

data -25,26, 7,13
data 5571,137

data 1,4, 7,11
data 9263,2837

data 122,407, 7,11
data -517,1477

'more subtle
data 5,8, 7,11
data 353,30809

data 0,0, 0,0

print
do
   read q.a,q.b, p,k

   sw = a.r2pa(q, 1)
   if sw = 1 then exit do
   a.printf(0)

   read q.a,q.b

   sw or= b.r2pa(q, 1)
   if sw = 1 then exit do
   if sw then continue do
   b.printf(0)

   c.add(a, b)
   print "+ ="
   c.printf(1)

   print : ?
loop

system


package main

import "fmt"

// constants
const EMX = 64      // exponent maximum (if indexing starts at -EMX)
const DMX = 100000  // approximation loop maximum
const AMX = 1048576 // argument maximum
const PMAX = 32749  // prime maximum

// global variables
var p1 = 0
var p = 7  // default prime
var k = 11 // precision

func abs(a int) int {
    if a >= 0 {
        return a
    }
    return -a
}

func min(a, b int) int {
    if a < b {
        return a
    }
    return b
}

type Ratio struct {
    a, b int
}

type Padic struct {
    v int
    d [2 * EMX]int // add EMX to index to be consistent wih FB
}

// (re)initialize receiver from Ratio, set 'sw' to print
func (pa *Padic) r2pa(q Ratio, sw int) int {
    a := q.a
    b := q.b
    if b == 0 {
        return 1
    }
    if b < 0 {
        b = -b
        a = -a
    }
    if abs(a) > AMX || b > AMX {
        return -1
    }
    if p < 2 || k < 1 {
        return 1
    }
    p = min(p, PMAX)  // maximum short prime
    k = min(k, EMX-1) // maxumum array length
    if sw != 0 {
        fmt.Printf("%d/%d + ", a, b)   // numerator, denominator
        fmt.Printf("0(%d^%d)\n", p, k) // prime, precision
    }

    // (re)initialize
    pa.v = 0
    p1 = p - 1
    pa.d = [2 * EMX]int{}
    if a == 0 {
        return 0
    }
    i := 0

    // find -exponent of p in b
    for b%p == 0 {
        b = b / p
        i--
    }
    s := 0
    r := b % p

    // modular inverse for small p
    b1 := 1
    for b1 <= p1 {
        s += r
        if s > p1 {
            s -= p
        }
        if s == 1 {
            break
        }
        b1++
    }
    if b1 == p {
        fmt.Println("r2pa: impossible inverse mod")
        return -1
    }
    pa.v = EMX
    for {
        // find exponent of P in a
        for a%p == 0 {
            a = a / p
            i++
        }

        // valuation
        if pa.v == EMX {
            pa.v = i
        }

        // upper bound
        if i >= EMX {
            break
        }

        // check precision
        if (i - pa.v) > k {
            break
        }

        // next digit
        pa.d[i+EMX] = a * b1 % p
        if pa.d[i+EMX] < 0 {
            pa.d[i+EMX] += p
        }

        // remainder - digit * divisor
        a -= pa.d[i+EMX] * b
        if a == 0 {
            break
        }
    }
    return 0
}

// Horner's rule
func (pa *Padic) dsum() int {
    t := min(pa.v, 0)
    s := 0
    for i := k - 1 + t; i >= t; i-- {
        r := s
        s *= p
        if r != 0 && (s/r-p != 0) {
            // overflow
            s = -1
            break
        }
        s += pa.d[i+EMX]
    }
    return s
}

// add b to receiver
func (pa *Padic) add(b Padic) *Padic {
    c := 0
    r := Padic{}
    r.v = min(pa.v, b.v)
    for i := r.v; i <= k+r.v; i++ {
        c += pa.d[i+EMX] + b.d[i+EMX]
        if c > p1 {
            r.d[i+EMX] = c - p
            c = 1
        } else {
            r.d[i+EMX] = c
            c = 0
        }
    }
    return &r
}

// complement of receiver
func (pa *Padic) cmpt() *Padic {
    c := 1
    r := Padic{}
    r.v = pa.v
    for i := pa.v; i <= k+pa.v; i++ {
        c += p1 - pa.d[i+EMX]
        if c > p1 {
            r.d[i+EMX] = c - p
            c = 1
        } else {
            r.d[i+EMX] = c
            c = 0
        }
    }
    return &r
}

// rational reconstruction
func (pa *Padic) crat() {
    fl := false
    s := pa
    j := 0
    i := 1

    // denominator count
    for i <= DMX {
        // check for integer
        j = k - 1 + pa.v
        for j >= pa.v {
            if s.d[j+EMX] != 0 {
                break
            }
            j--
        }
        fl = ((j - pa.v) * 2) < k
        if fl {
            fl = false
            break
        }

        // check negative integer
        j = k - 1 + pa.v
        for j >= pa.v {
            if p1-s.d[j+EMX] != 0 {
                break
            }
            j--
        }
        fl = ((j - pa.v) * 2) < k
        if fl {
            break
        }

        // repeatedly add self to s
        s = s.add(*pa)
        i++
    }
    if fl {
        s = s.cmpt()
    }

    // numerator: weighted digit sum
    x := s.dsum()
    y := i
    if x < 0 || y > DMX {
        fmt.Println(x, y)
        fmt.Println("crat: fail")
    } else {
        // negative powers
        i = pa.v
        for i <= -1 {
            y *= p
            i++
        }

        // negative rational
        if fl {
            x = -x
        }
        fmt.Print(x)
        if y > 1 {
            fmt.Printf("/%d", y)
        }
        fmt.Println()
    }
}

// print expansion
func (pa *Padic) printf(sw int) {
    t := min(pa.v, 0)
    for i := k - 1 + t; i >= t; i-- {
        fmt.Print(pa.d[i+EMX])
        if i == 0 && pa.v < 0 {
            fmt.Print(".")
        }
        fmt.Print(" ")
    }
    fmt.Println()
    // rational approximation
    if sw != 0 {
        pa.crat()
    }
}

func main() {
    data := [][]int{
        /* rational reconstruction depends on the precision
           until the dsum-loop overflows */
        {2, 1, 2, 4, 1, 1},
        {4, 1, 2, 4, 3, 1},
        {4, 1, 2, 5, 3, 1},
        {4, 9, 5, 4, 8, 9},
        {26, 25, 5, 4, -109, 125},
        {49, 2, 7, 6, -4851, 2},
        {-9, 5, 3, 8, 27, 7},
        {5, 19, 2, 12, -101, 384},
        /* two decadic pairs */
        {2, 7, 10, 7, -1, 7},
        {34, 21, 10, 9, -39034, 791},
        /* familiar digits */
        {11, 4, 2, 43, 679001, 207},
        {-8, 9, 23, 9, 302113, 92},
        {-22, 7, 3, 23, 46071, 379},
        {-22, 7, 32749, 3, 46071, 379},
        {35, 61, 5, 20, 9400, 109},
        {-101, 109, 61, 7, 583376, 6649},
        {-25, 26, 7, 13, 5571, 137},
        {1, 4, 7, 11, 9263, 2837},
        {122, 407, 7, 11, -517, 1477},
        /* more subtle */
        {5, 8, 7, 11, 353, 30809},
    }

    sw := 0
    a := Padic{}
    b := Padic{}

    for _, d := range data {
        q := Ratio{d[0], d[1]}
        p = d[2]
        k = d[3]
        sw = a.r2pa(q, 1)
        if sw == 1 {
            break
        }
        a.printf(0)
        q.a = d[4]
        q.b = d[5]
        sw = sw | b.r2pa(q, 1)
        if sw == 1 {
            break
        }
        if sw == 0 {
            b.printf(0)
            c := a.add(b)
            fmt.Println("+ =")
            c.printf(1)
        }
        fmt.Println()
    }
}


{-# LANGUAGE KindSignatures, DataKinds  #-}
module Padic where

import Data.Ratio
import Data.List (genericLength)
import GHC.TypeLits

data Padic (n :: Nat) = Null
                      | Padic { unit :: [Int], order :: Int }

-- valuation of the base
modulo :: (KnownNat p, Integral i) => Padic p -> i
modulo = fromIntegral . natVal

-- Constructor for zero value
pZero :: KnownNat p => Padic p
pZero = Padic (repeat 0) 0

-- Smart constructor, adjusts trailing zeros with the order.
mkPadic :: (KnownNat p, Integral i) => [i] -> Int -> Padic p
mkPadic u k = go 0 (fromIntegral <$> u)
  where
    go 17 _ = pZero
    go i (0:u) = go (i+1) u
    go i u = Padic u (k-i)

-- Constructor for p-adic unit
mkUnit :: (KnownNat p, Integral i) => [i] -> Padic p
mkUnit u = mkPadic u 0

-- Zero test (up to 1/p^17)
isZero :: KnownNat p => Padic p -> Bool
isZero (Padic u _) = all (== 0) (take 17 u)
isZero _ = False

-- p-adic norm
pNorm :: KnownNat p => Padic p -> Ratio Int
pNorm Null = undefined
pNorm p = fromIntegral (modulo p) ^^ (- order p)

-- test for an integerness up to p^-17
isInteger :: KnownNat p => Padic p -> Bool
isInteger Null = False
isInteger (Padic s k) = case splitAt k s of
  ([],i) -> length (takeWhile (==0) $ reverse (take 20 i)) > 3
  _ -> False

-- p-adics are shown with 1/p^17 precision
instance KnownNat p => Show (Padic p) where
  show Null = "Null"
  show x@(Padic u k) =
    show (modulo x) ++ "-adic: " ++
    (case si of {[] -> "0"; _ -> si})
    ++ "." ++
    (case f of {[] -> "0"; _ -> sf})
    where
      (f,i) = case compare k 0 of
        LT -> ([], replicate (-k) 0 ++ u)
        EQ -> ([], u)
        GT -> splitAt k (u ++ repeat 0)
      sf = foldMap showD $ reverse $ take 17 f
      si = foldMap showD $ dropWhile (== 0) $ reverse $ take 17 i
      el s = if length s > 16 then "…" else ""
      showD n = [(['0'..'9']++['a'..'z']) !! n]

instance KnownNat p => Eq (Padic p) where
  a == b = isZero (a - b)

instance KnownNat p => Ord (Padic p) where
  compare = error "Ordering is undefined fo p-adics."

instance KnownNat p => Num (Padic p) where
  fromInteger 0 = pZero
  fromInteger n = pAdic (fromInteger n)

  x@(Padic a ka) + Padic b kb = mkPadic s k
    where
      k = ka `max` kb
      s = addMod (modulo x)
          (replicate (k-ka) 0 ++ a)
          (replicate (k-kb) 0 ++ b)
  _ + _ = Null

  x@(Padic a ka) * Padic b kb =
    mkPadic (mulMod (modulo x) a b) (ka + kb)
  _ * _ = Null

  negate x@(Padic u k) =
    case map (\y -> modulo x - 1 - y) u of
      n:ns -> Padic ((n+1):ns) k
      [] -> pZero
  negate _ = Null

  abs p = pAdic (pNorm p)

  signum = undefined

------------------------------------------------------------
-- conversion from rationals to p-adics

instance KnownNat p => Fractional (Padic p) where
  fromRational = pAdic

  recip Null = Null
  recip x@(Padic (u:us) k)
    | isZero x = Null
    | gcd p u /= 1 = Null
    | otherwise = mkPadic res (-k)
    where
      p = modulo x
      res = longDivMod p (1:repeat 0) (u:us)

pAdic :: (Show i, Integral i, KnownNat p)
      => Ratio i -> Padic p
pAdic 0 = pZero
pAdic x = res
  where
    p = modulo res
    (k, q) = getUnit p x
    (n, d) = (numerator q, denominator q)
    res = maybe Null process $ recipMod p d

    process r = mkPadic (series n) k
      where
        series n
          | n == 0 = repeat 0
          | n `mod` p == 0 = 0 : series (n `div` p)
          | otherwise =
              let m = (n * r) `mod` p
              in m : series ((n - m * d) `div` p)

------------------------------------------------------------
-- conversion from p-adics to rationals
-- works for relatively small denominators

instance KnownNat p => Real (Padic p) where
  toRational Null = error "no rational representation!"
  toRational x@(Padic s k) = res
    where
      p = modulo x
      res = case break isInteger $ take 10000 $ iterate (x +) x of
        (_,[]) -> - toRational (- x)
        (d, i:_) -> (fromBase p (unit i) * (p^(- order i))) % (genericLength d + 1)

      fromBase p = foldr (\x r -> r*p + x) 0 .
                   take 20 . map fromIntegral

--------------------------------------------------------------------------------
-- helper functions

-- extracts p-adic unit from a rational number
getUnit :: Integral i => i -> Ratio i -> (Int, Ratio i)
getUnit p x = (genericLength k1 - genericLength k2, c)
  where
    (k1,b:_) = span (\n -> denominator n `mod` p == 0) $
               iterate (* fromIntegral p) x
    (k2,c:_) = span (\n -> numerator n `mod` p == 0) $
               iterate (/ fromIntegral p) b

-- Reciprocal of a number modulo p (extended Euclidean algorithm).
-- For non-prime p returns Nothing non-invertible element of the ring.
recipMod :: Integral i => i -> i -> Maybe i
recipMod p 1 = Just 1
recipMod p a | gcd p a == 1 = Just $ go 0 1 p a
             | otherwise = Nothing
  where
    go t _ _ 0 = t `mod` p
    go t nt r nr =
      let q = r `div` nr
      in go nt (t - q*nt) nr (r - q*nr)

-- Addition of two sequences modulo p
addMod p = go 0
  where
    go 0 [] ys = ys
    go 0 xs [] = xs
    go s [] ys = go 0 [s] ys
    go s xs [] = go 0 xs [s]
    go s (x:xs) (y:ys) =
      let (q, r) = (x + y + s) `divMod` p
      in r : go q xs ys

-- Subtraction of two sequences modulo p
subMod p a (b:bs) = addMod p a $ (p-b) : ((p - 1 -) <$> bs)

-- Multiplication of two sequences modulo p
mulMod p as [b] = mulMod p [b] as
mulMod p as bs = case as of
  [0] -> repeat 0
  [1] -> bs
  [a] -> go 0 bs
    where
      go s [] = [s]
      go s (b:bs) =
        let (q, r) = (a * b + s) `divMod` p
        in r : go q bs
  as -> go bs
    where
      go [] = []
      go (b:bs) =
        let c:cs = mulMod p [b] as
        in c : addMod p (go bs) cs

-- Division of two sequences modulo p
longDivMod p a (b:bs) = case recipMod p b of
  Nothing -> error $
    show b ++ " is not invertible modulo " ++ show p
  Just r -> go a
    where
      go [] = []
      go (0:xs) = 0 : go xs
      go (x:xs) =
        let m = (x*r) `mod` p
            _:zs = subMod p (x:xs) (mulMod p [m] (b:bs))
        in m : go zs


using Nemo, LinearAlgebra

set_printing_mode(FlintPadicField, :terse)

""" convert to Rational (rational reconstruction) """
function toRational(pa::padic)
    rat = lift(QQ, pa)
    r, den = BigInt(numerator(rat)), Int(denominator(rat))
    p, k = Int(prime(parent(pa))), Int(precision(pa))
    N = BigInt(p^k)
    a1, a2 = [N, 0], [r, 1]
    while dot(a1, a1) > dot(a2, a2)
        q = dot(a1, a2) // dot(a2, a2)
        a1, a2 = a2, a1 - BigInt(round(q)) * a2
    end
    if dot(a1, a1) < N
        return (Rational{Int}(a1[1]) // Rational{Int}(a1[2])) // Int(den)
    else
        return Int(r) // den
    end
end

function dstring(pa::padic)
    u, v, n, p, k = pa.u, pa.v, pa.N, pa.parent.p, pa.parent.prec_max
    d = digits(v > 0 ? u * p^v : u, base=pa.parent.p, pad=k)
    return prod([i == k + v && v != 0 ? "$x . " : "$x " for (i, x) in enumerate(reverse(d))])
end

const DATA = [
    [2, 1, 2, 4, 1, 1],
    [4, 1, 2, 4, 3, 1],
    [4, 1, 2, 5, 3, 1],
    [4, 9, 5, 4, 8, 9],
    [26, 25, 5, 4, -109, 125],
    [49, 2, 7, 6, -4851, 2],
    [-9, 5, 3, 8, 27, 7],
    [5, 19, 2, 12, -101, 384],

    # Base 10 10-adic p-adics are not allowed by Nemo library -- p must be a prime

    # familiar digits
    [11, 4, 2, 43, 679001, 207],
    [-8, 9, 23, 9, 302113, 92],
    [-22, 7, 3, 23, 46071, 379],
    [-22, 7, 32749, 3, 46071, 379],
    [35, 61, 5, 20, 9400, 109],
    [-101, 109, 61, 7, 583376, 6649],
    [-25, 26, 7, 13, 5571, 137],
    [1, 4, 7, 11, 9263, 2837],
    [122, 407, 7, 11, -517, 1477],
    # more subtle
    [5, 8, 7, 11, 353, 30809],
]

for (num1, den1, P, K, num2, den2) in DATA
    Qp = PadicField(P, K)
    a = Qp(QQ(num1 // den1))
    b = Qp(QQ(num2 // den2))
    c = a + b
    r = toRational(c)
    println(a, "\n", dstring(a), "\n", b, "\n", dstring(b), "\n+ =\n", c, "\n", dstring(c), "   $r\n")
end


import math, strformat

const
  Emx = 64        # Exponent maximum.
  Dmx = 100000    # Approximation loop maximum.
  Amx = 1048576   # Argument maximum.
  PMax = 32749    # Prime maximum.

type

  Ratio = tuple[a, b: int]

  Padic = object
    p: int                        # Prime.
    k: int                        # Precision.
    v: int
    d: array[-Emx..(Emx-1), int]

  PadicError = object of ValueError

proc r2pa(pa: var Padic; q: Ratio; sw: bool) =
  ## Convert "q" to p-adic number, set "sw" to print.

  var (a, b) = q

  if b == 0:
    raise newException(PadicError, &"Wrong rational: {a}/{b}" )
  if b < 0:
    b = -b
    a = -a
  if abs(a) > Amx or b > Amx:
    raise newException(PadicError, &"Rational exceeding limits: {a}/{b}")
  if pa.p  < 2:
    raise newException(PadicError, &"Wrong value for p: {pa.p}")
  if pa.k < 1:
    raise newException(PadicError, &"Wrong value for k: {pa.k}")
  pa.p = min(pa.p, PMax)      # Maximum short prime.
  pa.k = min(pa.k, Emx - 1)   # Maximum array length.

  if sw: echo &"{a}/{b} + 0({pa.p}^{pa.k})"

  # Initialize.
  pa.v = 0
  pa.d.reset()
  if a == 0: return
  var i = 0

  # Find -exponent of "p" in "b".
  while b mod pa.p == 0:
    b = b div pa.p
    dec i

  var s = 0
  var r = b mod pa.p

  # Modular inverse for small "p".
  var b1 = 1
  while b1 < pa.p:
    inc s, r
    if s >= pa.p: dec s, pa.p
    if s == 1: break
    inc b1
  if b1 == pa.p:
    raise newException(PadicError, "Impossible to compute inverse modulo")
  pa.v = Emx
  while true:
    # Find exponent of "p" in "a".
    while a mod pa.p == 0:
      a = a div pa.p
      inc i
    # Valuation.
    if pa.v == Emx: pa.v = i
    # Upper bound.
    if i >= Emx: break
    # Check precision.
    if i - pa.v > pa.k: break
    # Next digit.
    pa.d[i] = floorMod(a * b1, pa.p)
    # Remainder - digit * divisor.
    dec a, pa.d[i] * b
    if a == 0: break

func dsum(pa: Padic): int =
  ## Horner's rule.
  let t = min(pa.v, 0)
  for i in countdown(pa.k - 1 + t, t):
    var r = result
    result *= pa.p
    if r != 0 and (result div r - pa.p) != 0:
      return -1    # Overflow.
    inc result, pa.d[i]

func `+`(pa, pb: Padic): Padic =
  ## Add two p-adic numbers.
  assert pa.p == pb.p and pa.k == pb.k
  result.p = pa.p
  result.k = pa.k
  var c = 0
  result.v = min(pa.v, pb.v)
  for i in result.v..(pa.k + result.v):
    inc c, pa.d[i] + pb.d[i]
    if c >= pa.p:
      result.d[i] = c - pa.p
      c = 1
    else:
      result.d[i] = c
      c = 0

func cmpt(pa: Padic): Padic =
  ## Return the complement.
  var c = 1
  result.p = pa.p
  result.k = pa.k
  result.v = pa.v
  for i in pa.v..(pa.k + pa.v):
    inc c, pa.p - 1 - pa.d[i]
    if c >= pa.p:
      result.d[i] = c - pa.p
      c = 1
    else:
      result.d[i] = c
      c = 0

func crat(pa: Padic): string =
  ## Rational reconstruction.
  var s = pa

  # Denominator count.
  var i = 1
  var fl = false
  while i <= Dmx:
    # Check for integer.
    var j = pa.k - 1 + pa.v
    while j >= pa.v:
      if s.d[j] != 0: break
      dec j
    fl = (j - pa.v) * 2 < pa.k
    if fl:
      fl = false
      break
    # Check negative integer.
    j = pa.k - 1 + pa.v
    while j >= pa.v:
      if pa.p - 1 - s.d[j] != 0: break
      dec j
    fl = (j - pa.v) * 2 < pa.k
    if fl: break
    # Repeatedly add "pa" to "s".
    s = s + pa
    inc i

  if fl: s = s.cmpt()

  # Numerator: weighted digit sum.
  var x = s.dsum()
  var y = i
  if x < 0 or y > Dmx:
    raise newException(PadicError, &"Error during rational reconstruction: {x}, {y}")
  # Negative powers.
  for i in pa.v..(-1): y *= pa.p
  # Negative rational.
  if fl: x = -x
  result = $x
  if y > 1: result.add &"/{y}"

func `$`(pa: Padic): string =
  ## String representation.
  let t = min(pa.v, 0)
  for i in countdown(pa.k - 1 + t, t):
    result.add $pa.d[i]
    if i == 0 and pa.v < 0: result.add "."
    result.add " "

proc print(pa: Padic; sw: int) =
  echo pa
  # Rational approximation.
  if sw != 0: echo pa.crat()

when isMainModule:

  # Rational reconstruction depends on the precision
  # until the dsum-loop overflows.
  const Data = [[2, 1, 2, 4, 1, 1],
                [4, 1, 2, 4, 3, 1],
                [4, 1, 2, 5, 3, 1],
                [4, 9, 5, 4, 8, 9],
                [26, 25, 5, 4, -109, 125],
                [49, 2, 7, 6, -4851, 2],
                [-9, 5, 3, 8, 27, 7],
                [5, 19, 2, 12, -101, 384],
                # Two decadic pairs.
                [2, 7, 10, 7, -1, 7],
                [34, 21, 10, 9, -39034, 791],
                # Familiar digits.
                [11, 4, 2, 43, 679001, 207],
                [-8, 9, 23, 9, 302113, 92],
                [-22, 7, 3, 23, 46071, 379],
                [-22, 7, 32749, 3, 46071, 379],
                [35, 61, 5, 20, 9400, 109],
                [-101, 109, 61, 7, 583376, 6649],
                [-25, 26, 7, 13, 5571, 137],
                [1, 4, 7, 11, 9263, 2837],
                [122, 407, 7, 11, -517, 1477],
                # More subtle.
                [5, 8, 7, 11, 353, 30809]]

  for d in Data:
    try:
      var a, b = Padic(p: d[2], k: d[3])
      r2pa(a, (d[0], d[1]), true)
      print(a, 0)
      r2pa(b, (d[4], d[5]), true)
      print(b, 0)
      echo "+ ="
      print(a + b, 1)
      echo ""
    except PadicError:
      echo getCurrentExceptionMsg()