A-M baby

Task/Multiplicative-order/0DESCRIPTION

@@ -0,0 +1,37 @@
+The '''multiplicative order''' of ''a'' relative to ''m'' is the least positive integer ''n'' such that ''a^n'' is 1 (modulo ''m'').
+For example, the multiplicative order of 37 relative to 1000 is 100 because 37^100 is 1 (modulo 1000), and no number smaller than 100 would do.
+
+One possible algorithm that is efficient also for large numbers is the following: By the [[wp:Chinese_Remainder_Theorem|Chinese Remainder Theorem]], it's enough to calculate the multiplicative order for each prime exponent ''p^k'' of ''m'', and
+combine the results with the ''[[least common multiple]]'' operation.
+Now the order of ''a'' wrt. to ''p^k'' must divide ''Φ(p^k)''. Call this number ''t'', and determine it's factors ''q^e''. Since each multiple of the order will also yield 1 when used as exponent for ''a'', it's enough to find the least d such that ''(q^d)*(t/(q^e))'' yields 1 when used as exponent.
+
+Implement a routine to calculate the multiplicative order along these lines. You may assume that routines to determine the factorization into prime powers are available in some library.
+
+----
+
+An algorithm for the multiplicative order can be found in Bach & Shallit, <i>Algorithmic Number Theory, Volume I: Efficient Algorithms</i>, The MIT Press, 1996:
+
+<p>Exercise 5.8, page 115:</p>
+
+<p>Suppose you are given a prime<tt> p </tt>and a complete factorization
+of<tt> p-1</tt> .<tt> </tt>Show how to compute the order of an
+element<tt> a </tt>in<tt> (Z/(p))<sup>*</sup> </tt>using<tt> O((lg p)<sup>4</sup>/(lg lg p)) </tt>bit
+operations.</p>
+
+<p>Solution, page 337:</p>
+
+<p>Let the prime factorization of<tt> p-1 </tt> be<tt> q1<sup>e1</sup>q2<sup>e2</sup>...qk<sup>ek</sup></tt> .<tt> </tt>We use the following observation:
+if<tt> x^((p-1)/qi<sup>fi</sup>) = 1 (mod p)</tt> ,<tt> </tt>
+and<tt> fi=ei </tt>or<tt> x^((p-1)/qi<sup>fi+1</sup>) != 1 (mod p)</tt> ,<tt> </tt>then<tt> qi<sup>ei-fi</sup>||ord<sub>p</sub> x</tt> .<tt> </tt>
+(This follows by combining Exercises 5.1 and 2.10.)
+
+Hence it suffices to find, for each<tt> i</tt> ,<tt> </tt>the exponent<tt> fi </tt> such that the condition above holds.</p>
+
+<p>This can be done as follows: first compute<tt> q1<sup>e1</sup>, q2<sup>e2</sup>, ... ,
+qk<sup>ek</sup></tt> .<tt> </tt> This can be done using<tt> O((lg p)<sup>2</sup>) </tt>bit operations. Next, compute<tt> y1=(p-1)/q1<sup>e1</sup>, ... , yk=(p-1)/qk<sup>ek</sup></tt> .<tt> </tt>
+This can be done using<tt> O((lg p)<sup>2</sup>) </tt>bit operations. Now, using the binary method,
+compute<tt> x1=a<sup>y1</sup>(mod p), ... ,  xk=a<sup>yk</sup>(mod p) </tt>.<tt> </tt>
+This can be done using<tt> O(k(lg p)<sup>3</sup>) </tt>bit operations, and<tt> k=O((lg p)/(lg lg p)) </tt>by Theorem 8.8.10.
+Finally, for each<tt> i</tt> ,<tt> </tt>repeatedly raise<tt> xi </tt>to the<tt> qi</tt>-th power<tt> (mod p) </tt>(as many as<tt> ei-1 </tt> times), checking to see when 1 is obtained.
+This can be done using<tt> O((lg p)<sup>3</sup>) </tt>steps.
+The total cost is dominated by<tt> O(k(lg p)<sup>3</sup>)</tt> ,<tt> </tt>which is<tt> O((lg p)<sup>4</sup>/(lg lg p))</tt> .

