text:
expon := function(a, n, one, mul)
	local p;
	p := one;
	while n > 0 do
		if IsOddInt(n) then
			p := mul(a, p);
		fi;
		a := mul(a, a);
		n := QuoInt(n, 2);
	od;
	return p;
end;

expon(2, 10, 1, \*);
# 1024

# a more creative use of exponentiation
List([0 .. 31], n -> (1 - expon(0, n, 1, \-))/2);
# [ 0, 1, 1, 0, 1, 0, 0, 1, 1, 0, 0, 1, 0, 1, 1, 0,
#   1, 0, 0, 1, 0, 1, 1, 0, 0, 1, 1, 0, 1, 0, 0, 1 ]

ext: gap

max_issues_repo_name: seanwallawalla-forks/RosettaCodeData

max_forks_repo_name: seanwallawalla-forks/RosettaCodeData

lm_label:
1. YES
2. YES


text:
FixedPartitions := function(arg)
	local aux;
	aux := function(i, u)
		local r, v, w;
		if i = Size(arg) then
			return [[u]];
		else
			r := [ ];
			for v in Combinations(u, arg[i]) do
				for w in aux(i + 1, Difference(u, v)) do
					Add(r, Concatenation([v], w));
				od;
			od;
			return r;
		fi;
	end;
	return aux(1, [1 .. Sum(arg)]);
end;

FixedPartitions(2, 0, 2);
# [ [ [ 1, 2 ], [  ], [ 3, 4 ] ], [ [ 1, 3 ], [  ], [ 2, 4 ] ],
#   [ [ 1, 4 ], [  ], [ 2, 3 ] ], [ [ 2, 3 ], [  ], [ 1, 4 ] ],
#   [ [ 2, 4 ], [  ], [ 1, 3 ] ], [ [ 3, 4 ], [  ], [ 1, 2 ] ] ]

FixedPartitions(1, 1, 1);
# [ [ [ 1 ], [ 2 ], [ 3 ] ], [ [ 1 ], [ 3 ], [ 2 ] ], [ [ 2 ], [ 1 ], [ 3 ] ],
#   [ [ 2 ], [ 3 ], [ 1 ] ], [ [ 3 ], [ 1 ], [ 2 ] ], [ [ 3 ], [ 2 ], [ 1 ] ] ]

max_stars_repo_name: mullikine/RosettaCodeData


text:
# We will compute the sum exactly

# Computing an approximation of a rationnal (giving a string)
# Value is truncated toward zero
Approx := function(x, d)
	local neg, a, b, n, m, s;
	if x < 0 then
		x := -x;
		neg := true;
	else
		neg := false;
	fi;
	a := NumeratorRat(x);
	b := DenominatorRat(x);
	n := QuoInt(a, b);
	a := RemInt(a, b);
	m := 10^d;
	s := "";
	if neg then
		Append(s, "-");
	fi;
	Append(s, String(n));
	n := Size(s) + 1;
	Append(s, String(m + QuoInt(a*m, b)));
	s[n] := '.';
	return s;
end;

a := Sum([1 .. 1000], n -> 1/n^2);;
Approx(a, 10);
"1.6439345666"
# and pi^2/6 is 1.6449340668, truncated to ten digits


text:
DotProduct := function(u, v)
	return u*v;
end;

CrossProduct := function(u, v)
	return [
		u[2]*v[3] - u[3]*v[2],
		u[3]*v[1] - u[1]*v[3],
		u[1]*v[2] - u[2]*v[1] ];
end;

ScalarTripleProduct := function(u, v, w)
	return DotProduct(u, CrossProduct(v, w));
end;

VectorTripleProduct := function(u, v, w)
	return CrossProduct(u, CrossProduct(v, w));
end;

a := [3, 4, 5];
b := [4, 3, 5];
c := [-5, -12, -13];

DotProduct(a, b);
# 49

CrossProduct(a, b);
# [ 5, 5, -7 ]

