fcn multisplit(text, sep){
   lastmatch := i := 0; matches := List();
   while(i < text.len()){
      foreach j,s in ([0..].zip(sep)){
         if(i == text.find(s,i)){
	    if(i > lastmatch) matches.append(text[lastmatch,i-lastmatch]);
	    matches.append(T(j,i));  # Replace the string containing the matched separator with a tuple of which separator and where in the string the match occured
	    lastmatch = i + s.len();
	    i += s.len()-1;
	    break;
	 }
      }
      i += 1;
   }
   if(i > lastmatch) matches.append(text[lastmatch,i-lastmatch]);
   return(matches);
}


var a = new Array(n);
for (var i = 0; i < n; i++)
  a[i] = new Foo();


def Array(atype; n):
  if   atype == "number" then [ range(0;n) ]
  elif atype == "object" then [ range(0;n)| {"value": . } ]
  elif atype == "array"  then [ range(0;n)| [.] ]
  elif atype == "string" then [ range(0;n)| tostring ]
  elif atype == "boolean" then
    if n == 0 then [] elif n == 1 then [false] elif n==2 then [false, true]
    else error("there are only two boolean values")
    end
  elif atype == "null" then
    if n == 0 then [] elif n == 1 then [null]
    else error("there is only one null value")
    end
  else error("\(atype) is not a jq type")
  end;

# Example:

 Array("object"; 4)


foo() = rand()             # repeated calls change the result with each call
repeat([foo()], outer=5)   # but this only calls foo() once, clones that first value


// version 1.1.2

class Foo {
    val id: Int

    init {
       id = ++numCreated // creates a distict id for each object
    }

    companion object {
        private var numCreated = 0
    }
}

fun main(args: Array<String>) {
    val n = 3  // say

    /* correct approach - creates references to distinct objects */
    val fooList = List(n) { Foo() }
    for (foo in fooList) println(foo.id)

    /* incorrect approach - creates references to same object */
    val f = Foo()
    val fooList2 = List(n) { f }
    for (foo in fooList2) println(foo.id)
}


arr := n times to (Array) map { Object clone. }.


| ?- create_protocol(statep, [], [public(state/1)]),
     findall(
         Id,
         (integer::between(1, 10, N),
          create_object(Id, [implements(statep)], [], [state(N)])),
         Ids
     ).
Ids = [o1, o2, o3, o4, o5, o6, o7, o8, o9, o10].


-- This concept is relevant to tables in Lua
local table1 = {1,2,3}

-- The following will create a table of references to table1
local refTab = {}
for i = 1, 10 do refTab[i] = table1 end

-- Instead, tables should be copied using a function like this
function copy (t)
    local new = {}
    for k, v in pairs(t) do new[k] = v end
    return new
end

-- Now we can create a table of independent copies of table1
local copyTab = {}
for i = 1, 10 do copyTab[i] = copy(table1) end


Module CheckIt {
      Form 60, 40
      Foo=Lambda Id=1 (m)->{
            class Alfa {
                  x, id
                  Class:
                  Module Alfa(.x, .id) {}
            }
            =Alfa(m, id)
            id++
      }

      Dim A(10)<<Foo(20)
      \\ for each arrayitem call Foo(20)
      TestThis()

      \\  call once foo(20) and result copy to each array item
      Dim A(10)=Foo(20)
      TestThis()

      Bar=Lambda Foo (m)->{
            ->Foo(m)
      }
      \\ Not only the same id, but the same group
      \\ each item is pointer to group
      Dim A(10)=Bar(20)
      TestThis()

      Sub TestThis()
            Local i
            For i=0 to 9 {
                  For A(i){
                        .x++
                         Print .id , .x
                  }
            }
            Print
      End Sub
}
Checkit


import sequtils, strutils

# Creating a sequence containing sequences of integers.
var s1 = newSeq[seq[int]](5)
for item in s1.mitems: item = @[1]
echo "s1 = ", s1   # @[@[1], @[1], @[1], @[1], @[1]]
s1[0].add 2
echo "s1 = ", s1   # @[@[1, 2], @[1], @[1], @[1], @[1]]

# Using newSeqWith.
var s2 = newSeqWith(5, @[1])
echo "s2 = ", s2   # @[@[1], @[1], @[1], @[1], @[1]]
s2[0].add 2
echo "s2 = ", s2   # @[@[1, 2], @[1], @[1], @[1], @[1]]

# Creating a sequence containing pointers.
proc newInt(n: int): ref int =
  new(result)
  result[] = n
var s3 = newSeqWith(5, newInt(1))
echo "s3 contains references to ", s3.mapIt(it[]).join(", ")   # 1, 1, 1, 1, 1
s3[0][] = 2
echo "s3 contains references to ", s3.mapIt(it[]).join(", ")   # 2, 1, 1, 1, 1

# How to create non distinct elements.
let p = newInt(1)
var s4 = newSeqWith(5, p)
echo "s4 contains references to ", s4.mapIt(it[]).join(", ")   # 1, 1, 1, 1, 1
s4[0][] = 2
echo "s4 contains references to ", s4.mapIt(it[]).join(", ")   # 2, 2, 2, 2, 2


Array.make n (new foo);;
(* here (new foo) can be any expression that returns a new object,
   record, array, or string *)