Task/Multiplicative-order/1META.yaml

@@ -0,0 +1,2 @@
+---
+note: Discrete math

Task/Multiplicative-order/ALGOL-68/multiplicative-order.alg

@@ -0,0 +1,120 @@
+MODE LOOPINT = INT;
+
+MODE POWMODSTRUCT = LONG INT;
+PR READ "prelude/pow_mod.a68" PR;
+
+MODE SORTSTRUCT = LONG INT;
+PR READ "prelude/sort.a68" PR;
+
+MODE GCDSTRUCT = LONG INT;
+PR READ "prelude/gcd.a68" PR;
+
+PR READ "prelude/iterator.a68" PR;
+
+PROC is prime = (LONG INT p)BOOL:
+    ( p > 1 |#ANDF# ALL((YIELDBOOL yield)VOID: factored(p, (LONG INT f, LONG INT e)VOID: yield(f = p))) | FALSE );
+
+FLEX[4]LONG INT prime list := (2,3,5,7);
+
+OP +:= = (REF FLEX[]LONG INT lhs, LONG INT rhs)VOID: (
+    [UPB lhs +1] LONG INT next lhs;
+    next lhs[:UPB lhs] := lhs;
+    lhs := next lhs;
+    lhs[UPB lhs] := rhs
+);
+
+PROC primes = (PROC (LONG INT)VOID yield)VOID: (
+    LONG INT p;
+    FOR p index TO UPB prime list DO
+        p:= prime list[p index];
+        yield(p)
+    OD;
+    DO
+        p +:= 2;
+        WHILE NOT is prime(p) DO
+            p +:= 2
+        OD;
+        prime list +:= p;
+        yield(p)
+    OD
+);
+
+PROC factored = (LONG INT in a, PROC (LONG INT,LONG INT)VOID yield)VOID: (
+    LONG INT a := in a;
+  # FOR          p IN  # primes( # DO #
+       (LONG INT p)VOID:(
+        LONG INT j := 0;
+        WHILE a MOD p = 0 DO
+            a := a % p;
+            j +:= 1
+        OD;
+        IF j > 0 THEN yield (p,j) FI;
+        IF a < p*p THEN done FI
+      )
+  # ) OD #  );
+    done:
+    IF a > 1 THEN yield (a,1) FI
+);
+
+PROC mult0rdr1 = (LONG INT a, p, e)LONG INT: (
+    LONG INT m := p ** SHORTEN e;
+    LONG INT t := (p-1)*(p**SHORTEN (e-1)); #  = Phi(p**e) where p prime #
+    LONG INT q;
+    FLEX[0]LONG INT qs := (1);
+  # FOR          f0,f1 IN  # factored(t # DO #,
+       (LONG INT f0,f1)VOID: (
+            FLEX[SHORTEN((f1+1)*UPB qs)]LONG INT next qs;
+            FOR j TO SHORTEN f1 + 1 DO
+                FOR q index TO UPB qs DO
+                    q := qs[q index];
+                    next qs[(j-1)*UPB qs+q index] := q * f0**(j-1)
+                OD
+            OD;
+            qs := next qs
+        )
+  #   OD # );
+    VOID(in place shell sort(qs));
+
+    FOR q index TO UPB qs DO
+        q := qs[q index];
+        IF pow mod(a,q,m)=1 THEN done FI
+    OD;
+    done:
+    q
+);
+
+PROC reduce = (PROC (LONG INT,LONG INT)LONG INT diadic, FORLONGINT iterator, LONG INT initial value)LONG INT: (
+  LONG INT out := initial value;
+# FOR          next IN # iterator( # DO #
+     (LONG INT next)VOID:
+    out := diadic(out, next)
+ # OD # );
+  out
+);
+
+PROC mult order = (LONG INT a, LONG INT m)LONG INT: (
+    PROC mofs = (YIELDLONGINT yield)VOID:(
+      # FOR          p,          count IN # factored(m, # DO #
+           (LONG INT p, LONG INT count)VOID:
+            yield(mult0rdr1(a,p,count))
+        )
+  # OD #  );
+    reduce(lcm, mofs, 1)
+);
+
+main:(
+    FORMAT d = $g(-0)$;
+    printf((d, mult order(37, 1000), $l$));        # 100 #
+    LONG INT b := LENG 10**20-1;
+    printf((d, mult order(2, b), $l$)); # 3748806900 #
+    printf((d, mult order(17,b), $l$)); # 1499522760 #
+    b := 100001;
+    printf((d, mult order(54,b), $l$));
+    printf((d, pow mod( 54, mult order(54,b),b), $l$));
+    IF ANY( (YIELDBOOL yield)VOID: FOR r FROM 2 TO SHORTEN mult order(54,b)-1 DO yield(1=pow mod(54,r, b)) OD  )
+    THEN
+        printf(($g$, "Exists a power r < 9090 where pow mod(54,r,b) = 1", $l$))
+    ELSE
+        printf(($g$, "Everything checks.", $l$))
+    FI
+)

Task/Multiplicative-order/Ada/multiplicative-order-1.ada

@@ -0,0 +1,21 @@
+package Multiplicative_Order is
+
+   type Positive_Array is array (Positive range <>) of Positive;
+
+   function Find_Order(Element, Modulus: Positive) return Positive;
+   -- naive algorithm
+   -- returns the smallest I such that (Element**I) mod Modulus = 1
+
+   function Find_Order(Element: Positive;
+                       Coprime_Factors: Positive_Array) return Positive;
+   -- faster algorithm for the same task
+   -- computes the order of all Coprime_Factors(I)
+   -- and returns their least common multiple
+   -- this gives the same result as Find_Order(Element, Modulus)
+   -- with Modulus being the product of all the Coprime_Factors(I)
+   --
+   -- preconditions: (1) 1 = GCD(Coprime_Factors(I), Coprime_Factors(J))
+   --                    for all pairs I, J with I /= J
+   --                (2) 1 < Coprime_Factors(I)   for all I
+
+end Multiplicative_Order;

Task/Multiplicative-order/Ada/multiplicative-order-2.ada

@@ -0,0 +1,66 @@
+package body Multiplicative_Order is
+
+   function Find_Order(Element, Modulus: Positive) return Positive is
+
+      function Power(Exp, Pow, M: Positive) return Positive is
+         -- computes Exp**Pow mod M;
+         -- note that Ada's native integer exponentiation "**" may overflow on
+         -- computing Exp**Pow before ever computing the "mod M" part
+         Result: Positive := 1;
+         E: Positive := Exp;
+         P: Natural := Pow;
+      begin
+         while P > 0 loop
+            if P mod 2 = 1 then
+               Result := (Result * E) mod M;
+            end if;
+            E := (E * E) mod M;
+            P := P / 2;
+         end loop;
+         return Result;
+      end Power;
+
+   begin -- Find_Order(Element, Modulus)
+      for I in 1 .. Modulus loop
+         if Power(Element, I, Modulus) = 1 then
+            return Positive(I);
+         end if;
+      end loop;
+      raise Program_Error with
+        Positive'Image(Element) &" is not coprime to" &Positive'Image(Modulus);
+   end Find_Order;
+
+   function Find_Order(Element: Positive;
+                       Coprime_Factors: Positive_Array) return Positive is
+
+         function GCD (A, B : Positive) return Integer is
+            M : Natural := A;
+            N : Natural := B;
+            T : Natural;
+         begin
+            while N /= 0 loop
+               T := M;
+               M := N;
+               N ;:= T mod N;
+            end loop;
+            return M;
+         end GCD; -- from http://rosettacode.org/wiki/Least_common_multiple#Ada
+
+         function LCM (A, B : Natural) return Integer is
+         begin
+            if A = 0 or B = 0 then
+               return 0;
+            end if;
+            return abs (A * B) / Gcd (A, B);
+         end LCM; -- from http://rosettacode.org/wiki/Least_common_multiple#Ada
+
+         Result : Positive := 1;
+
+   begin -- Find_Order(Element, Coprime_Factors)
+      for I in Coprime_Factors'Range loop
+         Result := LCM(Result, Find_Order(Element, Coprime_Factors(I)));
+      end loop;
+      return Result;
+   end Find_Order;
+
+end Multiplicative_Order;

Task/Multiplicative-order/Ada/multiplicative-order-3.ada

@@ -0,0 +1,24 @@
+with Ada.Text_IO, Multiplicative_Order;
+
+procedure Main is
+   package IIO is new Ada.Text_IO.Integer_IO(Integer);
+   use Multiplicative_Order;
+begin
+   IIO.Put(Find_Order(3,10));
+   IIO.Put(Find_Order(37,1000));
+   IIO.Put(Find_Order(37,10_000));
+   IIO.Put(Find_Order(37, 3343));
+   IIO.Put(Find_Order(37, 3344));
+   -- IIO.Put(Find_Order( 2,1000));
+     --would raise Program_Error, because there is no I with 2**I=1 mod 1000
+   Ada.Text_IO.New_Line;
+   IIO.Put(Find_Order(3, (2,5)));           --  3 *   5 = 10
+   IIO.Put(Find_Order(37, (8, 125)));       --  8 * 125 = 1000
+   IIO.Put(Find_Order(37, (16, 625)));      -- 16 * 625 = 10_000
+   IIO.Put(Find_Order(37, (1 => 3343)));    -- 1-element-array: 3343 is a prime
+   IIO.Put(Find_Order(37, (11, 19, 16)));   -- 11 * 19 * 16 = 3344
+
+   -- this violates the precondition, because 8 and 2 are not coprime
+   -- it gives an incorrect result
+   IIO.Put(Find_Order(37, (11, 19, 8, 2)));
+end Main;

Task/Multiplicative-order/C/multiplicative-order.c

@@ -0,0 +1,63 @@
+ulong mpow(ulong a, ulong p, ulong m)
+{
+	ulong r = 1;
+	while (p) {
+		if ((1 & p)) r = r * a % m;
+		a = a * a % m;
+		p >>= 1;
+	}
+	return r;
+}
+
+ulong ipow(ulong a, ulong p) {
+	ulong r = 1;
+	while (p) {
+		if ((1 & p)) r = r * a;
+		a *= a;
+		p >>= 1;
+	}
+	return r;
+}
+
+ulong gcd(ulong m, ulong n)
+{
+	ulong t;
+	while (m) { t = m; m = n % m; n = t; }
+	return n;
+}
+
+ulong lcm(ulong m, ulong n)
+{
+	ulong g = gcd(m, n);
+	return m / g * n;
+}
+
+ulong multi_order_p(ulong a, ulong p, ulong e)
+{
+	ulong fac[10000];
+	ulong m = ipow(p, e);
+	ulong t = m / p * (p - 1);
+	int i, len = get_factors(t, fac);
+	for (i = 0; i < len; i++)
+		if (mpow(a, fac[i], m) == 1)
+			return fac[i];
+	return 0;
+}
+
+ulong multi_order(ulong a, ulong m)
+{
+	prime_factor pf[100];
+	int i, len = get_prime_factors(m, pf);
+	ulong res = 1;
+	for (i = 0; i < len; i++)
+		res = lcm(res, multi_order_p(a, pf[i].p, pf[i].e));
+	return res;
+}
+
+int main()
+{
+	sieve();
+	printf("%lu\n", multi_order(37, 1000));
+	printf("%lu\n", multi_order(54, 100001));
+	return 0;
+}

Task/Multiplicative-order/Go/multiplicative-order.go

@@ -0,0 +1,102 @@
+package main
+
+import (
+    "fmt"
+    "math/big"
+)
+
+func main() {
+    moTest(big.NewInt(37), big.NewInt(3343))
+    b := big.NewInt(100)
+    moTest(b.Add(b.Exp(ten, b, nil), one), big.NewInt(7919))
+    moTest(b.Add(b.Exp(ten, b.SetInt64(1000), nil), one), big.NewInt(15485863))
+    moTest(b.Sub(b.Exp(ten, b.SetInt64(10000), nil), one),
+        big.NewInt(22801763489))
+
+    moTest(big.NewInt(1511678068), big.NewInt(7379191741))
+    moTest(big.NewInt(3047753288), big.NewInt(2257683301))
+}
+
+func moTest(a, n *big.Int) {
+    if a.BitLen() < 100 {
+        fmt.Printf("ord(%v)", a)
+    } else {
+        fmt.Print("ord([big])")
+    }
+    if n.BitLen() < 100 {
+        fmt.Printf(" mod %v ", n)
+    } else {
+        fmt.Print(" mod [big] ")
+    }
+    if !n.ProbablyPrime(20) {
+        fmt.Println("not computed.  modulus must be prime for this algorithm.")
+        return
+    }
+    fmt.Println("=", moBachShallit58(a, n, factor(new(big.Int).Sub(n, one))))
+}
+
+var one = big.NewInt(1)
+var two = big.NewInt(2)
+var ten = big.NewInt(10)
+
+func moBachShallit58(a, n *big.Int, pf []pExp) *big.Int {
+    n1 := new(big.Int).Sub(n, one)
+    var x, y, o1, g big.Int
+    mo := big.NewInt(1)
+    for _, pe := range pf {
+        y.Quo(n1, y.Exp(pe.prime, big.NewInt(pe.exp), nil))
+        var o int64
+        for x.Exp(a, &y, n); x.Cmp(one) > 0; o++ {
+            x.Exp(&x, pe.prime, n)
+        }
+        o1.Exp(pe.prime, o1.SetInt64(o), nil)
+        mo.Mul(mo, o1.Quo(&o1, g.GCD(nil, nil, mo, &o1)))
+    }
+    return mo
+}
+
+type pExp struct {
+    prime *big.Int
+    exp   int64
+}
+
+func factor(n *big.Int) (pf []pExp) {
+    var e int64
+    for ; n.Bit(int(e)) == 0; e++ {
+    }
+    if e > 0 {
+        n.Rsh(n, uint(e))
+        pf = []pExp{{big.NewInt(2), e}}
+    }
+    s := sqrt(n)
+    q, r := new(big.Int), new(big.Int)
+    for d := big.NewInt(3); n.Cmp(one) > 0; d.Add(d, two) {
+        if d.Cmp(s) > 0 {
+            d.Set(n)
+        }
+        for e = 0; ; e++ {
+            q.QuoRem(n, d, r)
+            if r.BitLen() > 0 {
+                break
+            }
+            n.Set(q)
+        }
+        if e > 0 {
+            pf = append(pf, pExp{new(big.Int).Set(d), e})
+            s = sqrt(n)
+        }
+    }
+    return
+}
+
+func sqrt(n *big.Int) *big.Int {
+    a := new(big.Int)
+    for b := new(big.Int).Set(n); ; {
+        a.Set(b)
+        b.Rsh(b.Add(b.Quo(n, a), a), 1)
+        if b.Cmp(a) >= 0 {
+            return a
+        }
+    }
+    return a.SetInt64(0)
+}

Task/Multiplicative-order/Haskell/multiplicative-order-1.hs

@@ -0,0 +1 @@
+primeFacsExp :: Integer -> [(Integer, Int)]

Task/Multiplicative-order/Haskell/multiplicative-order-2.hs

@@ -0,0 +1,9 @@
+powerMod :: (Integral a, Integral b) => a -> a -> b -> a
+powerMod m _ 0 =  1
+powerMod m x n | n > 0 = f x' (n-1) x' where
+  x' = x `rem` m
+  f _ 0 y = y
+  f a d y = g a d where
+    g b i | even i    = g (b*b `rem` m) (i `quot` 2)
+          | otherwise = f b (i-1) (b*y `rem` m)
+powerMod m _ _  = error "powerMod: negative exponent"

Task/Multiplicative-order/Haskell/multiplicative-order-3.hs

@@ -0,0 +1,11 @@
+multOrder a m
+  | gcd a m /= 1  = error "Arguments not coprime"
+  | otherwise     = foldl1' lcm $ map (multOrder' a) $ primeFacsExp m
+
+multOrder' a (p,k) = r where
+  pk = p^k
+  t = (p-1)*p^(k-1) -- totient \Phi(p^k)
+  r = product $ map find_qd $ primeFacsExp $ t
+  find_qd (q,e) = q^d where
+    x = powerMod pk a (t `div` (q^e))
+    d = length $ takeWhile (/= 1) $ iterate (\y -> powerMod pk y q) x