ScalarTripleProduct(a, b, c);
# 6

# Another way to get it
Determinant([a, b, c]);
# 6

VectorTripleProduct(a, b, c);
# [ -267, 204, -3 ]


text:
IsPrimeTrial := function(n)
   local k, m;
   if n < 5 then
      return (n = 2) or (n = 3);
   fi;
   if RemInt(n, 2) = 0 then
      return false;
   fi;
   m := RootInt(n);
   k := 3;
   while k <= m do
      if RemInt(n, k) = 0 then
         return false;
      fi;
      k := k + 2;
   od;
   return true;
end;

Filtered([1 .. 100], IsPrimeTrial);
# [ 2, 3, 5, 7, 11, 13, 17, 19, 23, 29, 31, 37, 41, 43, 47, 53, 59, 61, 67, 71, 73, 79, 83, 89, 97 ]


text:
# Using parity of binomial coefficients
SierpinskiTriangle := function(n)
	local i, j, s, b;
	n := 2^n - 1;
	b := " ";
	while Size(b) < n do
		b := Concatenation(b, b);
	od;
	for i in [0 .. n] do
		s := "";
		for j in [0 .. i] do
			if IsEvenInt(Binomial(i, j)) then
				Append(s, "  ");
			else
				Append(s, "* ");
			fi;
		od;
		Print(b{[1 .. n - i]}, s, "\n");
	od;
end;

SierpinskiTriangle(4);
               *
              * *
             *   *
            * * * *
           *       *
          * *     * *
         *   *   *   *
        * * * * * * * *
       *               *
      * *             * *
     *   *           *   *
    * * * *         * * * *
   *       *       *       *
  * *     * *     * *     * *
 *   *   *   *   *   *   *   *
* * * * * * * * * * * * * * * *


text:
#
# Read("~/Workspace/groupsSB/epi/ext.gi");
#
# highest_weight:=[1,1];# A2: corresponding highest weight module is the Lie algebra
#

L:= SimpleLieAlgebra(type,rank,Rationals);
cb0:=CanonicalBasis(L);
V:= HighestWeightModule( L, highest_weight );
extA:=List([1..Dimension(V)],i->ExteriorPowerOfAlgebraModule( V, i ));
extA_basis:=List(extA,i->Basis(i));

ext_e:=function(k,e)
	local W,extb,result,v;
    W:=extA[k];
    extb:=extA_basis[k];

	result:=[];
	for v in extb do
		Append(result,[Coefficients(extb,e^v)]);
	od;
	result:=TransposedMat(result);
	return result;
end;

ade0:=function(e)
	local result,v;
	result:=[];
	for v in cb0 do
		Append(result,[Coefficients(cb0,e*v)]);
	od;
	result:=TransposedMat(result);
	return result;
end;

ext_root_group:=function(k,index,t)
	local ee,tmp,result,i;
	ee:=ext_e(k,cb0[index]);
	tmp:=ee;
	result:=tmp^0;
	i:=1;
	while Length(Set(Concatenation(tmp)))<>1 do
		result:=result+t^i*tmp/Factorial(i);
		i:=i+1;
		tmp:=tmp*ee;
	od;
	return result;
end;

ext_root_nil_degree:=function(k,index)
	local ee,tmp,i;
	ee:=ext_e(k,cb0[index]);
	tmp:=ee;
	i:=1;
	while Length(Set(Concatenation(tmp)))<>1 do
		i:=i+1;
		tmp:=tmp*ee;
	od;
	return i;
end;

ext_lin_comb:=function(k,coeffs)
	local extAb,result;
	extAb:=extA_basis[k];
	result:=List([1..Length(extAb)],i->coeffs[i]*extAb[i]);
	return Sum(result);
end;

ext: gi

max_stars_repo_name: iuliansimion/groupsSB

max_issues_repo_name: iuliansimion/groupsSB

max_forks_repo_name: iuliansimion/groupsSB