ListBuffer init(10, #[ Float rand ]) println


-- get an array of directory objects
array = fillArrayWith(3, .directory)
say "each object will have a different identityHash"
say
loop d over array
    say d d~identityHash
end

::routine fillArrayWith
  use arg size, class

  array = .array~new(size)
  loop i = 1 to size
      -- Note, this assumes this object class can be created with
      -- no arguments
      array[i] = class~new
  end

return array


declare
  Xs = {MakeList 5} %% a list of 5 unbound variables
in
  {ForAll Xs OS.rand} %% fill it with random numbers (CORRECT)
  {Show Xs}


(Foo->new) x $n
# here Foo->new can be any expression that returns a reference representing
# a new object


with javascript_semantics
sequence s = repeat("x",6)          ?s
    s[$] = 5                        ?s
    s[1] &= 'y'                     ?s
--  s[2] = s                        ?s
    s[2] = deep_copy(s)             ?s


1..3 | ForEach-Object {((Get-Date -Hour ($_ + (1..4 | Get-Random))).AddDays($_ + (1..4 | Get-Random)))} |
       Select-Object -Unique |
       ForEach-Object {$_.ToString()}


n=Random(50)+25
Dim A.i(n)
; Creates a Array of n [25-75] elements depending on the outcome of Random().
; Each element will be initiated to zero.

For i=0 To ArraySize(A())
  A(i)=2*i
Next i
; Set each individual element at a wanted (here 2*i) value and
; automatically adjust accordingly to the unknown length of the Array.

NewList *PointersToA()
For i=0 To ArraySize(A())
  AddElement(*PointersToA())
  *PointersToA()=@A(i)
Next
; Create a linked list of the same length as A() above.
; Each element is then set to point to the Array element
; of the same order.

ForEach *PointersToA()
  Debug PeekI(*PointersToA())
Next
; Verify by sending each value of A() via *PointersToA()
; to the debugger's output.


[Foo()] * n # here Foo() can be any expression that returns a new object


rep(foo(), n)        # foo() is any code returning a value


#lang racket

;; a list of 10 references to the same vector
(make-list 10 (make-vector 10 0))

;; a list of 10 distinct vectors
(build-list 10 (λ (n) (make-vector 10 0)))


/*REXX program does a list comprehension that will create N random integers, all unique.*/
parse arg n lim .                                /*obtain optional argument from the CL.*/
if   n=='' |   n==","  then   n=   1000          /*Not specified?  Then use the default.*/
if lim=='' | lim==","  then lim= 100000          /* "      "         "   "   "     "    */
lim= min(lim, 1e5)                               /*limit the random range if necessary. */
randoms=                                         /*will contain random list of integers.*/
$= .
        do j=1  for n                            /*gen a unique random integer for list.*/

             do until wordpos($, randoms)==0     /*ensure    "      "      "     "    " */
             $= random(0, lim)                   /*Not unique?  Then obtain another int.*/
             end   /*until*/                     /*100K is the maximum range for RANDOM.*/

        randoms= $ randoms                       /*add an unique random integer to list.*/
        end   /*j*/

say  words(randoms) ' unique numbers generated.' /*stick a fork in it,  we're all done. */


[Foo.new] * n         # here Foo.new can be any expression that returns a new object
Array.new(n, Foo.new)


use std::rc::Rc;
use std::cell::RefCell;

fn main() {
    let size = 3;

    // Clone the given element to fill out the vector.
    let mut v: Vec<String> = vec![String::new(); size];
    v[0].push('a');
    println!("{:?}", v);

    // Run a given closure to create each element.
    let mut v: Vec<String> = (0..size).map(|i| i.to_string()).collect();
    v[0].push('a');
    println!("{:?}", v);

    // For multiple mutable views of the same thing, use something like Rc and RefCell.
    let v: Vec<Rc<RefCell<String>>> = vec![Rc::new(RefCell::new(String::new())); size];
    v[0].borrow_mut().push('a');
    println!("{:?}", v);
}


sash[r7rs]> (define-record-type <a> (make-a x) a? (x get-x))
#<unspecified>
sash[r7rs]> (define l1 (make-list 5 (make-a 3)))
#<unspecified>
sash[r7rs]> (eq? (list-ref l1 0) (list-ref l1 1))
#t


$ include "seed7_05.s7i";

const func array file: openFiles (in array string: fileNames) is func
  result
    var array file: fileArray is 0 times STD_NULL;  # Define array variable
  local
    var integer: i is 0;
  begin
    fileArray := length(fileNames) times STD_NULL;  # Array size computed at run-time
    for key i range fileArray do
      fileArray[i] := open(fileNames[i], "r");      # Assign multiple distinct objects
    end for;
  end func;

const proc: main is func
  local
    var array file: files is 0 times STD_NULL;
  begin
    files := openFiles([] ("abc.txt", "def.txt", "ghi.txt", "jkl.txt"));
  end func;


[Foo.new] * n;      # incorrect (only one distinct object is created)


|c|
"Create an ordered collection that will grow while we add elements"
c := OrderedCollection new.
"fill the collection with 9 arrays of 10 elements; elements (objects)
 are initialized to the nil object, which is a well-defined 'state'"
1 to: 9 do: [ :i | c add: (Array new: 10) ].
"However, let us show a way of filling the arrays with object number 0"
c := OrderedCollection new.
1 to: 9 do: [ :i | c add: ((Array new: 10) copyReplacing: nil withObject: 0) ].
"demonstrate that the arrays are distinct: modify the fourth of each"
1 to: 9 do: [ :i | (c at: i) at: 4 put: i ].
"show it"
c do: [ :e | e printNl ].


class Foo { }

var foos = [Foo]()
for i in 0..<n {
    foos.append(Foo())
}

// incorrect version:
var foos_WRONG = [Foo](count: n, repeatedValue: Foo())  // Foo() only evaluated once


package require TclOO

# The class that we want to make unique instances of
set theClass Foo

# Wrong version; only a single object created
set theList [lrepeat $n [$theClass new]]

# Right version; objects distinct
set theList {}
for {set i 0} {$i<$n} {incr i} {
    lappend theList [$theClass new]
}


class Foo {
    static init() { __count = 0 } // set object counter to zero

    construct new() {
        __count = __count + 1 // increment object counter
        _number = __count // allocates a unique number to each object created
    }

    number { _number }
}

Foo.init() // set object counter to zero
var n = 10 // say
// Create a List of 'n' distinct Foo objects
var foos = List.filled(n, null)
for (i in 0...foos.count) foos[i] = Foo.new()
// Show they're distinct by printing out their object numbers
foos.each { |f| System.write("%(f.number) ") }
System.print("\n")

// Now create a second List where each of the 'n' elements is the same Foo object
var foos2 = List.filled(n, Foo.new())
// Show they're the same by printing out their object numbers
foos2.each { |f| System.write("%(f.number) ") }
System.print()


code Reserve=3, IntIn=10;
char A;  int  N, I;
[N:= IntIn(8);                  \get number of items from command line
A:= Reserve(N);                 \create array of N bytes
for I:= 0 to N-1 do A(I):= I*3; \initialize items with different values
for I:= 0 to N-1 do A:= I*3;    \error: "references to the same mutable object"
]


sub test()
	print "Random number: " + str$(ran(100))
end sub

sub repL$(e$, n)
	local i, r$

	for i = 1 to n
		r$ = r$ + "," + e$
	next
	return r$
end sub

dim func$(1)

n = token(repL$("test", 5), func$(), ",")

for i = 1 to n
	execute(func$(i))
next i


ld hl,RamArea ;a label for an arbitrary section of RAM
ld a,(foo)    ;load the value of some memory location. "foo" is the label of a 16-bit address.
ld b,a        ;use this as a loop counter.
xor a         ;set A to zero

loop:         ;creates a list of ascending values starting at zero. Each is stored at a different memory location
ld (hl),a     ;store A in ram
inc a         ;ensures each value is different.
inc hl        ;next element of list
djnz loop


n:=3;
n.pump(List) //-->L(0,1,2)

n.pump(List,List) //-->L(0,1,2), not expected
  because the second list can be used to describe a calculation
n.pump(List,List(Void,List)) //--> L(L(),L(),L()) all same
   List(Void,List) means returns List, which is a "known" value
n.pump(List,List.fpM("-")) //--> L(L(),L(),L()) all distinct
   fpM is partial application: call List.create()

n.pump(List,(0.0).random.fp(1)) //--> 3 [0,1) randoms
L(0.902645,0.799657,0.0753809)

n.pump(String) //-->"012", default action is id function

class C{ var n; fcn init(x){n=x} }
n.pump(List,C) //--> L(C,C,C)
n.pump(List,C).apply("n") //-->L(0,1,2) ie all classes distinct


T PExp
   BigInt prime
   Int exp
   F (prime, exp)
      .prime = prime
      .exp = exp

F isqrt(self)
   V b = self
   L
      V a = b
      b = (self I/ a + a) I/ 2
      I b >= a
         R a

F factor(BigInt n)
   [PExp] pf
   V nn = n
   V b = 0
   L ((nn % 2) == 0)
      nn I/= 2
      b++

   I b > 0
      pf [+]= PExp(BigInt(2), b)

   V s = isqrt(nn)
   V d = BigInt(3)
   L nn > 1
      I d > s
         d = nn
      V e = 0
      L
         V (div, rem) = divmod(nn, d)
         I bit_length(rem) > 0
            L.break
         nn = div
         e++

      I e > 0
         pf [+]= PExp(d, e)
         s = isqrt(nn)

      d += 2

   R pf

F moBachShallit58(BigInt a, BigInt n; pf)
   V n1 = n - 1
   V mo = BigInt(1)
   L(pe) pf
      V y = n1 I/ pow(pe.prime, BigInt(pe.exp))
      V o = 0
      V x = pow(a, y, n)
      L x > 1
         x = pow(x, pe.prime, n)
         o++
      V o1 = pow(pe.prime, BigInt(o))
      o1 I/= gcd(mo, o1)
      mo *= o1
   R mo

F moTest(a, n)
   I bit_length(a) < 100
      print(‘ord(’a‘)’, end' ‘’)
   E
      print(‘ord([big])’, end' ‘’)
   print(‘ mod ’n‘ = ’moBachShallit58(a, n, factor(n - 1)))

moTest(37, 3343)

moTest(pow(BigInt(10), 100) + 1, 7919)
moTest(pow(BigInt(10), 1000) + 1, 15485863)
moTest(pow(BigInt(10), 10000) - 1, BigInt(22801763489))

moTest(1511678068, 7379191741)
moTest(BigInt(‘3047753288’), BigInt(‘2257683301’))


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;


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
)


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;
}


using System;
using System.Collections.Generic;
using System.Numerics;
using System.Threading;

namespace MultiplicativeOrder {
    // Taken from https://stackoverflow.com/a/33918233
    public static class PrimeExtensions {
        // Random generator (thread safe)
        private static ThreadLocal<Random> s_Gen = new ThreadLocal<Random>(
          () => {
              return new Random();
          }
        );

        // Random generator (thread safe)
        private static Random Gen {
            get {
                return s_Gen.Value;
            }
        }

        public static bool IsProbablyPrime(this BigInteger value, int witnesses = 10) {
            if (value <= 1)
                return false;

            if (witnesses <= 0)
                witnesses = 10;

            BigInteger d = value - 1;
            int s = 0;

            while (d % 2 == 0) {
                d /= 2;
                s += 1;
            }

            byte[] bytes = new byte[value.ToByteArray().LongLength];
            BigInteger a;

            for (int i = 0; i < witnesses; i++) {
                do {
                    Gen.NextBytes(bytes);

                    a = new BigInteger(bytes);
                }
                while (a < 2 || a >= value - 2);

                BigInteger x = BigInteger.ModPow(a, d, value);
                if (x == 1 || x == value - 1)
                    continue;

                for (int r = 1; r < s; r++) {
                    x = BigInteger.ModPow(x, 2, value);

                    if (x == 1)
                        return false;
                    if (x == value - 1)
                        break;
                }

                if (x != value - 1)
                    return false;
            }

            return true;
        }
    }

    static class Helper {
        public static BigInteger Sqrt(this BigInteger self) {
            BigInteger b = self;
            while (true) {
                BigInteger a = b;
                b = self / a + a >> 1;
                if (b >= a) return a;
            }
        }

        public static long BitLength(this BigInteger self) {
            BigInteger bi = self;
            long bitlength = 0;
            while (bi != 0) {
                bitlength++;
                bi >>= 1;
            }
            return bitlength;
        }

        public static bool BitTest(this BigInteger self, int pos) {
            byte[] arr = self.ToByteArray();
            int idx = pos / 8;
            int mod = pos % 8;
            if (idx >= arr.Length) {
                return false;
            }
            return (arr[idx] & (1 << mod)) > 0;
        }
    }

    class PExp {
        public PExp(BigInteger prime, int exp) {
            Prime = prime;
            Exp = exp;
        }

        public BigInteger Prime { get; }

        public int Exp { get; }
    }

    class Program {
        static void MoTest(BigInteger a, BigInteger n) {
            if (!n.IsProbablyPrime(20)) {
                Console.WriteLine("Not computed. Modulus must be prime for this algorithm.");
                return;
            }
            if (a.BitLength() < 100) {
                Console.Write("ord({0})", a);
            } else {
                Console.Write("ord([big])");
            }
            if (n.BitLength() < 100) {
                Console.Write(" mod {0} ", n);
            } else {
                Console.Write(" mod [big] ");
            }
            BigInteger mob = MoBachShallit58(a, n, Factor(n - 1));
            Console.WriteLine("= {0}", mob);
        }

        static BigInteger MoBachShallit58(BigInteger a, BigInteger n, List<PExp> pf) {
            BigInteger n1 = n - 1;
            BigInteger mo = 1;
            foreach (PExp pe in pf) {
                BigInteger y = n1 / BigInteger.Pow(pe.Prime, pe.Exp);
                int o = 0;
                BigInteger x = BigInteger.ModPow(a, y, BigInteger.Abs(n));
                while (x > 1) {
                    x = BigInteger.ModPow(x, pe.Prime, BigInteger.Abs(n));
                    o++;
                }
                BigInteger o1 = BigInteger.Pow(pe.Prime, o);
                o1 = o1 / BigInteger.GreatestCommonDivisor(mo, o1);
                mo = mo * o1;
            }
            return mo;
        }

        static List<PExp> Factor(BigInteger n) {
            List<PExp> pf = new List<PExp>();
            BigInteger nn = n;
            int e = 0;
            while (!nn.BitTest(e)) e++;
            if (e > 0) {
                nn = nn >> e;
                pf.Add(new PExp(2, e));
            }
            BigInteger s = nn.Sqrt();
            BigInteger d = 3;
            while (nn > 1) {
                if (d > s) d = nn;
                e = 0;
                while (true) {
                    BigInteger div = BigInteger.DivRem(nn, d, out BigInteger rem);
                    if (rem.BitLength() > 0) break;
                    nn = div;
                    e++;
                }
                if (e > 0) {
                    pf.Add(new PExp(d, e));
                    s = nn.Sqrt();
                }
                d = d + 2;
            }

            return pf;
        }

        static void Main(string[] args) {
            MoTest(37, 3343);
            MoTest(BigInteger.Pow(10, 100) + 1, 7919);
            MoTest(BigInteger.Pow(10, 1000) + 1, 15485863);
            MoTest(BigInteger.Pow(10, 10000) - 1, 22801763489);
            MoTest(1511678068, 7379191741);
            MoTest(3047753288, 2257683301);
        }
    }
}


#include <algorithm>
#include <bitset>
#include <iostream>
#include <vector>

typedef unsigned long ulong;
std::vector<ulong> primes;

typedef struct {
    ulong p, e;
} prime_factor; /* prime, exponent */

void sieve() {
    /* 65536 = 2^16, so we can factor all 32 bit ints */
    constexpr int SIZE = 1 << 16;

    std::bitset<SIZE> bits;
    bits.flip(); // set all bits
    bits.reset(0);
    bits.reset(1);
    for (int i = 0; i < 256; i++) {
        if (bits.test(i)) {
            for (int j = i * i; j < SIZE; j += i) {
                bits.reset(j);
            }
        }
    }

    /* collect primes into a list. slightly faster this way if dealing with large numbers */
    for (int i = 0; i < SIZE; i++) {
        if (bits.test(i)) {
            primes.push_back(i);
        }
    }
}

auto get_prime_factors(ulong n) {
    std::vector<prime_factor> lst;
    ulong e, p;

    for (ulong i = 0; i < primes.size(); i++) {
        p = primes[i];
        if (p * p > n) break;
        for (e = 0; !(n % p); n /= p, e++);
        if (e) {
            lst.push_back({ p, e });
        }
    }

    if (n != 1) {
        lst.push_back({ n, 1 });
    }
    return lst;
}

auto get_factors(ulong n) {
    auto f = get_prime_factors(n);
    std::vector<ulong> lst{ 1 };

    size_t len2 = 1;
    /* L = (1); L = (L, L * p**(1 .. e)) forall((p, e)) */
    for (size_t i = 0; i < f.size(); i++, len2 = lst.size()) {
        for (ulong j = 0, p = f[i].p; j < f[i].e; j++, p *= f[i].p) {
            for (size_t k = 0; k < len2; k++) {
                lst.push_back(lst[k] * p);
            }
        }
    }

    std::sort(lst.begin(), lst.end());
    return lst;
}

ulong mpow(ulong a, ulong p, ulong m) {
    ulong r = 1;
    while (p) {
        if (p & 1) {
            r = r * a % m;
        }
        a = a * a % m;
        p >>= 1;
    }
    return r;
}

ulong ipow(ulong a, ulong p) {
    ulong r = 1;
    while (p) {
        if (p & 1) 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 m = ipow(p, e);
    ulong t = m / p * (p - 1);
    auto fac = get_factors(t);
    for (size_t i = 0; i < fac.size(); i++) {
        if (mpow(a, fac[i], m) == 1) {
            return fac[i];
        }
    }
    return 0;
}

ulong multi_order(ulong a, ulong m) {
    auto pf = get_prime_factors(m);
    ulong res = 1;
    for (size_t i = 0; i < pf.size(); 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));   // expect 100
    printf("%lu\n", multi_order(54, 100001)); // expect 9090

    return 0;
}


(defn gcd [a b]
   (if (zero? b)
      a
      (recur b (mod a b))))

(defn lcm [a b]
   (/ (* a b) (gcd a b)))

(def NaN  (Math/log -1))

(defn ord' [a [p e]]
   (let [m   (imath/expt p e)
         t   (* (quot m p) (dec p))]
            (loop [dv (factor/divisors t)]
               (let [d (first dv)]
                  (if (= (mmath/expm a d m) 1)
                     d
                     (recur (next dv)))))))

(defn ord [a n]
   (if (not= (gcd a n) 1)
      NaN
      (->>
         (factor/factorize n)
         (map (partial ord' a))
         (reduce lcm))))


import std.bigint;
import std.random;
import std.stdio;

struct PExp {
    BigInt prime;
    int exp;
}

BigInt gcd(BigInt x, BigInt y) {
    if (y == 0) {
        return x;
    }
    return gcd(y, x % y);
}

/// https://en.wikipedia.org/wiki/Modular_exponentiation#Right-to-left_binary_method
BigInt modPow(BigInt b, BigInt e, BigInt n) {
    if (n == 1) return BigInt(0);
    BigInt result = 1;
    b = b % n;
    while (e > 0) {
        if (e % 2 == 1) {
            result = (result * b) % n;
        }
        e >>= 1;
        b = (b*b) % n;
    }
    return result;
}

BigInt pow(long b, long e) {
    return pow(BigInt(b), BigInt(e));
}
BigInt pow(BigInt b, BigInt e) {
    if (e == 0) {
        return BigInt(1);
    }

    BigInt result = 1;
    while (e > 1) {
        if (e % 2 == 0) {
            b *= b;
            e /= 2;
        } else {
            result *= b;
            b *= b;
            e = (e - 1) / 2;
        }
    }

    return b * result;
}

BigInt sqrt(BigInt self) {
    BigInt b = self;
    while (true) {
        BigInt a = b;
        b = self / a + a >> 1;
        if (b >= a) return a;
    }
}

long bitLength(BigInt self) {
    BigInt bi = self;
    long length;
    while (bi != 0) {
        length++;
        bi >>= 1;
    }
    return length;
}

PExp[] factor(BigInt n) {
    PExp[] pf;
    BigInt nn = n;
    int b = 0;
    int e = 1;
    while ((nn & e) == 0) {
        e <<= 1;
        b++;
    }
    if (b > 0) {
        nn = nn >> b;
        pf ~= PExp(BigInt(2), b);
    }
    BigInt s = nn.sqrt();
    BigInt d = 3;
    while (nn > 1) {
        if (d > s) d = nn;
        e = 0;
        while (true) {
            BigInt div, rem;
            nn.divMod(d, div, rem);
            if (rem.bitLength > 0) break;
            nn = div;
            e++;
        }
        if (e > 0) {
            pf ~= PExp(d, e);
            s = nn.sqrt();
        }
        d += 2;
    }

    return pf;
}

BigInt moBachShallit58(BigInt a, BigInt n, PExp[] pf) {
    BigInt n1 = n - 1;
    BigInt mo = 1;
    foreach(pe; pf) {
        BigInt y = n1 / pe.prime.pow(BigInt(pe.exp));
        int o = 0;
        BigInt x = a.modPow(y, n);
        while (x > 1) {
            x = x.modPow(pe.prime, n);
            o++;
        }
        BigInt o1 = pe.prime.pow(BigInt(o));
        o1 = o1 / gcd(mo, o1);
        mo = mo * o1;
    }
    return mo;
}

void moTest(ulong a, ulong n) {
    moTest(BigInt(a), n);
}
void moTest(BigInt a, ulong n) {
    // Commented out because the implementations tried all failed for the -2 and -3 tests.
    // if (!n.isProbablePrime()) {
        // writeln("Not computed. Modulus must be prime for this algorithm.");
        // return;
    // }
    if (a.bitLength < 100) {
        write("ord(", a, ")");
    } else {
        write("ord([big])");
    }
    write(" mod ", n, " ");
    BigInt nn = n;
    BigInt mob = moBachShallit58(a, nn, factor(nn - 1));
    writeln("= ", mob);
}

void main() {
    moTest(37, 3343);

    moTest(pow(10, 100) + 1, 7919);
    moTest(pow(10, 1000) + 1, 15485863);
    moTest(pow(10, 10000) - 1, 22801763489);

    moTest(1511678068, 7379191741);
    moTest(3047753288, 2257683301);
}


(require 'bigint)

;; factor-exp returns a list ((p k) ..) : a = p1^k1 * p2^k2 ..
(define (factor-exp a)
	(map (lambda (g) (list (first g) (length g)))
					(group* (prime-factors a))))

;; copied from Ruby
(define (_mult_order a p k  (x))
	(define pk (expt p k))
	(define t (* (1- p) (expt p (1- k))))
	(define r 1)
	(for [((q e) (factor-exp t))]
	    (set! x (powmod a (/ t (expt q e)) pk))
	    (while (!= x 1)
	    	(*= r q)
	    	(set! x (powmod x q pk))))
	r)

(define (order a m)
        "multiplicative order : (order a m) →  n : a^n = 1 (mod m)"
	(assert (= 1 (gcd a m)) "a and m must be coprimes")
	(define mopks (for/list [((p k)  (factor-exp m))] (_mult_order a p k)))
	(for/fold (n 1) ((mopk mopks)) (lcm n mopk)))

;; results
order 37 1000)
   → 100
(order (+ (expt 10 100) 1) 7919)
   → 3959
(order (+ (expt 10 1000) 1) 15485863)
   → 15485862


USING: kernel math math.functions math.primes.factors sequences ;

: (ord) ( a pair -- n )
    first2 dupd ^ swap dupd [ /i ] keep 1 - * divisors
    [ swap ^mod 1 = ] 2with find nip ;

: ord ( a n -- m )
    2dup gcd nip 1 =
    [ group-factors [ (ord) ] with [ lcm ] map-reduce ]
    [ 2drop 0/0. ] if ;


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)
}


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"


import java.math.BigInteger;
import java.util.ArrayList;
import java.util.List;

public class MultiplicativeOrder {
    private static final BigInteger ONE = BigInteger.ONE;
    private static final BigInteger TWO = BigInteger.valueOf(2);
    private static final BigInteger THREE = BigInteger.valueOf(3);
    private static final BigInteger TEN = BigInteger.TEN;

    private static class PExp {
        BigInteger prime;
        long exp;

        PExp(BigInteger prime, long exp) {
            this.prime = prime;
            this.exp = exp;
        }
    }

    private static void moTest(BigInteger a, BigInteger n) {
        if (!n.isProbablePrime(20)) {
            System.out.println("Not computed. Modulus must be prime for this algorithm.");
            return;
        }
        if (a.bitLength() < 100) System.out.printf("ord(%s)", a);
        else System.out.print("ord([big])");
        if (n.bitLength() < 100) System.out.printf(" mod %s ", n);
        else System.out.print(" mod [big] ");
        BigInteger mob = moBachShallit58(a, n, factor(n.subtract(ONE)));
        System.out.println("= " + mob);
    }

    private static BigInteger moBachShallit58(BigInteger a, BigInteger n, List<PExp> pf) {
        BigInteger n1 = n.subtract(ONE);
        BigInteger mo = ONE;
        for (PExp pe : pf) {
            BigInteger y = n1.divide(pe.prime.pow((int) pe.exp));
            long o = 0;
            BigInteger x = a.modPow(y, n.abs());
            while (x.compareTo(ONE) > 0) {
                x = x.modPow(pe.prime, n.abs());
                o++;
            }
            BigInteger o1 = BigInteger.valueOf(o);
            o1 = pe.prime.pow(o1.intValue());
            o1 = o1.divide(mo.gcd(o1));
            mo = mo.multiply(o1);
        }
        return mo;
    }

    private static List<PExp> factor(BigInteger n) {
        List<PExp> pf = new ArrayList<>();
        BigInteger nn = n;
        Long e = 0L;
        while (!nn.testBit(e.intValue())) e++;
        if (e > 0L) {
            nn = nn.shiftRight(e.intValue());
            pf.add(new PExp(TWO, e));
        }
        BigInteger s = sqrt(nn);
        BigInteger d = THREE;
        while (nn.compareTo(ONE) > 0) {
            if (d.compareTo(s) > 0) d = nn;
            e = 0L;
            while (true) {
                BigInteger[] qr = nn.divideAndRemainder(d);
                if (qr[1].bitLength() > 0) break;
                nn = qr[0];
                e++;
            }
            if (e > 0L) {
                pf.add(new PExp(d, e));
                s = sqrt(nn);
            }
            d = d.add(TWO);
        }
        return pf;
    }

    private static BigInteger sqrt(BigInteger n) {
        BigInteger b = n;
        while (true) {
            BigInteger a = b;
            b = n.divide(a).add(a).shiftRight(1);
            if (b.compareTo(a) >= 0) return a;
        }
    }

    public static void main(String[] args) {
        moTest(BigInteger.valueOf(37), BigInteger.valueOf(3343));

        BigInteger b = TEN.pow(100).add(ONE);
        moTest(b, BigInteger.valueOf(7919));

        b = TEN.pow(1000).add(ONE);
        moTest(b, BigInteger.valueOf(15485863));

        b = TEN.pow(10000).subtract(ONE);
        moTest(b, BigInteger.valueOf(22801763489L));

        moTest(BigInteger.valueOf(1511678068), BigInteger.valueOf(7379191741L));
        moTest(BigInteger.valueOf(3047753288L), BigInteger.valueOf(2257683301L));
    }
}


using Primes

function factors(n)
    f = [one(n)]
    for (p,e) in factor(n)
        f = reduce(vcat, [f*p^j for j in 1:e], init=f)
    end
    return length(f) == 1 ? [one(n), n] : sort!(f)
end

function multorder(a, m)
    gcd(a,m) == 1 || error("$a and $m are not coprime")
    res = one(m)
    for (p,e) in factor(m)
        m = p^e
        t = div(m, p) * (p-1)
        for f in factors(t)
            if powermod(a, f, m) == 1
                res = lcm(res, f)
                break
            end
        end
    end
    res
end


// version 1.2.10

import java.math.BigInteger

val bigOne   = BigInteger.ONE
val bigTwo   = 2.toBigInteger()
val bigThree = 3.toBigInteger()
val bigTen   = BigInteger.TEN

class PExp(val prime: BigInteger, val exp: Long)

fun moTest(a: BigInteger, n: BigInteger) {
    if (!n.isProbablePrime(20)) {
        println("Not computed. Modulus must be prime for this algorithm.")
        return
    }
    if (a.bitLength() < 100) print("ord($a)") else print("ord([big])")
    if (n.bitLength() < 100) print(" mod $n ") else print(" mod [big] ")
    val mob = moBachShallit58(a, n, factor(n - bigOne))
    println("= $mob")
}

fun moBachShallit58(a: BigInteger, n: BigInteger, pf: List<PExp>): BigInteger {
    val n1 = n - bigOne
    var mo = bigOne
    for (pe in pf) {
        val y = n1 / pe.prime.pow(pe.exp.toInt())
        var o = 0L
        var x = a.modPow(y, n.abs())
        while (x > bigOne) {
            x = x.modPow(pe.prime, n.abs())
            o++
        }
        var o1 = o.toBigInteger()
        o1 = pe.prime.pow(o1.toInt())
        o1 /= mo.gcd(o1)
        mo *= o1
    }
    return mo
}

fun factor(n: BigInteger): List<PExp> {
    val pf = mutableListOf<PExp>()
    var nn = n
    var e = 0L
    while (!nn.testBit(e.toInt())) e++
    if (e > 0L) {
        nn = nn shr e.toInt()
        pf.add(PExp(bigTwo, e))
    }
    var s = bigSqrt(nn)
    var d = bigThree
    while (nn > bigOne) {
        if (d > s) d = nn
        e = 0L
        while (true) {
            val (q, r) = nn.divideAndRemainder(d)
            if (r.bitLength() > 0) break
            nn = q
            e++
        }
        if (e > 0L) {
            pf.add(PExp(d, e))
            s = bigSqrt(nn)
        }
        d += bigTwo
    }
    return pf
}

fun bigSqrt(n: BigInteger): BigInteger {
    var b = n
    while (true) {
        val a = b
        b = (n / a + a) shr 1
        if (b >= a) return a
    }
}

fun main(args: Array<String>) {
    moTest(37.toBigInteger(), 3343.toBigInteger())

    var b = bigTen.pow(100) + bigOne
    moTest(b, 7919.toBigInteger())

    b = bigTen.pow(1000) + bigOne
    moTest(b, BigInteger("15485863"))

    b = bigTen.pow(10000) - bigOne
    moTest(b, BigInteger("22801763489"))

    moTest(BigInteger("1511678068"), BigInteger("7379191741"))
    moTest(BigInteger("3047753288"), BigInteger("2257683301"))
}


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]