Task/Multiplicative-order/J/multiplicative-order-1.j

@@ -0,0 +1,6 @@
+mo=: 4 : 0
+ a=. x: x
+ m=. x: y
+ assert. 1=a+.m
+ *./ a mopk"1 |: __ q: m
+)

Task/Multiplicative-order/J/multiplicative-order-2.j

@@ -0,0 +1,10 @@
+mopk=: 4 : 0
+ a=. x: x
+ 'p k'=. x: y
+ pm=. (p^k)&|@^
+ t=. (p-1)*p^k-1  NB. totient
+ 'q e'=. __ q: t
+ x=. a pm t%q^e
+ d=. (1<x)+x (pm i. 1:)&> (e-1) */\@$&.> q
+ */q^d
+)

Task/Multiplicative-order/J/multiplicative-order-3.j

@@ -0,0 +1,4 @@
+   37 mo 1000
+100
+   2 mo _1+10^80x
+190174169488577769580266953193403101748804183400400

Task/Multiplicative-order/Mathematica/multiplicative-order.mathematica

@@ -0,0 +1,6 @@
+MultiplicativeOrder[37, 1000]
+MultiplicativeOrder[10^100 + 1, 7919]        (*10^3th prime number  Prime[1000]*)
+MultiplicativeOrder[10^1000 + 1, 15485863]       (*10^6th prime number*)
+MultiplicativeOrder[10^10000 - 1, 22801763489]       (*10^9th prime number*)
+MultiplicativeOrder[13, 1 + 10^80]
+MultiplicativeOrder[11, 1 + 10^100]