text:
PolynomialRegression := function(x, y, n)
	local a;
	a := List([0 .. n], i -> List(x, s -> s^i));
	return TransposedMat((a * TransposedMat(a))^-1 * a * TransposedMat([y]))[1];
end;

x := [0,  1,  2,  3,  4,  5,  6,   7,   8,   9,   10];
y := [1,  6,  17, 34, 57, 86, 121, 162, 209, 262, 321];

# Return coefficients in ascending degree order
PolynomialRegression(x, y, 2);
# [ 1, 2, 3 ]


text:
# Using built-in functions
Incr := s -> String(Int(s) + 1);

# Implementing addition
# (but here 9...9 + 1 = 0...0 since the string length is fixed)
Increment := function(s)
  local c, n, carry, digits;
  digits := "0123456789";
  n := Length(s);
  carry := true;
  while n > 0 and carry do
    c := Position(digits, s[n]) - 1;
    if carry then
      c := c + 1;
    fi;
    if c > 9 then
      carry := true;
      c := c - 10;
    else
      carry := false;
    fi;
    s[n] := digits[c + 1];
    n := n - 1;
  od;
end;

s := "2399";
Increment(s);
s;
# "2400"


text:
cube := Group([(1, 2, 3, 4)(5, 6, 7, 8), (1, 4, 8, 5)(2, 3, 7, 6)]);

Print("Order(cube) = ", Order(cube), "\n");

degree := 8;
colorings := Filtered(
  Combinations(Cartesian([1..degree], ["b", "w"]), degree)
, \c -> Size(Set(List(c, \a -> a[1]))) = degree
);

Print("Size(colorings) = ", Size(colorings), "\n");

OnFunctions := function(omega, g)
  local result;
  result := List(omega, t -> [t[1]^g, t[2]]);
  SortBy(result, t -> t[1]);
  return result;
end;

orbits := Orbits(cube, colorings, OnFunctions);
Print("Size(orbits) = ", Size(orbits), "\n");

IsFixed := function(omega, g)
  return OnFunctions(omega, g) = omega;
end;

orbitCount := 1/Order(cube) * Sum(List(Elements(cube), \g -> Size(Filtered(colorings, \c -> IsFixed(c, g)))));

Print("orbitCount: ", orbitCount, ", #orbits: ", Size(orbits));

max_stars_repo_name: fifth-postulate/group-theory-with-gap

max_issues_repo_name: fifth-postulate/group-theory-with-gap

max_forks_repo_name: fifth-postulate/group-theory-with-gap


text:
# Built-in function
DivisorsInt(Factorial(5));
# [ 1, 2, 3, 4, 5, 6, 8, 10, 12, 15, 20, 24, 30, 40, 60, 120 ]

# A possible implementation, not suitable to large n
div := n -> Filtered([1 .. n], k -> n mod k = 0);

div(Factorial(5));
# [ 1, 2, 3, 4, 5, 6, 8, 10, 12, 15, 20, 24, 30, 40, 60, 120 ]

# Another implementation, usable for large n (if n can be factored quickly)
div2 := function(n)
  local f, p;
  f := Collected(FactorsInt(n));
  p := List(f, v -> List([0 .. v[2]], k -> v[1]^k));
  return SortedList(List(Cartesian(p), Product));
end;

div2(Factorial(5));
# [ 1, 2, 3, 4, 5, 6, 8, 10, 12, 15, 20, 24, 30, 40, 60, 120 ]


text:
# Built-in
a := 2988348162058574136915891421498819466320163312926952423791023078876139;
b := 2351399303373464486466122544523690094744975233415544072992656881240319;
PowerModInt(a, b, 10^40);
1527229998585248450016808958343740453059

# Implementation
PowerModAlt := function(a, n, m)
    local r;
    r := 1;
    while n > 0 do
        if IsOddInt(n) then
            r := RemInt(r*a, m);
        fi;
        n := QuoInt(n, 2);
        a := RemInt(a*a, m);
    od;
    return r;