import strformat
import bignum

type PExp = tuple[prime: Int; exp: uint]

let
  one = newInt(1)
  two = newInt(2)
  ten = newInt(10)

func sqrt(n: Int): Int =
  var s = n
  while true:
    result = s
    s = (n div result + result) shr 1
    if s >= result: break

proc factor(n: Int): seq[PExp] =
  var n = n
  var e = 0u
  while n.bit(e) == 0: inc e
  if e != 0:
    n = n shr e
    result.add (two, e)
  var s = sqrt(n)
  var d = newInt(3)
  while n > one:
    if d > s: d = n
    e = 0u
    while true:
      let (q, r) = divMod(n, d)
      if not r.isZero: break
      n = q
      inc e
    if e != 0:
      result.add (d.clone, e)
      s = sqrt(n)
    inc d, two

proc moBachShallit58(a, n: Int; pf: seq[PExp]): Int =
  let n = abs(n)
  let n1 = n - one
  result = newInt(1)
  for pe in pf:
    let y = n1 div pe.prime.pow(pe.exp)
    var o = 0u
    var x = a.exp(y.toInt.uint, n)
    while x > one:
      x = x.exp(pe.prime.toInt.uint, n)
      inc o
    var o1 = pe.prime.pow(o)
    o1 = o1 div gcd(result, o1)
    result *= o1

