Initial data commit

Task/P-Adic-numbers-basic/00-META.yaml

@@ -0,0 +1,3 @@
+---
+from: http://rosettacode.org/wiki/P-Adic_numbers,_basic
+note: mathematics

Task/P-Adic-numbers-basic/00-TASK.txt

@@ -0,0 +1,50 @@
+;Conversion and addition of [[wp:P-adic_number|p-adic Numbers]].
+
+
+;Task.
+
+Convert two rationals to p-adic numbers and add them up.
+Rational reconstruction is needed to interpret the result.
+
+p-Adic numbers were introduced around 1900 by Hensel. p-Adic expansions
+(a series of digits 0 ≤ d < p times p-power weights)
+are finite-tailed and tend to zero in the direction of higher positive
+powers of p (to the left in the notation used here).
+For example, the number 4 (100.0) has ''smaller'' 2-adic norm than 1/4 (0.01).
+
+If we convert a natural number, the familiar p-ary expansion is obtained:
+10 decimal is 1010 both binary and 2-adic. To convert a rational number a/b
+we perform p-adic long division. If p is actually prime, this is always possible
+if first the 'p-part' is removed from b (and the p-adic point shifted accordingly).
+The inverse of b modulo p is then used in the conversion.
+
+'''Recipe:''' at each step the most significant digit of the partial remainder
+(initially a) is zeroed by subtracting a proper multiple of the divisor b.
+Shift out the zero digit (divide by p) and repeat until the remainder is zero
+or the precision limit is reached. Because p-adic division starts from the right,
+the 'proper multiplier' is simply
+d = partial remainder * 1/b (mod p).
+The d's are the successive p-adic digits to find.
+
+Addition proceeds as usual, with carry from the right to the leftmost term,
+where it has least magnitude and just drops off. We can work with approximate rationals
+and obtain exact results. The routine for rational reconstruction demonstrates this:
+repeatedly add a p-adic to itself (keeping count to determine the denominator),
+until an integer is reached (the numerator then equals the weighted digit sum).
+But even p-adic arithmetic fails if the precision is too low. The examples mostly
+set the shortest prime-exponent combinations that allow valid reconstruction.
+
+
+;Related task.
+
+[[p-Adic square roots]]
+
+
+;Reference.
+
+[https://www.cut-the-knot.org/blue/p-adicExpansion.shtml] p-Adic expansions
+
+
+__TOC__
+
+

Task/P-Adic-numbers-basic/FreeBASIC/p-adic-numbers-basic.basic

@@ -0,0 +1,360 @@
+' ***********************************************
+'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

Task/P-Adic-numbers-basic/Go/p-adic-numbers-basic.go

@@ -0,0 +1,330 @@
+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()
+    }
+}

Task/P-Adic-numbers-basic/Haskell/p-adic-numbers-basic.hs