Task/Multiplicative-order/Maxima/multiplicative-order.maxima

@@ -0,0 +1,17 @@
+zn_order(37, 1000);
+/* 100 */
+
+zn_order(10^100 + 1, 7919);
+/* 3959 */
+
+zn_order(10^1000 + 1, 15485863);
+/* 15485862 */
+
+zn_order(10^10000 - 1, 22801763489);
+/* 22801763488 */
+
+zn_order(13, 1 + 10^80);
+/* 109609547199756140150989321269669269476675495992554276140800 */
+
+zn_order(11, 1 + 10^100);
+/* 2583496112724752500580158969425549088007844580826869433740066152289289764829816356800 */

Task/Multiplicative-order/Python/multiplicative-order.py

@@ -0,0 +1,66 @@
+def gcd(a, b):
+    while b != 0:
+        a, b = b, a % b
+    return a
+
+def lcm(a, b):
+    return (a*b) / gcd(a, b)
+
+def isPrime(p):
+    return (p > 1) and all(f == p for f,e in factored(p))
+
+primeList = [2,3,5,7]
+def primes():
+    for p in primeList:
+        yield p
+    while 1:
+        p += 2
+        while not isPrime(p):
+            p += 2
+        primeList.append(p)
+        yield p
+
+def factored( a):
+    for p in primes():
+        j = 0
+        while a%p == 0:
+            a /= p
+            j += 1
+        if j > 0:
+            yield (p,j)
+        if a < p*p: break
+    if a > 1:
+        yield (a,1)
+
+
+def multOrdr1(a,(p,e) ):
+    m = p**e
+    t = (p-1)*(p**(e-1)) #  = Phi(p**e) where p prime
+    qs = [1,]
+    for f in factored(t):
+        qs = [ q * f[0]**j for j in range(1+f[1]) for q in qs ]
+    qs.sort()
+
+    for q in qs:
+        if pow( a, q, m )==1: break
+    return q
+
+
+def multOrder(a,m):
+    assert gcd(a,m) == 1
+    mofs = (multOrdr1(a,r) for r in factored(m))
+    return reduce(lcm, mofs, 1)
+
+
+if __name__ == "__main__":
+    print multOrder(37, 1000)        # 100
+    b = 10**20-1
+    print multOrder(2, b) # 3748806900
+    print multOrder(17,b) # 1499522760
+    b = 100001
+    print multOrder(54,b)
+    print pow( 54, multOrder(54,b),b)
+    if any( (1==pow(54,r, b)) for r in range(1,multOrder(54,b))):
+        print 'Exists a power r < 9090 where pow(54,r,b)==1'
+    else:
+        print 'Everything checks.'