proc moTest(a, n: Int) =
  if n.probablyPrime(25) == 0:
    echo "Not computed. Modulus must be prime for this algorithm."
    return

  stdout.write if a.bitLen < 100: &"ord({a})" else: "ord([big])"
  stdout.write if n.bitlen < 100: &" mod {n}" else: " mod [big]"
  let mob = moBachShallit58(a, n, factor(n - one))
  echo &" = {mob}"

when isMainModule:
  moTest(newInt(37), newInt(3343))

  var b = ten.pow(100) + one
  motest(b, newInt(7919))

  b = ten.pow(1000) + one
  moTest(b, newInt("15485863"))

  b = ten.pow(10000) - one
  moTest(b, newInt("22801763489"))

  moTest(newInt("1511678068"), newInt("7379191741"))

  moTest(newInt("3047753288"), newInt("2257683301"))


use ntheory qw/znorder/;
say znorder(54, 100001);
use bigint; say znorder(11, 1 + 10**100);


with javascript_semantics
include mpfr.e

procedure multi_order(mpz res, a, sequence p_and_k)
    mpz {pk,t,x,q,pz} = mpz_inits(5)
    mpz_set_si(res,1)
    if length(p_and_k)=1 then
        string {ps} = p_and_k
        mpz_set_str(pk,ps)
        mpz_sub_ui(t,pk,1)
    else
        atom {p, k} = p_and_k
        mpz_set_d(pz,p)
        mpz_pow_ui(pk,pz,k)
        mpz_pow_ui(t,pz,k-1)
        mpz_sub_ui(pz,pz,1)
        mpz_mul(t,t,pz)
    end if
    sequence pf = mpz_prime_factors(t)
    for i=1 to length(pf) do
        if length(pf[i])=1 then
            string {fs} = pf[i]
            mpz_set_str(q,fs)
            mpz_set(x,q)
        else
            {integer qi, integer ei} = pf[i]
            mpz_set_si(q,qi)
            mpz_pow_ui(x,q,ei)
        end if
        mpz_fdiv_q(x, t, x)
        mpz_powm(x,a,x,pk)
        integer guard = 0
        while mpz_cmp_si(x,1)!=0 do
            mpz_mul(res,res,q)
            mpz_powm(x,x,q,pk)
            guard += 1
            if guard>100 then ?9/0 end if -- (increase if rqd)
        end while
    end for
    x = mpz_free(x)
end procedure

function multiplicative_order(mpz a, m)
    mpz res = mpz_init(1),
        ri = mpz_init()
    mpz_gcd(ri,a,m)
    if mpz_cmp_si(ri,1)!=0 then return "(a,m) not coprime" end if
    sequence pf = mpz_prime_factors(m,10000) -- (increase if rqd)
    for i=1 to length(pf) do
        multi_order(ri,a,pf[i])
        mpz_lcm(res,res,ri)
    end for
    return mpz_get_str(res)
end function

function shorta(mpz n)
    string res = mpz_get_str(n)
    integer lr = length(res)
    if lr>80 then
        res[6..-6] = "..."
        res &= sprintf(" (%d digits)",lr)
    end if
    return res
end function

procedure mo_test(mpz a, n)
    string res = multiplicative_order(a, n)
    printf(1,"ord(%s) mod %s = %s\n",{shorta(a),shorta(n),res})
end procedure

function i(atom i) return mpz_init(i) end function -- (ugh)
function p10(integer e,i)   -- init to 10^e+i
    mpz res = mpz_init()
    mpz_ui_pow_ui(res,10,e)
    mpz_add_si(res,res,i)
    return res
end function

atom t = time()
mo_test(i(3), i(10))
mo_test(i(37), i(1000))
mo_test(i(37), i(10000))
mo_test(i(37), i(3343))
mo_test(i(37), i(3344))
mo_test(i(2), i(1000))
mo_test(p10(100,+1), i(7919))
mo_test(p10(1000,+1), i(15485863))
mo_test(p10(10000,-1), i(22801763489))
mo_test(i(1511678068), i(7379191741))
mo_test(i(3047753288), i(2257683301))
?"==="
mpz b = p10(20,-1)
mo_test(i(2), b)
mo_test(i(17),b)
mo_test(i(54),i(100001))
string s9090 = multiplicative_order(mpz_init(54),mpz_init(100001))
if s9090!="9090" then ?9/0 end if
mpz m54 = mpz_init(54),
    m100001 = mpz_init(100001)
mpz_powm_ui(b,m54,9090,m100001)
printf(1,"%s\n",mpz_get_str(b))
bool error = false
for r=1 to 9090-1 do
    mpz_powm_ui(b,m54,r,m100001)
    if mpz_cmp_si(b,1)=0 then
        printf(1,"mpz_powm_ui(54,%d,100001) gives 1!\n",r)
        error = true
        exit
    end if
end for
if not error then
    printf(1,"Everything checks. (%s)\n",{elapsed(time()-t)})
end if


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.'


#lang racket
(require math)