@@ -0,0 +1,216 @@
+{-# 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

Task/P-Adic-numbers-basic/Julia/p-adic-numbers-basic.julia

@@ -0,0 +1,62 @@
+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

Task/P-Adic-numbers-basic/Nim/p-adic-numbers-basic.nim

@@ -0,0 +1,226 @@
+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()

Task/P-Adic-numbers-basic/Phix/p-adic-numbers-basic.phix

@@ -0,0 +1,268 @@
+// constants
+constant EMX  = 64      // exponent maximum (if indexing starts at -EMX)
+constant DMX  = 1e5     // approximation loop maximum
+constant AMX  = 1048576 // 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
+
+procedure pad_to(string fmt, sequence data, integer len)
+    fmt = sprintf(fmt,data)
+    puts(1,fmt&repeat(' ',len-length(fmt)))
+end procedure
+
+class Padic
+    integer v = 0
+    sequence d = repeat(0,EMX*2)
+
+    // (re)initialize 'this' from Ratio, set 'sw' to print
+    function r2pa(Ratio q, integer sw)
+        integer {a,b} = q
+        if b=0 then return 1 end if
+        if b<0 then
+            b = -b
+            a = -a
+        end if
+        if abs(a)>AMX or b>AMX then return -1 end if
+        if p<2 or k<1 then return 1 end if
+        p = min(p, PMAX)  // maximum short prime
+        k = min(k, EMX-1) // maximum array length
+        if sw!=0 then
+             -- numerator, denominator, prime, precision
+            pad_to("%d/%d + O(%d^%d)",{a,b,p,k},30)
+        end if
+
+        // (re)initialize
+        v = 0
+        p1 = p - 1
+        sequence ntd = repeat(0,2*EMX) -- (new this.d)
+        if a=0 then return 0 end if
+
+        // find -exponent of p in b
+        integer i = 0
+        while remainder(b,p)=0 do
+            b /= p
+            i -= 1
+        end while
+        integer s = 0,
+                r = remainder(b,p)
+
+        // modular inverse for small P
+        integer b1 = 1
+        while b1<=p1 do
+            s += r
+            if s>p1 then s -= p end if
+            if s=1 then exit end if
+            b1 += 1
+        end while
+        if b1=p then
+            printf(1,"r2pa: impossible inverse mod")
+            return -1
+        end if
+        v = EMX
+        while true do
+            // find exponent of P in a
+            while remainder(a,p)=0 do
+                a /= p
+                i += 1
+            end while
+
+            // valuation
+            if v=EMX then v = i end if
+
+            // upper bound
+            if i>=EMX then exit end if
+
+            // check precision
+            if i-v>k then exit end if
+
+            // next digit
+            integer rdx = remainder(a*b1,p)
+            if rdx<0 then rdx += p end if
+            if rdx<0 or rdx>=p then ?9/0 end if -- sanity chk
+            ntd[i+EMX+1] = rdx
+
+            // remainder - digit * divisor
+            a -= rdx*b
+            if a=0 then exit end if
+        end while
+        this.d = ntd
+        return 0
+    end function
+
+    // Horner's rule
+    function dsum()
+        integer t = min(v, 0),
+                s = 0
+        for i=k-1+t to t by -1 do
+            integer r = s
+            s *= p
+            if r!=0 and floor(s/r)-p!=0 then
+                // overflow
+                s = -1
+                exit
+            end if
+            s += d[i+EMX+1]
+        end for
+        return s
+    end function
+
+    // add b to 'this'
+    function add(Padic b)
+        integer c = 0
+        Padic r = new({min(v,b.v)})
+        sequence rd = r.d
+        for i=r.v to k+r.v do
+            integer dx = i+EMX+1
+            c += d[dx] + b.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
+
+    // complement
+    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
+
+    // rational reconstruction
+    procedure crat()
+        integer sgn = 1
+        Padic s = this
+        integer j = 0,
+                i = 1
+
+        // denominator count
+        while i<=DMX do
+            // check for integer
+            j = k-1+v
+            while j>=v and s.d[j+EMX+1]=0 do
+                j -= 1
+            end while
+            if ((j-v)*2)<k then exit end if
+
+            // check for negative integer
+            j = k-1+v
+            while j>=v and p1-s.d[j+EMX+1]=0 do
+                j -= 1
+            end while
+            if ((j-v)*2)<k then
+                s = s.complement()
+                sgn = -1
+                exit
+            end if
+
+            // repeatedly add self to s
+            s = s.add(this)
+            i += 1
+        end while
+
+        // numerator: weighted digit sum
+        integer x = s.dsum(),
+                y = i
+        if x<0 or y>DMX then
+            printf(1,"crat: fail")
+        else
+            // negative powers
+            for i=v to -1 do
+                y *= p
+            end for
+            pad_to(iff(y=1?"%d":"%d/%d"),{x*sgn,y},26)
+            printf(1,"+ = ")
+        end if
+    end procedure
+
+    // print expansion
+    procedure prntf(bool sw)
+        integer t = min(v, 0)
+        // rational approximation
+        if sw!=0 then crat() end if
+        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")
+    end procedure
+end class
+
+sequence data = {
+    /* rational reconstruction limits are relative to the precision */
+    {{2, 1}, 2, 4, {1, 1}},
+    {{4, 1}, 2, 4, {3, 1}},
+    {{4, 1}, 2, 5, {3, 1}},
+    {{4, 9}, 5, 4, {8, 9}},
+-- all tested, but let's keep the output reasonable:
+--  {{-7, 5}, 7, 4, {99, 70}},
+--  {{26, 25}, 5, 4, {-109, 125}},
+--  {{49, 2}, 7, 6, {-4851, 2}},
+--  {{-9, 5}, 3, 8, {27, 7}},
+--  {{5, 19}, 2, 12, {-101, 384}},
+--  /* four decadic pairs */
+--  {{6, 7}, 10, 7, {-5, 7}},
+--  {{2, 7}, 10, 7, {-3, 7}},
+--  {{2, 7}, 10, 7, {-1, 7}},
+--  {{34, 21}, 10, 9, {-39034, 791}},
+--  /* familiar digits */
+--  {{11, 4}, 2, 43, {679001, 207}},
+--  {{11, 4}, 3, 27, {679001, 207}},
+--  {{11, 4}, 11, 13, {679001, 207}},
+--  {{-22, 7}, 2, 37, {46071, 379}},
+--  {{-22, 7}, 3, 23, {46071, 379}},
+--  {{-22, 7}, 7, 13, {46071, 379}},
+--  {{-101, 109}, 2, 40, {583376, 6649}},
+--  {{-101, 109}, 61, 7, {583376, 6649}},
+--  {{-101, 109}, 32749, 3, {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}}
+}
+
+integer sw = 0,qa,qb
+Padic a = new()
+Padic b = new()
+
+for i=1 to length(data) do
+    {Ratio q, p, k, Ratio q2} = data[i]
+    sw = a.r2pa(q, 1)
+    if sw=1 then exit end if
+    a.prntf(0)
+    sw = sw or b.r2pa(q2, 1)
+    if sw=1 then exit end if
+    if sw=0 then
+        b.prntf(0)
+        Padic c = a.add(b)
+        c.prntf(1)
+    end if
+    printf(1,"\n")
+end for

Task/P-Adic-numbers-basic/Raku/p-adic-numbers-basic.raku

@@ -0,0 +1,94 @@
+# 20210225 Raku programming solution
+
+#!/usr/bin/env raku
+
+class Padic { has ($.p is default(2), %.v is default({})) is rw ;
+
+   method r2pa (Rat $x is copy, \p, \d) { # Reference: math.stackexchange.com/a/1187037
+      self.p = p ;
+      $x += p**d if $x < 0 ;  # complement
+
+      my $lowerest = 0;
+      my ($num,$den) = $x.nude;
+      while ($den % p) == 0 { $den /= p and $lowerest-- }
+      $x = $num / $den;
+
+      while +self.v < d {
+         my %d = ^p Z=> (( $x «-« ^p ) »/» p )».&{ .denominator % p }; # .kv
+         for %d.keys { self.v.{$lowerest++} = $_ and last if %d{$_} != 0 }
+         $x = ($x - self.v.{$lowerest-1}) / p ;
+      }
+      self
+   }
+
+   method add (Padic \x, \d) {
+      my $div = 0;
+      my $lowerest = (self.v.keys.sort({.Int}).first,
+                         x.v.keys.sort({.Int}).first  ).min ;
+      return Padic.new:
+         p => self.p,
+         v => gather for ^d {
+            my $power = $lowerest + $_;
+            given ((self.v.{$power}//0)+(x.v.{$power}//0)+$div).polymod(x.p)
+               { take ($power, .[0]).Slip and $div = .[1] }
+         }
+   }
+
+   method gist {
+      # en.wikipedia.org/wiki/P-adic_number#Notation
+      # my %H = (0..9) Z=> ('₀'..'₉'); # (0x2080 .. 0x2089);
+      # '⋯ ' ~ self.v ~ ' ' ~ [~] self.p.comb».&{ %H{$_} }
+
+      # express as a series
+      my %H = ( 0…9 ,'-') Z=> ( '⁰','¹','²','³','⁴'…'⁹','⁻');
+      [~] self.v.keys.sort({.Int}).map: {
+         ' + ' ~ self.v.{$_} ~ '*' ~ self.p ~ [~] $_.comb».&{ %H{$_}} }
+      }
+}
+
+my @T;
+for my \D = (
+#`[[ these are not working
+   < 26/25 -109/125 5 4 >,
+   < 6/7 -5/7 10 7 >,
+   < 2/7 -3/7 10 7 >,
+   < 2/7 -1/7 10 7 >,
+   < 34/21 -39034/791 10 9 >,
+#]]