Task/Multiplicative-order/Ruby/multiplicative-order.rb

@@ -0,0 +1,47 @@
+require 'rational' # for lcm
+require 'mathn'    # for prime_division
+
+def powerMod(b, p, m)
+  result = 1
+  bits = p.to_s(2)
+  for bit in bits.split('')
+    result = (result * result) % m
+    if bit == '1'
+      result = (result * b) % m
+    end
+  end
+  result
+end
+
+def multOrder_(a, p, k)
+  pk = p ** k
+  t = (p - 1) * p ** (k - 1)
+  r = 1
+  for q, e in t.prime_division
+    x = powerMod(a, t / q ** e, pk)
+    while x != 1
+      r *= q
+      x = powerMod(x, q, pk)
+    end
+  end
+  r
+end
+
+def multOrder(a, m)
+  m.prime_division.inject(1) {|result, f|
+    result.lcm(multOrder_(a, *f))
+  }
+end
+
+puts multOrder(37, 1000)        # 100
+b = 10**20-1
+puts multOrder(2, b) # 3748806900
+puts multOrder(17,b) # 1499522760
+b = 100001
+puts multOrder(54,b)
+puts powerMod(54, multOrder(54,b), b)
+if (1...multOrder(54,b)).any? {|r| powerMod(54, r, b) == 1}
+  puts 'Exists a power r < 9090 where powerMod(54,r,b)==1'
+else
+  puts 'Everything checks.'
+end