(define (order a n)
  (unless (coprime? a n) (error 'order "arguments must be coprime"))
  (for/fold ([o 1]) ([r (factorize n)])
    (lcm o (order1 a r))))

(define (order1 a p&e)
  (match-define (list p e) p&e)
  (define m (expt p e))
  (define t (* (- p 1) (expt p (- e 1))))
  (define qs
    (for/fold ([qs '(1)]) ([f (factorize t)])
       (match f [(list f0 f1)
                 (for*/list ([q qs] [j (in-range (+ 1 f1))])
                   (* q (expt f0 j)))])))
  (for/or ([q (sort qs <)] #:when (= (modular-expt a q m) 1)) q))

(order 37 1000)
(order (+ (expt 10 100) 1) 7919)
(order (+ (expt 10 1000) 1) 15485863)
(order (- (expt 10 10000) 1) 22801763489)
(order 13 (+ 1 (expt 10 80)))


/*REXX pgm computes multiplicative order of a minimum integer  N  such that  a^n mod m≡1*/
wa= 0;  wm= 0     /*       ═a═   ══m══     */    /*maximum widths of the A and M values.*/
@.=.;                @.1=   3      10
                     @.2=  37    1000
                     @.3=  37   10000
                     @.4=  37    3343
                     @.5=  37    3344
                     @.6=   2    1000
pad= left('', 9)
d= 500                                           /*use 500 decimal digits for a starter.*/
     do w=1  for 2                               /*when W≡1, find max widths of A and M.*/
       do j=1  while @.j\==.;         parse var  @.j     a  .  1  r  m  ,  n
       if w==1  then do;  wa= max(wa, length(a) );     wm= max(wm, length(m) );    iterate
                     end
       if m//a==0  then n= ' [solution not possible]'     /*test co─prime for  A and B. */
       numeric digits d                          /*start with  100  decimal digits.     */
       if n==''  then do n= 2;    p= r * a       /*compute product──may have an exponent*/
                      parse  var  p  'E'  _      /*try to extract the exponent from  P. */
                      if _\==''   then do;  numeric digits _+d  /*bump the decimal digs.*/
                                            p=r*a               /*recalculate integer P.*/
                                       end
                      if p//m==1  then leave     /*now, perform the nitty─gritty modulo.*/
                      r= p                       /*assign product to R for next multiply*/
                      end   /*n*/                /* [↑]    //   is really  ÷  remainder.*/
       say pad  'a='  right(a,wa)  pad  "m=" right(m,wm)  pad  'multiplicative order:'   n
       end   /*j*/
     end     /*w*/                               /*stick a fork in it,  we're all done. */


require 'prime'

def powerMod(b, p, m)
  p.to_s(2).each_char.inject(1) do |result, bit|
    result = (result * result) % m
    bit=='1' ? (result * b) % m : result
  end
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) do |result, f|
    result.lcm(multOrder_(a, *f))
  end
end

puts multOrder(37, 1000)
b = 10**20-1
puts multOrder(2, b)
puts multOrder(17,b)
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


$ include "seed7_05.s7i";
  include "bigint.s7i";

const type: oneFactor is new struct
    var bigInteger: prime is 0_;
    var integer: exp is 0;
  end struct;

const func oneFactor: oneFactor (in bigInteger: prime, in integer: exp) is func
  result
    var oneFactor: aFactor is oneFactor.value;
  begin
    aFactor.prime := prime;
    aFactor.exp := exp;
  end func;

const func array oneFactor: factor (in var bigInteger: n) is func
  result
    var array oneFactor: pf is 0 times oneFactor.value;
  local
    var integer: e is 0;
    var bigInteger: d is 0_;
    var bigInteger: s is 0_;
  begin
    e := lowestSetBit(n);
    if e > 0 then
      n >>:= e;
      pf := [] (oneFactor(2_, e));
    end if;
    s := sqrt(n);
    d := 3_;
    while n > 1_ do
      if d > s then
        d := n;
      end if;
      e := 0;
      while n rem d = 0_ do
        n := n div d;
        incr(e);
      end while;
      if e > 0 then
        pf &:= oneFactor(d, e);
        s := sqrt(n);
      end if;
      d +:= 2_;
    end while;
  end func;

const func bigInteger: moBachShallit58(in bigInteger: a, in bigInteger: n, in array oneFactor: pf) is func
  result
    var bigInteger: mo is 0_;
  local
    var bigInteger: n1 is 0_;
    var oneFactor: pe is oneFactor.value;
    var bigInteger: x is 0_;
    var bigInteger: y is 0_;
    var integer: o is 0;
    var bigInteger: o1 is 0_;
  begin
    n1 := n - 1_;
    mo := 1_;
    for pe range pf do
      y := n1 div pe.prime ** pe.exp;
      x := modPow(a, y, n);
      o := 0;
      while x > 1_ do
        x := modPow(x, pe.prime, n);
        incr(o);
      end while;
      o1 := pe.prime ** o;
      mo *:= o1 div gcd(mo, o1);
    end for;
  end func;

const func boolean: isProbablyPrime (in bigInteger: primeCandidate, in var integer: count) is func
  result
    var boolean: isProbablyPrime is TRUE;
  local
    var bigInteger: aRandomNumber is 0_;
  begin
    while isProbablyPrime and count > 0 do
      aRandomNumber := rand(1_, pred(primeCandidate));
      isProbablyPrime := modPow(aRandomNumber, pred(primeCandidate), primeCandidate) = 1_;
      decr(count);
    end while;
    # writeln(count);
  end func;

const proc: moTest (in bigInteger: a, in bigInteger: n) is func
  begin
    if bitLength(a) < 100 then
      write("ord(" <& a <& ")");
    else
      write("ord([big])");
    end if;
    if bitLength(n) < 100 then
      write(" mod " <& n <& " ");
    else
      write(" mod [big] ");
    end if;
    if not isProbablyPrime(n, 20) then
      writeln("not computed.  modulus must be prime for this algorithm.")
    else
      writeln("= " <& moBachShallit58(a, n, factor(n - 1_)));
    end if;
  end func;

const proc: main is func
  local
    var bigInteger: b is 100_;
  begin
    moTest(37_, 3343_);
    moTest(10_ ** 100 + 1_, 7919_);
    moTest(10_ ** 1000 + 1_, 15485863_);
    moTest(10_ ** 10000 - 1_, 22801763489_);
    moTest(1511678068_, 7379191741_);
    moTest(3047753288_, 2257683301_);
  end func;


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"


Imports System.Numerics
Imports System.Runtime.CompilerServices
Imports System.Threading

Module Module1
    Private s_gen As New ThreadLocal(Of Random)(Function() New Random())

    Private Function Gen()
        Return s_gen.Value
    End Function

    <Extension()>
    Public Function IsProbablyPrime(value As BigInteger, Optional witnesses As Integer = 10) As Boolean
        If value <= 1 Then
            Return False
        End If

        If witnesses <= 0 Then
            witnesses = 10
        End If

        Dim d = value - 1
        Dim s = 0

        While d Mod 2 = 0
            d /= 2
            s += 1
        End While

        Dim bytes(value.ToByteArray.LongLength - 1) As Byte
        Dim a As BigInteger

        For i = 1 To witnesses
            Do
                Gen.NextBytes(bytes)

                a = New BigInteger(bytes)
            Loop While a < 2 OrElse a >= value - 2

            Dim x = BigInteger.ModPow(a, d, value)
            If x = 1 OrElse x = value - 1 Then
                Continue For
            End If

            For r = 1 To s - 1
                x = BigInteger.ModPow(x, 2, value)

                If x = 1 Then
                    Return False
                End If
                If x = value - 1 Then
                    Exit For
                End If
            Next

            If x <> value - 1 Then
                Return False
            End If
        Next

        Return True
    End Function

    <Extension()>
    Function Sqrt(self As BigInteger) As BigInteger
        Dim b = self
        While True
            Dim a = b
            b = self / a + a >> 1
            If b >= a Then
                Return a
            End If
        End While
        Throw New Exception("Should not have happened")
    End Function

    <Extension()>
    Function BitLength(self As BigInteger) As Long
        Dim bi = self
        Dim len = 0L
        While bi <> 0
            len += 1
            bi >>= 1
        End While
        Return len
    End Function

    <Extension()>
    Function BitTest(self As BigInteger, pos As Integer) As Boolean
        Dim arr = self.ToByteArray
        Dim i = pos \ 8
        Dim m = pos Mod 8
        If i >= arr.Length Then
            Return False
        End If
        Return (arr(i) And (1 << m)) > 0
    End Function

    Class PExp
        Sub New(p As BigInteger, e As Integer)
            Prime = p
            Exp = e
        End Sub

        Public ReadOnly Property Prime As BigInteger
        Public ReadOnly Property Exp As Integer
    End Class

    Function MoBachShallit58(a As BigInteger, n As BigInteger, pf As List(Of PExp)) As BigInteger
        Dim n1 = n - 1
        Dim mo As BigInteger = 1
        For Each pe In pf
            Dim y = n1 / BigInteger.Pow(pe.Prime, pe.Exp)
            Dim o = 0
            Dim x = BigInteger.ModPow(a, y, BigInteger.Abs(n))
            While x > 1
                x = BigInteger.ModPow(x, pe.Prime, BigInteger.Abs(n))
                o += 1
            End While
            Dim o1 = BigInteger.Pow(pe.Prime, o)
            o1 /= BigInteger.GreatestCommonDivisor(mo, o1)
            mo *= o1
        Next
        Return mo
    End Function

    Function Factor(n As BigInteger) As List(Of PExp)
        Dim pf As New List(Of PExp)
        Dim nn = n
        Dim e = 0
        While Not nn.BitTest(e)
            e += 1
        End While
        If e > 0 Then
            nn >>= e
            pf.Add(New PExp(2, e))
        End If
        Dim s = nn.Sqrt
        Dim d As BigInteger = 3
        While nn > 1
            If d > s Then
                d = nn
            End If
            e = 0
            While True
                Dim remainder As New BigInteger
                Dim div = BigInteger.DivRem(nn, d, remainder)
                If remainder.BitLength > 0 Then
                    Exit While
                End If
                nn = div
                e += 1
            End While
            If e > 0 Then
                pf.Add(New PExp(d, e))
                s = nn.Sqrt
            End If
            d += 2
        End While
        Return pf
    End Function

    Sub MoTest(a As BigInteger, n As BigInteger)
        If Not n.IsProbablyPrime(20) Then
            Console.WriteLine("Not computed. Modulus must be prime for this algorithm.")
            Return
        End If
        If a.BitLength < 100 Then
            Console.Write("ord({0})", a)
        Else
            Console.Write("ord([big])")
        End If
        If n.BitLength < 100 Then
            Console.Write(" mod {0}", n)
        Else
            Console.Write(" mod [big]")
        End If
        Dim mob = MoBachShallit58(a, n, Factor(n - 1))
        Console.WriteLine(" = {0}", mob)
    End Sub

    Sub Main()
        MoTest(37, 3343)
        MoTest(BigInteger.Pow(10, 100) + 1, 7919)
        MoTest(BigInteger.Pow(10, 1000) + 1, 15485863)
        MoTest(BigInteger.Pow(10, 10000) - 1, 22801763489)
        MoTest(1511678068, 7379191741)
        MoTest(3047753288, 2257683301)
    End Sub

End Module


import "/big" for BigInt

class PExp {
    construct new(prime, exp) {
        _prime = prime
        _exp = exp
    }
    prime { _prime }
    exp   { _exp }
}

var moBachShallit58 = Fn.new { |a, n, pf|
    var n1 = n - BigInt.one
    var mo = BigInt.one
    for (pe in pf) {
        var y = n1 / pe.prime.pow(pe.exp)
        var o = 0
        var x = a.modPow(y, n.abs)
        while (x > BigInt.one) {
            x = x.modPow(pe.prime, n.abs)
            o = o + 1
        }
        var o1 = BigInt.new(o)
        o1 = pe.prime.pow(o1)
        o1 = o1 / BigInt.gcd(mo, o1)
        mo = mo * o1
    }
    return mo
}

var factor = Fn.new { |n|
    var pf = []
    var nn = n.copy()
    var e = 0
    while (!nn.testBit(e)) e = e + 1
    if (e > 0) {
        nn = nn >> e
        pf.add(PExp.new(BigInt.two, e))
    }
    var s = nn.isqrt
    var d = BigInt.three
    while (nn > BigInt.one) {
        if (d > s) d = nn
        e = 0
        while (true) {
            var dm = nn.divMod(d)
            if (dm[1].bitLength > 0) break
            nn = dm[0]
            e = e + 1
        }
        if (e > 0) {
            pf.add(PExp.new(d, e))
            s = nn.isqrt
        }
        d = d + BigInt.two
    }
    return pf
}

var moTest = Fn.new { |a, n|
    if (!n.isProbablePrime(10)) {
        System.print("Not computed. Modulus must be prime for this algorithm.")
        return
    }
    System.write((a.bitLength < 100) ? "ord(%(a))"  : "ord([big])")
    System.write((n.bitLength < 100) ? " mod %(n) " : "mod([big])")
    var mob = moBachShallit58.call(a, n, factor.call(n - BigInt.one))
    System.print("= %(mob)")
}

moTest.call(BigInt.new(37), BigInt.new(3343))

var b = BigInt.ten.pow(100) + BigInt.one
moTest.call(b, BigInt.new(7919))

b = BigInt.ten.pow(1000) + BigInt.one
moTest.call(b, BigInt.new(15485863))

b = BigInt.ten.pow(10000) - BigInt.one
moTest.call(b, BigInt.new(22801763489))

moTest.call(BigInt.new(1511678068), BigInt.new(7379191741))
moTest.call(BigInt.new(3047753288), BigInt.new(2257683301))


generic
   type Element_Type is private;
   Zero : Element_Type;
   One : Element_Type;
   with function "+" (Left, Right : Element_Type) return Element_Type is <>;
   with function "-" (Left, Right : Element_Type) return Element_Type is <>;
   with function "*" (Left, Right : Element_Type) return Element_Type is <>;
   with function "/" (Left, Right : Element_Type) return Element_Type is <>;
package Matrices is
   type Vector is array (Positive range <>) of Element_Type;
   type Matrix is
     array (Positive range <>, Positive range <>) of Element_Type;

   function "*" (Left, Right : Matrix) return Matrix;
   function Invert (Source : Matrix) return Matrix;
   function Reduced_Row_Echelon_Form (Source : Matrix) return Matrix;
   function Regression_Coefficients
     (Source     : Vector;
      Regressors : Matrix)
      return       Vector;
   function To_Column_Vector
     (Source : Matrix;
      Row    : Positive := 1)
      return   Vector;
   function To_Matrix
     (Source        : Vector;
      Column_Vector : Boolean := True)
      return          Matrix;
   function To_Row_Vector
     (Source : Matrix;
      Column : Positive := 1)
      return   Vector;
   function Transpose (Source : Matrix) return Matrix;

   Size_Mismatch     : exception;
   Not_Square_Matrix : exception;
   Not_Invertible    : exception;
end Matrices;


var BN   =Import("zklBigNum");
var Sieve=Import("sieve");

    // factor n into powers of primes
    // eg 9090 == 2^1 * 3^2 * 5^1 * 101^1
fcn factor2PP(n){ // lazy factors using lazy primes --> (prime,power) ...
   Utils.Generator(fcn(a){
      primes:=Utils.Generator(Sieve.postponed_sieve);
      foreach p in (primes){
	 e:=0; while(a%p == 0){ a /= p; e+=1; }
	 if (e) vm.yield(p,e);
	 if (a<p*p) break;
      }
      if (a>1) vm.yield(a,1);
   },n)
}

fcn _multOrdr1(a,p,e){
   m:=p.pow(e);
   t:=m/p*(p - 1);
   qs:=L(BN(1));
   foreach p2,e2 in (factor2PP(t)){
      qs=[[(e,q); [0..e2]; qs; '{ q*BN(p2).pow(e) }]];
   }
   qs.filter1('wrap(q){ a.powm(q,m)==1 });
}

fcn multiOrder(a,m){
   if (m.gcd(a)!=1) throw(Exception.ValueError("Not co-prime"));
   res:=BN(1);
   foreach p,e in (factor2PP(m)){
      res = res.lcm(_multOrdr1(BN(a),BN(p),e));
   }
   return(res);
}


#include <stdio.h>
#include <gsl/gsl_matrix.h>
#include <gsl/gsl_math.h>
#include <gsl/gsl_multifit.h>

double w[] = {	52.21, 53.12, 54.48, 55.84, 57.20,
		58.57, 59.93, 61.29, 63.11, 64.47,
		66.28, 68.10, 69.92, 72.19, 74.46 };
double h[] = {	1.47, 1.50, 1.52, 1.55, 1.57,
		1.60, 1.63, 1.65, 1.68, 1.70,
		1.73, 1.75, 1.78, 1.80, 1.83	};

int main()
{
	int n = sizeof(h)/sizeof(double);
	gsl_matrix *X = gsl_matrix_calloc(n, 3);
	gsl_vector *Y = gsl_vector_alloc(n);
	gsl_vector *beta = gsl_vector_alloc(3);

	for (int i = 0; i < n; i++) {
		gsl_vector_set(Y, i, w[i]);

		gsl_matrix_set(X, i, 0, 1);
		gsl_matrix_set(X, i, 1, h[i]);
		gsl_matrix_set(X, i, 2, h[i] * h[i]);
	}

	double chisq;
	gsl_matrix *cov = gsl_matrix_alloc(3, 3);
	gsl_multifit_linear_workspace * wspc = gsl_multifit_linear_alloc(n, 3);
	gsl_multifit_linear(X, Y, beta, cov, &chisq, wspc);

	printf("Beta:");
	for (int i = 0; i < 3; i++)
		printf("  %g", gsl_vector_get(beta, i));
	printf("\n");

	gsl_matrix_free(X);
	gsl_matrix_free(cov);
	gsl_vector_free(Y);
	gsl_vector_free(beta);
	gsl_multifit_linear_free(wspc);

}


#include <array>
#include <iostream>

void require(bool condition, const std::string &message) {
    if (condition) {
        return;
    }
    throw std::runtime_error(message);
}

template<typename T, size_t N>
std::ostream &operator<<(std::ostream &os, const std::array<T, N> &a) {
    auto it = a.cbegin();
    auto end = a.cend();

    os << '[';
    if (it != end) {
        os << *it;
        it = std::next(it);
    }
    while (it != end) {
        os << ", " << *it;
        it = std::next(it);
    }
    return os << ']';
}

template <size_t RC, size_t CC>
class Matrix {
    std::array<std::array<double, CC>, RC> data;

public:
    Matrix() : data{} {
        // empty
    }

    Matrix(std::initializer_list<std::initializer_list<double>> values) {
        size_t rp = 0;
        for (auto row : values) {
            size_t cp = 0;
            for (auto col : row) {
                data[rp][cp] = col;
                cp++;
            }
            rp++;
        }
    }

    double get(size_t row, size_t col) const {
        return data[row][col];
    }

    void set(size_t row, size_t col, double value) {
        data[row][col] = value;
    }

    std::array<double, CC> get(size_t row) {
        return data[row];
    }

    void set(size_t row, const std::array<double, CC> &values) {
        std::copy(values.begin(), values.end(), data[row].begin());
    }

    template <size_t D>
    Matrix<RC, D> operator*(const Matrix<CC, D> &rhs) const {
        Matrix<RC, D> result;
        for (size_t i = 0; i < RC; i++) {
            for (size_t j = 0; j < D; j++) {
                for (size_t k = 0; k < CC; k++) {
                    double prod = get(i, k) * rhs.get(k, j);
                    result.set(i, j, result.get(i, j) + prod);
                }
            }
        }
        return result;
    }

    Matrix<CC, RC> transpose() const {
        Matrix<CC, RC> trans;
        for (size_t i = 0; i < RC; i++) {
            for (size_t j = 0; j < CC; j++) {
                trans.set(j, i, data[i][j]);
            }
        }
        return trans;
    }

    void toReducedRowEchelonForm() {
        size_t lead = 0;
        for (size_t r = 0; r < RC; r++) {
            if (CC <= lead) {
                return;
            }
            auto i = r;

            while (get(i, lead) == 0.0) {
                i++;
                if (RC == i) {
                    i = r;
                    lead++;
                    if (CC == lead) {
                        return;
                    }
                }
            }

            auto temp = get(i);
            set(i, get(r));
            set(r, temp);

            if (get(r, lead) != 0.0) {
                auto div = get(r, lead);
                for (size_t j = 0; j < CC; j++) {
                    set(r, j, get(r, j) / div);
                }
            }

            for (size_t k = 0; k < RC; k++) {
                if (k != r) {
                    auto mult = get(k, lead);
                    for (size_t j = 0; j < CC; j++) {
                        auto prod = get(r, j) * mult;
                        set(k, j, get(k, j) - prod);
                    }
                }
            }

            lead++;
        }
    }

    Matrix<RC, RC> inverse() {
        require(RC == CC, "Not a square matrix");

        Matrix<RC, 2 * RC> aug;
        for (size_t i = 0; i < RC; i++) {
            for (size_t j = 0; j < RC; j++) {
                aug.set(i, j, get(i, j));
            }
            // augment identify matrix to right
            aug.set(i, i + RC, 1.0);
        }

        aug.toReducedRowEchelonForm();

        // remove identity matrix to left
        Matrix<RC, RC> inv;
        for (size_t i = 0; i < RC; i++) {
            for (size_t j = RC; j < 2 * RC; j++) {
                inv.set(i, j - RC, aug.get(i, j));
            }
        }
        return inv;
    }

    template <size_t RC, size_t CC>
    friend std::ostream &operator<<(std::ostream &, const Matrix<RC, CC> &);
};

template <size_t RC, size_t CC>
std::ostream &operator<<(std::ostream &os, const Matrix<RC, CC> &m) {
    for (size_t i = 0; i < RC; i++) {
        os << '[';
        for (size_t j = 0; j < CC; j++) {
            if (j > 0) {
                os << ", ";
            }
            os << m.get(i, j);
        }
        os << "]\n";
    }

    return os;
}

template <size_t RC, size_t CC>
std::array<double, RC> multiple_regression(const std::array<double, CC> &y, const Matrix<RC, CC> &x) {
    Matrix<1, CC> tm;
    tm.set(0, y);

    auto cy = tm.transpose();
    auto cx = x.transpose();
    return ((x * cx).inverse() * x * cy).transpose().get(0);
}

void case1() {
    std::array<double, 5> y{ 1.0, 2.0, 3.0, 4.0, 5.0 };
    Matrix<1, 5> x{ {2.0, 1.0, 3.0, 4.0, 5.0} };
    auto v = multiple_regression(y, x);
    std::cout << v << '\n';
}

void case2() {
    std::array<double, 3> y{ 3.0, 4.0, 5.0 };
    Matrix<2, 3> x{
        {1.0, 2.0, 1.0},
        {1.0, 1.0, 2.0}
    };
    auto v = multiple_regression(y, x);
    std::cout << v << '\n';
}

void case3() {
    std::array<double, 15> y{ 52.21, 53.12, 54.48, 55.84, 57.20, 58.57, 59.93, 61.29, 63.11, 64.47, 66.28, 68.10, 69.92, 72.19, 74.46 };
    std::array<double, 15> a{ 1.47, 1.50, 1.52, 1.55, 1.57, 1.60, 1.63, 1.65, 1.68, 1.70, 1.73, 1.75, 1.78, 1.80, 1.83 };

    Matrix<3, 15> x;
    for (size_t i = 0; i < 15; i++) {
        x.set(0, i, 1.0);
    }
    x.set(1, a);
    for (size_t i = 0; i < 15; i++) {
        x.set(2, i, a[i] * a[i]);
    }

    auto v = multiple_regression(y, x);
    std::cout << v << '\n';
}

int main() {
    case1();
    case2();
    case3();

    return 0;
}


type Grade is range 0..100;
subtype Lower_Case is Character range 'a'..'z';
subtype Natural is Integer range 0..Integer'Last;
subtype Positive is Integer range 1..Integer'Last;
type Deflection is range -180..180;


/*Single dimensional array of integers*/
int a[10];

/*2-dimensional array, also called matrix of floating point numbers.
This matrix has 3 rows and 2 columns.*/

float b[3][2];

/*3-dimensional array ( Cube ? Cuboid ? Lattice ?) of characters*/

char c[4][5][6];

/*4-dimensional array (Hypercube ?) of doubles*/

double d[6][7][8][9];

/*Note that the right most number in the [] is required, all the others may be omitted.
Thus this is ok : */

int e[][3];

/*But this is not*/

float f[5][4][];

/*But why bother with all those numbers ? You can also write :*/
int *g;

/*And for a matrix*/
float **h;

/*or if you want to show off*/
double **i[];

/*you get the idea*/

char **j[][5];


using System;
using MathNet.Numerics.LinearRegression;
using MathNet.Numerics.LinearAlgebra;
using MathNet.Numerics.LinearAlgebra.Double;

class Program
{
    static void Main(string[] args)
    {
        var col = DenseVector.OfArray(new double[] { 1.47, 1.50, 1.52, 1.55, 1.57, 1.60, 1.63, 1.65,
            1.68, 1.70, 1.73, 1.75, 1.78, 1.80, 1.83 });
        var X = DenseMatrix.OfColumns(new Vector<double>[] { col.PointwisePower(0), col, col.PointwisePower(2) });
        var y = DenseVector.OfArray(new double[] { 52.21, 53.12, 54.48, 55.84, 57.20, 58.57, 59.93,
            61.29, 63.11, 64.47, 66.28, 68.10, 69.92, 72.19, 74.46 });
        var β = MultipleRegression.QR(X, y);
        Console.WriteLine(β);
    }
}


;; Solve a linear system AX=B where A is symmetric and positive definite, so it can be Cholesky decomposed.
(defun linsys (A B)
  (let* ((n (car  (array-dimensions A)))
         (m (cadr (array-dimensions B)))
         (y (make-array n        :element-type 'long-float :initial-element 0.0L0))
         (X (make-array `(,n ,m) :element-type 'long-float :initial-element 0.0L0))
         (L (chol A))) ; A=LL'

    (loop for col from 0 to (- m 1) do
       ;; Forward substitution: y = L\B
       (loop for k from 0 to (- n 1)
             do (setf (aref y k)
                      (/ (- (aref B k col)
                            (loop for j from 0 to (- k 1)
                                  sum (* (aref L k j)
                                         (aref y j))))
                         (aref L k k))))

       ;; Back substitution. x=L'\y
       (loop for k from (- n 1) downto 0
             do (setf (aref X k col)
                      (/ (- (aref y k)
                            (loop for j from (+ k 1) to (- n 1)
                                  sum (* (aref L j k)
                                         (aref X j col))))
                         (aref L k k)))))
    X))

;; Solve a linear least squares problem. Ax=b, with A being mxn, with m>n.
;; Solves the linear system A'Ax=A'b.
(defun lsqr (A b)
  (linsys (mmul (mtp A) A)
          (mmul (mtp A) b)))


var array = new int[,] { //Dimensions are inferred
    { 1, 2, 3 },
    { 4, 5, 6}
}
//Accessing a single element:
array[0, 0] = 999;

//To create a 4-dimensional array with all zeroes:
var array = new int[5, 4, 3, 2];


#include <iostream>
#include <vector>

// convienince for printing the contents of a collection
template<typename T>
std::ostream& operator<<(std::ostream& out, const std::vector<T>& c) {
    auto it = c.cbegin();
    auto end = c.cend();

    out << '[';
    if (it != end) {
        out << *it;
        it = std::next(it);
    }
    while (it != end) {
        out << ", " << *it;
        it = std::next(it);
    }
    return out << ']';
}

void fourDim() {
    using namespace std;

    // create a 4d jagged array, with bounds checking etc...
    vector<vector<vector<vector<int>>>> arr;
    int cnt = 0;

    arr.push_back(vector<vector<vector<int>>>{});
    arr[0].push_back(vector<vector<int>>{});
    arr[0][0].push_back(vector<int>{});
    arr[0][0][0].push_back(cnt++);
    arr[0][0][0].push_back(cnt++);
    arr[0][0][0].push_back(cnt++);
    arr[0][0][0].push_back(cnt++);
    arr[0].push_back(vector<vector<int>>{});
    arr[0][1].push_back(vector<int>{});
    arr[0][1][0].push_back(cnt++);
    arr[0][1][0].push_back(cnt++);
    arr[0][1][0].push_back(cnt++);
    arr[0][1][0].push_back(cnt++);
    arr[0][1].push_back(vector<int>{});
    arr[0][1][1].push_back(cnt++);
    arr[0][1][1].push_back(cnt++);
    arr[0][1][1].push_back(cnt++);
    arr[0][1][1].push_back(cnt++);

    arr.push_back(vector<vector<vector<int>>>{});
    arr[1].push_back(vector<vector<int>>{});
    arr[1][0].push_back(vector<int>{});
    arr[1][0][0].push_back(cnt++);
    arr[1][0][0].push_back(cnt++);
    arr[1][0][0].push_back(cnt++);
    arr[1][0][0].push_back(cnt++);

    cout << arr << '\n';
}

int main() {
    /* C++ does not have native support for multi-dimensional arrays,
     * but classes could be written to make things easier to work with.
     * There are standard library classes which can be used for single dimension arrays.
     * Also raw access is supported through pointers as in C.
     */

    fourDim();

    return 0;
}


import std.algorithm;
import std.array;
import std.exception;
import std.range;
import std.stdio;

public class Matrix {
    private double[][] data;
    private size_t rowCount;
    private size_t colCount;

    public this(size_t size)
    in(size > 0, "Must have at least one element")
    {
        this(size, size);
    }

    public this(size_t rows, size_t cols)
    in(rows > 0, "Must have at least one row")
    in(cols > 0, "Must have at least one column")
    {
        rowCount = rows;
        colCount = cols;

        data = uninitializedArray!(double[][])(rows, cols);
        foreach (ref row; data) {
            row[] = 0.0;
        }
    }

    public this(const double[][] source) {
        enforce(source.length > 0, "Must have at least one row");
        rowCount = source.length;

        enforce(source[0].length > 0, "Must have at least one column");
        colCount = source[0].length;

        data = uninitializedArray!(double[][])(rowCount, colCount);
        foreach (i; 0 .. rowCount) {
            enforce(source[i].length == colCount, "All rows must have equal columns");
            data[i] = source[i].dup;
        }
    }

    public auto opIndex(size_t r, size_t c) const {
        return data[r][c];
    }

    public auto opIndex(size_t r) const {
        return data[r];
    }

    public auto opBinary(string op)(const Matrix rhs) const {
        static if (op == "*") {
            auto rc1 = rowCount;
            auto cc1 = colCount;
            auto rc2 = rhs.rowCount;
            auto cc2 = rhs.colCount;
            enforce(cc1 == rc2, "Cannot multiply if the first columns does not equal the second rows");
            auto result = new Matrix(rc1, cc2);
            foreach (i; 0 .. rc1) {
                foreach (j; 0 .. cc2) {
                    foreach (k; 0 .. rc2) {
                        result[i, j] += this[i, k] * rhs[k, j];
                    }
                }
            }
            return result;
        } else {
            assert(false, "Not implemented");
        }
    }

    public void opIndexAssign(double value, size_t r, size_t c) {
        data[r][c] = value;
    }

    public void opIndexAssign(const double[] value, size_t r) {
        enforce(colCount == value.length, "Slice size must match column size");
        data[r] = value.dup;
    }

    public void opIndexOpAssign(string op)(double value, size_t r, size_t c) {
        mixin("data[r][c] " ~ op ~ "= value;");
    }

    public auto transpose() const {
        auto rc = rowCount;
        auto cc = colCount;
        auto t = new Matrix(cc, rc);
        foreach (i; 0 .. cc) {
            foreach (j; 0 .. rc) {
                t[i, j] = this[j, i];
            }
        }
        return t;
    }

    public void toReducedRowEchelonForm() {
        auto lead = 0;
        auto rc = rowCount;
        auto cc = colCount;
        foreach (r; 0 .. rc) {
            if (cc <= lead) {
                return;
            }
            auto i = r;

            while (this[i, lead] == 0.0) {
                i++;
                if (rc == i) {
                    i = r;
                    lead++;
                    if (cc == lead) {
                        return;
                    }
                }
            }

            auto temp = this[i];
            this[i] = this[r];
            this[r] = temp;

            if (this[r, lead] != 0.0) {
                auto div = this[r, lead];
                foreach (j; 0 .. cc) {
                    this[r, j] = this[r, j] / div;
                }
            }

            foreach (k; 0 .. rc) {
                if (k != r) {
                    auto mult = this[k, lead];
                    foreach (j; 0 .. cc) {
                        this[k, j] -= this[r, j] * mult;
                    }
                }
            }

            lead++;
        }
    }

    public auto inverse() const {
        enforce(rowCount == colCount, "Not a square matrix");
        auto len = rowCount;
        auto aug = new Matrix(len, 2 * len);
        foreach (i; 0 .. len) {
            foreach (j; 0 .. len) {
                aug[i, j] = this[i, j];
            }
            // augment identity matrix to right
            aug[i, i + len] = 1.0;
        }
        aug.toReducedRowEchelonForm;
        auto inv = new Matrix(len);
        // remove identify matrix to left
        foreach (i; 0 .. len) {
            foreach (j; len .. 2 * len) {
                inv[i, j - len] = aug[i, j];
            }
        }
        return inv;
    }

    void toString(scope void delegate(const(char)[]) sink) const {
        import std.format;
        auto fmt = FormatSpec!char("%s");

        put(sink, "[");
        foreach (i; 0 .. rowCount) {
            if (i > 0) {
                put(sink, " [");
            } else {
                put(sink, "[");
            }

            formatValue(sink, this[i, 0], fmt);
            foreach (j; 1 .. colCount) {
                put(sink, ", ");
                formatValue(sink, this[i, j], fmt);
            }

            if (i + 1 < rowCount) {
                put(sink, "]\n");
            } else {
                put(sink, "]");
            }
        }
        put(sink, "]");
    }
}

auto multipleRegression(double[] y, Matrix x) {
    auto tm = new Matrix([y]);
    auto cy = tm.transpose;
    auto cx = x.transpose;
    return ((x * cx).inverse * x * cy).transpose[0].dup;
}

void main() {
    auto y = [1.0, 2.0, 3.0, 4.0, 5.0];
    auto x = new Matrix([[2.0, 1.0, 3.0, 4.0, 5.0]]);
    auto v = multipleRegression(y, x);
    v.writeln;

    y = [3.0, 4.0, 5.0];
    x = new Matrix([
        [1.0, 2.0, 1.0],
        [1.0, 1.0, 2.0]
    ]);
    v = multipleRegression(y, x);
    v.writeln;

    y = [52.21, 53.12, 54.48, 55.84, 57.20, 58.57, 59.93, 61.29, 63.11, 64.47, 66.28, 68.10, 69.92, 72.19, 74.46];
    auto a = [1.47, 1.50, 1.52, 1.55, 1.57, 1.60, 1.63, 1.65, 1.68, 1.70, 1.73, 1.75, 1.78, 1.80, 1.83];
    x = new Matrix([
        repeat(1.0, a.length).array,
        a,
        a.map!"a * a".array
    ]);
    v = multipleRegression(y, x);
    v.writeln;
}


import std.stdio;

/*
 * Using just what is built-in, D only supports single dimension arrays. Like other languages, arrays can be built up as jagged arrays.
 * Arrays can either be created with a fixed size, or dynamically with support for resizing.
 */
void nativeExample() {
    int[3] staticArray; // Statically allocated array. Will only contain three elements, accessed from 0 to 2 inclusive.
    staticArray[0] = 1;
    staticArray[1] = 2;
    staticArray[2] = 3;
    writeln("Static array: ", staticArray);

    int[] dynamicArray; // Dynamically allocated array.
    dynamicArray.length = 3; // The array can be resized at runtime. If the number elements exceeds the allocated memory, new memory will be given from the heap.
    dynamicArray[0] = 4;
    dynamicArray[1] = 5;
    dynamicArray[2] = 6;
    dynamicArray ~= 7; // New elements can be concatenated.
    writeln("Dynamic array: ", dynamicArray);
}

/*
 * Multi-dimensional arrays can be created as custom types (classes or structs). They can have as many dimensions as are written for support.
 * The indexes can either be standard 0-n, or arbitrary m-n as needed. This example shows just a two dimensional example with standard indexes.
 * As few or as many of these pieces can be implemented as desired (compile-time error is given if a feature is not supported).
 */
struct Matrix(T) {
    // A dynamic array for the actual storage.
    private:
    T[] source;
    uint rows, cols; // dimensions

    public:
    this(uint m, uint n) {
        rows = m;
        cols = n;
        source.length = m*n;
    }

    /// Allow for short access to limits, e.g. a[$-1,$-1]
    int opDollar(size_t pos : 0)() const {
        return rows;
    }
    int opDollar(size_t pos : 1)()  const {
        return cols;
    }

    /// Allow for indexing to read a value, e.g. a[0,0]
    T opIndex(int i, int j) const in {
        assert(0 <= i && i <= rows, "Row index out of bounds");
        assert(0 <= j && j <= cols, "Col index out of bounds");
    } body {
        return source[i*rows + j];
    }

    /// Allow for assigning elements, e.g. a[0,0] = c
    T opIndexAssign(T elem, int i, int j) in {
        assert(0 <= i && i <= rows, "Row index out of bounds");
        assert(0 <= j && j <= cols, "Col index out of bounds");
    } body {
        auto index = rows*i + j;
        T prev = source[index];
        source[index] = elem;
        return prev;
    }

    /// Allow for applying operations and assigning elements, e.g. a[0,0] += c
    T opIndexOpAssign(string op)(T elem, int i, int j) {
        auto index = rows*i + j;
        T prev = source[index];
        mixin("source[index] " ~ op ~ "= elem;");
        return prev;
    }

    /// Support slicing, shown below
    auto opSlice(size_t pos)(int a, int b) in {
        assert(0 <= a && a <= opDollar!pos);
        assert(0 <= b && b <= opDollar!pos);
    } body {
        if (pos == 0) {
        } else {
            assert(0 <= a && a <= cols, "Col slice out of bounds");
            assert(0 <= b && b <= cols, "Col slice out of bounds");
        }
        return [a, b];
    }

    /// Allow for getting a sub-portion of the matrix, e.g. [0..2, 2..4]
    auto opIndex(int[] a, int[] b) const {
        auto t = Matrix!T(a.length, b.length);
        foreach(i, ia; a) {
            foreach(j, jb; b) {
                t[i, j] = this[ia, jb];
            }
        }
        return t;
    }
    auto opIndex(int[] a, int b) const {
        return opIndex(a, [b,b+1]);
    }
    auto opIndex(int a, int[] b) const {
        return opIndex([a,a+1], b);
    }

    /// Assign a single value to every element
    void opAssign(T value) {
        source[0..$] = value;
    }

    /// Assign a single element to a subset of the Matrix
    void opIndexAssign(T elem, int[] a, int[] b) {
        for (int i=a[0]; i<a[1]; i++) {
            auto start = rows * i;
            source[start+b[0]..start+b[1]] = elem;
        }
    }
    void opIndexAssign(T elem, int[] a, int b) {
        opIndexAssign(elem, a, [b, b+1]);
    }
    void opIndexAssign(T elem, int a, int[] b) {
        opIndexAssign(elem, [a, a+1], b);
    }

    /// Define how to write Matrix values as a string. Only does a simple string representation
    void toString(scope void delegate(const(char)[]) sink) const {
        import std.format;

        sink("[");
        foreach (i; 0..opDollar!0) {
            sink("[");
            foreach (j; 0..opDollar!1) {
                formattedWrite(sink, "%s", opIndex(i,j));
                if (j < cols-1) sink(", ");
            }
            if (i < rows-1) sink("]\n ");
            else sink("]");
        }
        sink("]");
    }
}

void customArray() {
    auto multi = Matrix!int(3, 3);
    writeln("Create a multidimensional object:\n", multi);
    writeln("Access an element: ", multi[0,0]);
    multi[0,0] = 1;
    writeln("Assign an element: ", multi[0,0]);
    multi[0,0] += 2;
    writeln("Arithmetic on an element: ", multi[0,0]);
    writeln("Slice a matrix:\n", multi[0..2, 0..2]);
    multi = 5;
    writeln("Assign all elements:\n", multi);
    multi[0..2,1..3] = 4;
    writeln("Assign some elements:\n", multi);
}

void main() {
    nativeExample();
    customArray();
}


PROGRAM MULTIPLE_REGRESSION

!$DOUBLE

CONST N=14,M=2,Q=3 ! number of points and M.R. polynom degree

DIM X[N],Y[N]      ! data points
DIM S[N],T[N]      ! linear system coefficient
DIM A[M,Q]         ! sistem to be solved

BEGIN

   DATA(1.47,1.50,1.52,1.55,1.57,1.60,1.63,1.65,1.68,1.70,1.73,1.75,1.78,1.80,1.83)
   DATA(52.21,53.12,54.48,55.84,57.20,58.57,59.93,61.29,63.11,64.47,66.28,68.10,69.92,72.19,74.46)

   FOR I%=0 TO N DO
     READ(X[I%])
   END FOR

   FOR I%=0 TO N DO
     READ(Y[I%])
   END FOR

   FOR K%=0 TO 2*M DO
      S[K%]=0  T[K%]=0
      FOR I%=0 TO N DO
         S[K%]=S[K%]+X[I%]^K%
         IF K%<=M THEN T[K%]=T[K%]+Y[I%]*X[I%]^K% END IF
      END FOR
   END FOR

! build linear system

   FOR ROW%=0 TO M DO
     FOR COL%=0 TO M DO
       A[ROW%,COL%]=S[ROW%+COL%]
     END FOR
     A[ROW%,COL%]=T[ROW%]
   END FOR

   PRINT("LINEAR SYSTEM COEFFICENTS") PRINT
   FOR I%=0 TO M DO
     FOR J%=0 TO M+1 DO
        WRITE(" ######.#";A[I%,J%];)
     END FOR
     PRINT
   END FOR
   PRINT

   FOR J%=0 TO M DO
         FOR I%=J% TO M DO
              EXIT IF A[I%,J%]<>0
         END FOR
         IF I%=M+1 THEN
             PRINT("SINGULAR MATRIX !")
             !$STOP
         END IF
         FOR K%=0 TO M+1 DO
             SWAP(A[J%,K%],A[I%,K%])
         END FOR
         Y=1/A[J%,J%]
         FOR K%=0 TO M+1 DO
             A[J%,K%]=Y*A[J%,K%]
         END FOR
         FOR I%=0 TO M DO
             IF I%<>J% THEN
                 Y=-A[I%,J%]
                 FOR K%=0 TO M+1 DO
                    A[I%,K%]=A[I%,K%]+Y*A[J%,K%]
                 END FOR
             END IF
         END FOR
   END FOR
   PRINT

   PRINT("SOLUTIONS") PRINT
   FOR I%=0 TO M DO
      PRINT("c";I%;"=";)
      WRITE("#####.#######";A[I%,M+1])
   END FOR

END PROGRAM


*-----------------------------------------------------------------------
* MR - multiple regression using the SLATEC library routine DHFTI
*
* Finds the nearest approximation to BETA in the system of linear equations:
*
*              X(j,i) . BETA(i) = Y(j)
* where
*                  1 ... j ... N
*                  1 ... i ... K
* and
*                  K .LE. N
*
* INPUT ARRAYS ARE DESTROYED!
*
*___Name___________Type_______________In/Out____Description_____________
*   X(N,K)         Double precision   In        Predictors
*   Y(N)           Double precision   Both      On input:   N Observations
*                                               On output:  K beta weights
*   N              Integer            In        Number of observations
*   K              Integer            In        Number of predictor variables
*   DWORK(N+2*K)   Double precision   Neither   Workspace
*   IWORK(K)       Integer            Neither   Workspace
*-----------------------------------------------------------------------
      SUBROUTINE MR (X, Y, N, K, DWORK, IWORK)
       IMPLICIT NONE
       INTEGER K, N, IWORK
       DOUBLE PRECISION X, Y, DWORK
       DIMENSION X(N,K), Y(N), DWORK(N+2*K), IWORK(K)

*         local variables
       INTEGER I, J
       DOUBLE PRECISION TAU, TOT

*        maximum of all column sums of magnitudes
       TAU = 0.
       DO J = 1, K
         TOT = 0.
         DO I = 1, N
           TOT = TOT + ABS(X(I,J))
         END DO
         IF (TOT > TAU) TAU = TOT
       END DO
       TAU = TAU * EPSILON(TAU)        ! tolerance argument

*            call function
       CALL DHFTI (X, N, N, K, Y, N, 1, TAU,
     $  J, DWORK(1), DWORK(N+1), DWORK(N+K+1), IWORK)
       IF (J < K) PRINT *, 'mr: solution is rank deficient!'
       RETURN
      END  ! of MR

*-----------------------------------------------------------------------
      PROGRAM t_mr        ! polynomial regression example
       IMPLICIT NONE
       INTEGER N, K
       PARAMETER (N=15, K=3)
       INTEGER IWORK(K), I, J
       DOUBLE PRECISION XIN(N), X(N,K), Y(N), DWORK(N+2*K)

       DATA XIN / 1.47, 1.50, 1.52, 1.55, 1.57, 1.60, 1.63, 1.65, 1.68,
     $            1.70, 1.73, 1.75, 1.78, 1.80, 1.83 /
       DATA Y / 52.21, 53.12, 54.48, 55.84, 57.20, 58.57, 59.93, 61.29,
     $          63.11, 64.47, 66.28, 68.10, 69.92, 72.19, 74.46 /

*              make coefficient matrix
       DO J = 1, K
         DO I = 1, N
           X(I,J) = XIN(I) **(J-1)
         END DO
       END DO

*               solve
       CALL MR (X, Y, N, K, DWORK, IWORK)

*               print result
  10   FORMAT ('beta: ', $)
  20   FORMAT (F12.4, $)
  30   FORMAT ()
       PRINT 10
       DO J = 1, K
         PRINT 20, Y(J)
       END DO
       PRINT 30
       STOP 'program complete'
      END


(require 'math) ;; dot-product

;; dims = vector #(d1 d2 .....)
;; allocates a new m-array
(define (make-m-array dims (init 0))
	;; allocate 2 + d1*d2*d3... consecutive cells
	(define msize (apply * (vector->list dims)))
	(define m-array (make-vector (+ 2 msize) init))

	;; compute displacements vector once for all
	;; m-array[0] = [1 d1 d1*d2 d1*d2*d3 ...]
	(define disps (vector-rotate! (vector-dup dims) 1))
	(vector-set! disps 0 1)
	(for [(i(in-range 1 (vector-length disps)) )]
	      (vector-set! disps i (* [disps i] [disps (1- i)])))
	(vector-set! m-array 0 disps)

	(vector-set! m-array 1 dims) ;; remember dims
	m-array)

;; from indices = #(i j k ...) to displacement
(define-syntax-rule (m-array-index ma indices)
	(+ 2 (dot-product (ma 0)  indices)))

;; check i < d1, j < d2, ...
(define (m-array-check ma indices)
	(for [(dim [ma 1]) (idx indices)]
		#:break (>= idx dim) => (error 'm-array:bad-index (list idx  '>= dim))))

;; --------------------
;; A P I
;; --------------------
;; indices is a vector #[i j k ...]
;; (make-m-array (dims) [init])

(define (m-array-dims ma) [ma 1])

; return ma[indices]
(define (m-array-ref ma indices)
	(m-array-check ma indices)
	[ma (m-array-index ma indices)])
; sets ma[indices]
(define (m-array-set! ma indices value )
	(m-array-check ma indices)
	(vector-set! ma (m-array-index ma indices) value))


USING: accessors arrays.shaped io kernel prettyprint sequences ;

! Create a 4-dimensional array with increasing elements.
{ 2 3 4 5 } increasing

! Check if an index is in bounds.
{ 0 0 0 0 } over shaped-bounds-check

! Access and print the first element.
"First element: " write
get-shaped-row-major .

! Set the first element and show the array.
"With first element set to 999:" print
999 { 0 0 0 0 } pick set-shaped-row-major dup .

! Reshape and show the array.
"Reshaped: " print
{ 5 4 3 2 } reshape .


4 5 6 7 8 CELL 5 darray test5d   \ Creates the array
i j k l m test5d   \ Returns the address of test5d[ i, j, k, l, m ]

100 i j k l m test5d !   \ Sets contents of test5d[ i, j, k, l, m ] to 100
 i j k l m test5d @      \ Gets contents of test5d[ i, j, k, l, m ]


      DIMENSION A(5,4,3,2)                 !Declares a (real) array A of four dimensions, storage permitting.
      X = 3*A(2,I,1,K)                     !Extracts a certain element, multiplies its value by three, result to X.
      A(1,2,3,4) = X + 1                   !Places a value (the result of the expression X + 1) ... somewhere...