end;

PowerModAlt(a, b, 10^40);


text:
Ackermann := function( m, n )

  if m = 0 then
      return n + 1;
  elif m > 0 and n = 0 then
      return Ackermann( m - 1, 1 );
  fi;

  return Ackermann( m - 1, Ackermann( m, n - 1 ) );

end;

max_stars_repo_name: Mynogs/Algorithm-Implementations

max_issues_repo_name: Mynogs/Algorithm-Implementations

max_forks_repo_name: Mynogs/Algorithm-Implementations


text:
# All of this is built-in
Derangements([1 .. 4]);
# [ [ 2, 1, 4, 3 ], [ 2, 3, 4, 1 ], [ 2, 4, 1, 3 ], [ 3, 1, 4, 2 ], [ 3, 4, 1, 2 ], [ 3, 4, 2, 1 ],
#   [ 4, 1, 2, 3 ], [ 4, 3, 1, 2 ], [ 4, 3, 2, 1 ] ]
Size(last);
# 9

NrDerangements([1 .. 4]);
# 9

# An implementation using formula D(n + 1) = n*(D(n) + D(n - 1))
NrDerangementsAlt_memo := [1, 0];
NrDerangementsAlt := function(n)
	if not IsBound(NrDerangementsAlt_memo[n + 1]) then
		NrDerangementsAlt_memo[n + 1] := (n - 1)*(NrDerangementsAlt(n - 1) + NrDerangementsAlt(n - 2));
	fi;
	return NrDerangementsAlt_memo[n + 1];
end;

L := List([0 .. 9]);

PrintArray(TransposedMat([L,
	List(L, n -> Size(Derangements([1 .. n]))),
	List(L, n -> NrDerangements([1 .. n])),
	List(L, NrDerangementsAlt)]));
# [ [       0,       1,       1,       1 ],
#   [       1,       0,       0,       0 ],
#   [       2,       1,       1,       1 ],
#   [       3,       2,       2,       2 ],
#   [       4,       9,       9,       9 ],
#   [       5,      44,      44,      44 ],
#   [       6,     265,     265,     265 ],
#   [       7,    1854,    1854,    1854 ],
#   [       8,   14833,   14833,   14833 ],
#   [       9,  133496,  133496,  133496 ] ]


text:
ZigZag := function(n)
  local a, i, j, k;
  a := NullMat(n, n);
  i := 1;
  j := 1;
  for k in [0 .. n*n - 1] do
    a[i][j] := k;
    if (i + j) mod 2 = 0 then
      if j < n then
        j := j + 1;
      else
        i := i + 2;
      fi;
      if i > 1 then
        i := i - 1;
      fi;
    else
      if i < n then
        i := i + 1;
      else
        j := j + 2;
      fi;
      if j > 1 then
        j := j - 1;
      fi;
    fi;
  od;
  return a;
end;

PrintArray(ZigZag(5));
# [ [   0,   1,   5,   6,  14 ],
#   [   2,   4,   7,  13,  15 ],
#   [   3,   8,  12,  16,  21 ],
#   [   9,  11,  17,  20,  22 ],
#   [  10,  18,  19,  23,  24 ] ]


text:
# Spiral matrix with numbers 1 .. n2, more natural in GAP
SpiralMatrix := function(n)
  local i, j, k, di, dj, p, vi, vj, imin, imax, jmin, jmax;
  a := NullMat(n, n);
  vi := [ 1, 0, -1, 0 ];
  vj := [ 0, 1, 0, -1 ];
  imin := 0;
  imax := n;
  jmin := 1;
  jmax := n + 1;
  p := 1;
  di := vi[p];
  dj := vj[p];
  i := 1;
  j := 1;
  for k in [1 .. n*n] do
    a[j][i] := k;
    i := i + di;
    j := j + dj;
    if i < imin or i > imax or j < jmin or j > jmax then
      i := i - di;
      j := j - dj;
      p := RemInt(p, 4) + 1;
      di := vi[p];
      dj := vj[p];
      i := i + di;
      j := j + dj;
      if p = 1 then
        imax := imax - 1;
      elif p = 2 then
        jmax := jmax - 1;
      elif p = 3 then
        imin := imin + 1;
      else
        jmin := jmin + 1;
      fi;
    fi;
  od;
  return a;