Task/Multiplicative-order/Tcl/multiplicative-order.tcl

@@ -0,0 +1,178 @@
+package require Tcl 8.5
+package require struct::list
+
+proc multOrder {a m} {
+    assert {[gcd $a $m] == 1}
+    set mofs [list]
+    dict for {p e} [factor_num $m] {
+        lappend mofs [multOrdr1 $a $p $e]
+    }
+    return [struct::list fold $mofs 1 lcm]
+}
+
+proc multOrdr1 {a p e} {
+    set m [expr {$p ** $e}]
+    set t [expr {($p - 1) * ($p ** ($e - 1))}]
+    set qs [dict create 1 ""]
+
+    dict for {f0 f1} [factor_num $t] {
+        dict for {q -} $qs {
+            foreach j [range [expr {1 + $f1}]] {
+                dict set qs [expr {$q * $f0 ** $j}] ""
+            }
+        }
+    }
+
+    dict for {q -} $qs {
+        if {pypow($a, $q, $m) == 1} break
+    }
+    return $q
+}
+
+####################################################
+# utility procs
+proc assert {condition {message "Assertion failed!"}} {
+    if { ! [uplevel 1 [list expr $condition]]} {
+        return -code error $message
+    }
+}
+
+proc gcd {a b} {
+    while {$b != 0} {
+        lassign [list $b [expr {$a % $b}]] a b
+    }
+    return $a
+}
+
+proc lcm {a b} {
+    expr {$a * $b / [gcd $a $b]}
+}
+
+proc factor_num {num} {
+    primes::restart
+    set factors [dict create]
+    for {set i [primes::get_next_prime]} {$i <= $num} {} {
+        if {$num % $i == 0} {
+            dict incr factors $i
+            set num [expr {$num / $i}]
+            continue
+        } elseif {$i*$i > $num} {
+            dict incr factors $num
+            break
+        } else {
+            set i [primes::get_next_prime]
+        }
+    }
+    return $factors
+}
+
+####################################################
+# a range command akin to Python's
+proc range args {
+    foreach {start stop step} [switch -exact -- [llength $args] {
+        1 {concat 0 $args 1}
+        2 {concat   $args 1}
+        3 {concat   $args  }
+        default {error {wrong # of args: should be "range ?start? stop ?step?"}}
+    }] break
+    if {$step == 0} {error "cannot create a range when step == 0"}
+    set range [list]
+    while {$step > 0 ? $start < $stop : $stop < $start} {
+        lappend range $start
+        incr start $step
+    }
+    return $range
+}
+
+# python's pow()
+proc ::tcl::mathfunc::pypow {x y {z ""}} {
+    expr {$z eq "" ? $x ** $y : ($x ** $y) % $z}
+}
+
+####################################################
+# prime number generator
+# ref http://wiki.tcl.tk/5996
+####################################################
+namespace eval primes {}
+
+proc primes::reset {} {
+    variable list [list]
+    variable current_index end
+}
+
+namespace eval primes {reset}
+
+proc primes::restart {} {
+    variable list
+    variable current_index
+    if {[llength $list] > 0} {
+        set current_index 0
+    }
+}
+
+proc primes::is_prime {candidate} {
+    variable list
+
+    foreach prime $list {
+        if {$candidate % $prime == 0} {
+            return false
+        }
+        if {$prime * $prime > $candidate} {
+            return true
+        }
+    }
+    while true {
+        set largest [get_next_prime]
+        if {$largest * $largest >= $candidate} {
+            return [is_prime $candidate]
+        }
+    }
+}
+
+proc primes::get_next_prime {} {
+    variable list
+    variable current_index
+
+    if {$current_index ne "end"} {
+        set p [lindex $list $current_index]
+        if {[incr current_index] == [llength $list]} {
+            set current_index end
+        }
+        return $p
+    }
+
+    switch -exact -- [llength $list] {
+        0 {set candidate 2}
+        1 {set candidate 3}
+        default {
+            set candidate [lindex $list end]
+            while true {
+                incr candidate 2
+                if {[is_prime $candidate]} break
+            }
+        }
+    }
+    lappend list $candidate
+    return $candidate
+}
+
+####################################################
+puts [multOrder 37 1000] ;# 100
+
+set b [expr {10**20 - 1}]
+puts [multOrder 2 $b] ;# 3748806900
+puts [multOrder 17 $b] ;# 1499522760
+
+set a 54
+set m 100001
+puts [set n [multOrder $a $m]] ;# 9090
+puts [expr {pypow($a, $n, $m)}] ;# 1
+
+set lambda {{a n m} {expr {pypow($a, $n, $m) == 1}}}
+foreach r [lreverse [range 1 $n]] {
+    if {[apply $lambda $a $r $m]} {
+        error "Oops, $n is not the smallest:  {$a $r $m} satisfies $lambda"
+    }
+    if {$r % 1000 == 0} {puts "$r ..."}
+}
+puts "OK, $n is the smallest n such that {$a $n $m} satisfies $lambda"