end;

PrintArray(SpiralMatrix(5));
# [ [   1,   2,   3,   4,   5 ],
#   [  16,  17,  18,  19,   6 ],
#   [  15,  24,  25,  20,   7 ],
#   [  14,  23,  22,  21,   8 ],
#   [  13,  12,  11,  10,   9 ] ]


text:
# According to section 21.18 of the reference manual, Sort is not stable (it's a Shell sort).
# However, SortingPerm is stable. We will see it on an example, showing indexes of elements after the sort.

n := 20;
L := List([1 .. n], i -> Random("AB"));
# "AABABBBABBABAABABBAB"

p := SortingPerm(L);
# (3,10,15,17,18,19,9,14,7,13,6,12,16,8,4)(5,11)

a := Permuted(L, p);;
b := Permuted([1 .. n], p);;

PrintArray(TransposedMat(List([1 .. n], i -> [a[i], b[i]])));
# [ [  'A',  'A',  'A',  'A',  'A',  'A',  'A',  'A',  'A',  'B',  'B',  'B',  'B',  'B',  'B',  'B',  'B',  'B',  'B',  'B' ],
#   [    1,    2,    4,    8,   11,   13,   14,   16,   19,    3,    5,    6,    7,    9,   10,   12,   15,   17,   18,   20 ] ]


text:
QuadraticRoots := function(a, b, c)
  local d;
  d := Sqrt(b*b - 4*a*c);
  return [ (-b+d)/(2*a), (-b-d)/(2*a) ];
end;

# Hint : E(12) is a 12th primitive root of 1
QuadraticRoots(2, 2, -1);
# [ 1/2*E(12)^4-1/2*E(12)^7+1/2*E(12)^8+1/2*E(12)^11,
#   1/2*E(12)^4+1/2*E(12)^7+1/2*E(12)^8-1/2*E(12)^11 ]

# This works also with floating-point numbers
QuadraticRoots(2.0, 2.0, -1.0);
# [ 0.366025, -1.36603 ]


text:
MultiFactorial := function(n, k)
    local r;
    r := 1;
    while n > 1 do
        r := r*n;
        n := n - k;
    od;
    return r;
end;

PrintArray(List([1 .. 10], n -> List([1 .. 5], k -> MultiFactorial(n, k))));
[ [        1,        1,        1,        1,        1 ],
  [        2,        2,        2,        2,        2 ],
  [        6,        3,        3,        3,        3 ],
  [       24,        8,        4,        4,        4 ],
  [      120,       15,       10,        5,        5 ],
  [      720,       48,       18,       12,        6 ],
  [     5040,      105,       28,       21,       14 ],
  [    40320,      384,       80,       32,       24 ],
  [   362880,      945,      162,       45,       36 ],
  [  3628800,     3840,      280,      120,       50 ] ]


text:
MersenneSmallFactor := function(n)
    local k, m, d;
    if IsPrime(n) then
        d := 2*n;
        m := 1;
        for k in [1 .. 1000000] do
            m := m + d;
            if PowerModInt(2, n, m) = 1 then
                return m;
            fi;
        od;
    fi;
    return fail;
end;

# If n is not prime, fail immediately
MersenneSmallFactor(15);
# fail

MersenneSmallFactor(929);
# 13007

MersenneSmallFactor(1009);
# 3454817

# We stop at k = 1000000 in 2*k*n + 1, so it may fail if 2^n - 1 has only larger factors
MersenneSmallFactor(101);
# fail

FactorsInt(2^101-1);
# [ 7432339208719, 341117531003194129 ]