Median := function(v)
  local n, w;
  w := SortedList(v);
  n := Length(v);
  return (w[QuoInt(n + 1, 2)] + w[QuoInt(n, 2) + 1]) / 2;
end;

a := [41, 56, 72, 17, 93, 44, 32];
b := [41, 72, 17, 93, 44, 32];

Median(a);
# 44
Median(b);
# 85/2


# Return the list L after applying Knuth shuffle. GAP also has the function Shuffle, which does the same.
ShuffleAlt := function(a)
    local i, j, n, t;
    n := Length(a);
    for i in [n, n - 1 .. 2] do
        j := Random(1, i);
        t := a[i];
        a[i] := a[j];
        a[j] := t;
    od;
    return a;
end;

# Return a "Permutation" object (a permutation of 1 .. n).
# They are printed in GAP, in cycle decomposition form.
PermShuffle := n -> PermList(ShuffleAlt([1 .. n]));

ShuffleAlt([1 .. 10]);
# [ 4, 7, 1, 5, 8, 2, 6, 9, 10, 3 ]

PermShuffle(10);
# (1,9)(2,3,6,4,5,10,8,7)

# One may also call the built-in random generator on the symmetric group :
Random(SymmetricGroup(10));
(1,8,2,5,9,6)(3,4,10,7)


Pascal := function(n)
	local i, v;
	v := [1];
	for i in [1 .. n] do
		Display(v);
		v := Concatenation([0], v) + Concatenation(v, [0]);
	od;
end;

Pascal(9);
# [ 1 ]
# [ 1, 1 ]
# [ 1, 2, 1 ]
# [ 1, 3, 3, 1 ]
# [ 1, 4, 6, 4, 1 ]
# [ 1, 5, 10, 10, 5, 1 ]
# [ 1, 6, 15, 20, 15, 6, 1 ]
# [ 1, 7, 21, 35, 35, 21, 7, 1 ]
# [ 1, 8, 28, 56, 70, 56, 28, 8, 1 ]


merge_lists := function( list1, list2 )
  local i, j, merged_list;

  merged_list := [ ];

  i := 1;

  j := 1;

  while i <= Length( list1 ) and j <= Length( list2 ) do

      if list1[ i ] <= list2[ j ] then

          Add( merged_list, list1[ i ] );

          i := i + 1;

      else

          Add( merged_list, list2[ j ] );

          j := j + 1;

      fi;

  od;

  if i <= Length( list1 ) then

      Append( merged_list, list1{[ i .. Length( list1 ) ]} );

  else

      Append( merged_list, list2{[ j .. Length( list2 ) ]} );

  fi;

  return merged_list;

end;

merge_sort := function( list )
  local lists_to_merge;

  if Length( list ) = 1 then

      return list;

  fi;

  lists_to_merge := [ ];

  lists_to_merge[ 1 ] := merge_sort( list{[ 1 .. Int( Length( list ) / 2 ) ]} );

  lists_to_merge[ 2 ] := merge_sort( list{[ Int( Length( list ) / 2 ) + 1 .. Length( list ) ]} );

  return merge_lists( lists_to_merge[ 1 ], lists_to_merge[ 2 ] );

end;


# Built-in
Factorial(5);

# An implementation
fact := n -> Product([1 .. n]);


LucasLehmer := function(n)
    local i, m, s;
    if n = 2 then
        return true;
    elif not IsPrime(n) then
        return false;
    else
        m := 2^n - 1;
        s := 4;
        for i in [3 .. n] do
            s := RemInt(s*s, m) - 2;
        od;
        return s = 0;
    fi;
end;

Filtered([1 .. 2000], LucasLehmer);
[2, 3, 5, 7, 13, 17, 19, 31, 61, 89, 107, 127, 521, 607, 1279]


x := Indeterminate(Rationals, "x");
p := x^11 + 3*x^8 + 7*x^2 + 3;
q := x^7 + 5*x^3 + 1;
QuotientRemainder(p, q);
# [ x^4+3*x-5, -16*x^4+25*x^3+7*x^2-3*x+8 ]


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

#F RHT( <log2(size)> ) - Rationalized Haar Transform non-terminal
#F
#F Definition: RHT(n) represents the (2^n x 2^n)-matrix defined recursively as:
#F             RHT(1) := DFT_2
#F             RHT(n) := [[ RHT(n-1) tensor [1, 1] ],
#F                        [ I_(n-1)  tensor [1 -1] ]]
#F Note:       I_(n-1) denotes the (2^(n-1) x 2^(n-1)) identity matrix
#F             DFT_2 denotes the matrix [[1, 1], [1, -1]]
#F Example:    RHT(6)
#F             RHT(6).transpose()
Class(RHT, NonTerminal, rec (
    abbrevs := [ n -> Checked(IsInt(n), n > 0, [n]) ],
    dims      := self >> [ 2^self.params[1], 2^self.params[1] ],
    terminate := self >> Cond(
	self.params[1] = 1,  F(2),
	self.transposed, Mat(RationalizedHaarTransform(2^self.params[1])).transpose(),
	                 Mat(RationalizedHaarTransform(2^self.params[1]))),
    isReal := True,
    SmallRandom := () -> [ Random([1..6]) ]
));

RulesFor(RHT, rec(
    #F RHT_Base: (base case) RHT_(2^1) = F_2
    #F
    RHT_Base := rec (
	info             := "RHT_(2^1) -> F_2",
	forTransposition := false,
	isApplicable     := P -> P[1] = 1,
	rule := (P, C) -> F(2)
    ),

    #F RHT_CooleyTukey: RHT_2^(n+1) = (RHT_2^(n) dirsum I_2^n) * (DFT_2 tensor I_2^n) * L
    #F
    RHT_CooleyTukey := rec (
	info             := "RHT_2^(n+1) -> (RHT_2^n dirsum I_n) * (F_2 tensor I_n)",
	isApplicable     := P -> P[1] > 1,
	allChildren      := P -> [[ RHT(P[1] - 1) ]],
	rule := (P, C) ->
	    Inplace(DirectSum(C[1], I(2 ^ (P[1]-1)))) *
	    Tensor(F(2), I(2 ^ (P[1]-1))) *
	    L(2^P[1], 2)
    )
));


MovingAverage := function(n)
  local sma, buffer, pos, sum, len;
  buffer := List([1 .. n], i -> 0);
  pos := 0;
  len := 0;
  sum := 0;
  sma := function(x)
    pos := RemInt(pos, n) + 1;
    sum := sum + x - buffer[pos];
    buffer[pos] := x;
    len := Minimum(len + 1, n);
    return sum/len;
  end;
  return sma;
end;

f := MovingAverage(3);
f(1);  #  1
f(2);  #  3/2
f(3);  #  2
f(4);  #  3
f(5);  #  4
f(5);  #  14/3
f(4);  #  14/3
f(3);  #  4
f(2);  #  3
f(1);  #  2


# Copyright (c) 2018-2021, Carnegie Mellon University
# See LICENSE for details

Class(DTTBase, NonTerminal, rec(
    abbrevs := [ N -> Checked(IsInt(N), N >= 1, [N]) ],
    dims := self >> [self.params[1], self.params[1]],
    isReal := True,

    normalizedArithCost := self >> let(n:=Double(self.params[1]),
        2.5*n*d_log(n)/d_log(2)),

    hashAs := self >> self
));

Declare(DCT3, DCT7);

#F DCT1(<n>) - Discrete Cosine Transform, Type I, non-terminal
#F Definition: (n x n)-matrix [ cos(k*l*pi/(n-1)) | k,l = 0...n-1 ]
#F Note:       The natural size for a DCT1 is 2^k + 1
#F Example:    DCT1(9)
#F
Class(DCT1, DTTBase, rec(
    terminate := self >> Mat(DCT_Iunscaled(self.params[1])),
    transpose := self >> Copy(self),
    SmallRandom := () -> Random([3,4,5,7,9,13,17,25,33])
));

#F DCT2(<n>) - Discrete Cosine Transform, Type II, non-terminal
#F Definition: (n x n)-matrix [ cos(k*(l+1/2)*pi/n) | k,l = 0...n-1 ]
#F Note:       DCT2 is the transpose of DCT3
#F Example:    DCT2(8)
Class(DCT2, DTTBase, rec(
    terminate := self >> Mat(DCT_IIunscaled(self.params[1])),
    transpose := self >> DCT3(self.params[1]),
    SmallRandom := () -> Random([2,3,4,5,6,8,9,10,12,15,16,18,24,27,30,32])
));

#F DCT3(<n>) - Discrete Cosine Transform, Type III, non-terminal (unscaled)
#F Definition: (n x n)-matrix [ cos((k+1/2)*l*pi/n) | k,l = 0...n-1 ]
#F  [scaled]   (n x n)-matrix [ a_l*cos((k+1/2)*l*pi/n) | k,l = 0...n-1 ]
#F                              a_j = 1/sqrt(2) for j = 0 and = 1 else
#F Note:       DCT3 is the transpose of DCT2, scaled NOT supported yet
#F Example:    DCT3(8)
Class(DCT3, DTTBase, rec(
    terminate := self >> Mat(DCT_IIIunscaled(self.params[1])),
    transpose := self >> DCT2(self.params[1]),
    SmallRandom := () -> Random([2,3,4,5,6,8,9,10,12,15,16,18,24,27,30,32])
));

#F DCT4(<size>) - Discrete Cosine Transform, Type IV, non-terminal
#F Definition: (n x n)-matrix  [ cos((k+1/2)*(l+1/2)*pi/n) | k,l = 0...n-1 ]
#F Note:       DCT4 is symmetric
#F Example:    DCT4(8)
Class(DCT4, DTTBase, rec(
    terminate := self >> Mat(DCT_IVunscaled(self.params[1])),
    transpose := self >> Copy(self),
    SmallRandom := () -> Random([2, 3, 4, 6, 8, 9, 12, 16, 18, 24, 27, 32])
));

#F DCT5(<size>) - Discrete Cosine Transform, Type V, non-terminal
#F Definition: (n x n)-matrix   [ cos(k*l*pi/(n-1/2)) | k,l = 0...n-1 ]
#F Note:       DCT5 is symmetric
#F Example:    DCT5(8)
Class(DCT5, DTTBase, rec(
    terminate := self >> Mat(DCT_Vunscaled(self.params[1])),
    transpose := self >> Copy(self),
));

#F DCT6(<size>) - Discrete Cosine Transform, Type VI, non-terminal
#F Definition: (n x n)-matrix   [ cos(k*(l+1/2)*pi/(n-1/2)) | k,l = 0...n-1 ]
#F Note:       The transpose of DCT6 is DCT7
#F Example:    DCT6(8)
Class(DCT6, DTTBase, rec(
    terminate := self >> Mat(DCT_VIunscaled(self.params[1])),
    transpose := self >> DCT7(self.params[1]),
));

#F DCT7(<size>) - Discrete Cosine Transform, Type VII, non-terminal
#F Definition: (n x n)-matrix   [ cos((k+1/2)*l*pi/(n-1/2)) | k,l = 0...n-1 ]
#F Note:       The transpose of DCT7 is DCT6
#F Example:    DCT7(8)
Class(DCT7, DTTBase, rec(
    terminate := self >> Mat(DCT_VIIunscaled(self.params[1])),
    transpose := self >> DCT6(self.params[1]),
));

#F DCT8(<size>) - Discrete Cosine Transform, Type VIII, non-terminal
#F Definition: (n x n)-matrix [ cos((k+1/2)*(l+1/2)*pi/(n+1/2)) | k,l = 0...n-1 ]
#F Note:       DCT8 is symmetric
#F Example:    DCT8(8)
Class(DCT8, DTTBase, rec(
    terminate := self >> Mat(DCT_VIIIunscaled(self.params[1])),
    transpose := self >> Copy(self)
));


# Built-in
IdentityMat(3);

# One can also specify the base ring
IdentityMat(3, Integers mod 10);


# The idiomatic way to compute with polynomials

x := Indeterminate(Rationals, "x");

# This is a value in a polynomial ring, not a function
p := 6*x^3 - 4*x^2 + 7*x - 19;

Value(p, 3);
# 128

u := CoefficientsOfUnivariatePolynomial(p);
# [ -19, 7, -4, 6 ]

# One may also create the polynomial from coefficients
q := UnivariatePolynomial(Rationals, [-19, 7, -4, 6], x);
# 6*x^3-4*x^2+7*x-19

p = q;
# true

# Now a Horner implementation
Horner := function(coef, x)
	local v, c;
	v := 0;
	for c in Reversed(coef) do
		v := x*v + c;
	od;
	return v;
end;

Horner(u, 3);
# 128


NextPermutation := function(a)
   local i, j, k, n, t;
   n := Length(a);
   i := n - 1;
   while i > 0 and a[i] > a[i + 1] do
      i := i - 1;
   od;
   j := i + 1;
   k := n;
   while j < k do
      t := a[j];
      a[j] := a[k];
      a[k] := t;
      j := j + 1;
      k := k - 1;
   od;
   if i = 0 then
      return false;
   else
      j := i + 1;
      while a[j] < a[i] do
         j := j + 1;
      od;
      t := a[i];
      a[i] := a[j];
      a[j] := t;
      return true;
   fi;
end;

Permutations := function(n)
   local a, L;
   a := List([1 .. n], x -> x);
   L := [ ];
   repeat
      Add(L, ShallowCopy(a));
   until not NextPermutation(a);
   return L;
end;

Permutations(3);
[ [ 1, 2, 3 ], [ 1, 3, 2 ],
  [ 2, 1, 3 ], [ 2, 3, 1 ],
  [ 3, 1, 2 ], [ 3, 2, 1 ] ]


RandNGen := function(n)
	local v, rand;
	v := [1 .. n - 1]*0;
	Add(v, 1);
	rand := function()
		return Random(v);
	end;
	return rand;
end;

UnbiasedGen := function(rand)
	local unbiased;
	unbiased := function()
		local a, b;
		while true do
			a := rand();
			b := rand();
			if a <> b then
				break;
			fi;
		od;
		return a;
	end;
	return unbiased;
end;

range := [2 .. 6];
v := List(range, RandNGen);
w := List(v, UnbiasedGen);
apply := gen -> Sum([1 .. 1000000], n -> gen());

# Some tests (2 is added as a witness, since in this case RandN is already unbiased)
PrintArray(TransposedMat([range, List(v, apply), List(w, apply)]));
# [ [       2,  499991,  499041 ],
#   [       3,  333310,  500044 ],
#   [       4,  249851,  500663 ],
#   [       5,  200532,  500448 ],
#   [       6,  166746,  499859 ] ]


#############################################################################
##
#A  util.gi                 toric library          David Joyner
##
##
##  This file contains miscellaneous functions
##
##

TORIC:=rec();

##
##  returns 1 if i=j, 0 otherwise
##
TORIC.krondecker_delta:=function(i, j)
if i = j then return 1; fi;
return 0;
end;

##
##  takes a lists of lists and returns the elements
##
TORIC.flatten:=function(L)
local L0,L1,i;
 L0:=ShallowCopy(L[1]);
 if Size(L) = 1 then return L0; fi;
 for i in [2..Size(L)] do
   Append(L0, L[i]);
 od;
 return Set(L0);
end;

##
##  the ``inner product'' v1^t*A*v2
##
TORIC.inner_product:=function(v1,v2,A) return v1*A*v2; end;

##
##  returns a list of dim-vectors of length dim
##
TORIC.make_basis:=function(dim)
local e,i,j;
 e:=[];
 for i in [1..dim] do
  e[i]:=List(TORIC.kronecker_delta(i,j), j in [1..dim]);
 od;
end;

##
##  Input: L is a list of vectors L:=[v1,...,vn]
##  Output: max abs value of all coords of all vecs vi
##
TORIC.max_vectors:=function(L)
 local n,max0,min0,i,max;
  n:=Size(L);
  max:=0;
  for i in [1..n] do
   max0:=Maximum(L[i]);
   min0:=Minimum(L[i]);
   max:=Maximum([max,AbsoluteValue(max0),AbsoluteValue(min0)]);
  od;
 return max;
end;

##
##  for lists L1, L2, returns Boolean Is L1 subset L2?
##
TORIC.is_sublist:=function(L1, L2)
 local i,j,ans,x,y;
  x:=Set(L1);
  y:=Set(L2);
  if IsSubset(y,x) then return true; fi;
 return false;
end;

##
##      Input: L is a list of n-1 vectors in Q^n
##      Output: a vector v s.t. <v,h>=0, for all h in span(L)
##
TORIC.normal_to_hyperplane:=function(L)
 local normal;
  normal:=NullspaceMat(TransposedMat(L));
 return normal[1];
end;

##
##      Input: L is a list of r vectors
##      Output: true if all vectors have same length
##              false otherwise
##
TORIC.consistent_vectors:=function(L)
 local a,b,i,n;
 n:=Length(L);
 b:=Maximum(List([1..n],i->Length(L[i])));
 a:=Minimum(List([1..n],i->Length(L[i])));
 if a<>b then
  Error("\n The vectors must all have the same length.\n");
 fi;
end;


#############################################################################
##
#A  toric.gi                  toric library                      David Joyner
##
##  this file contains implementations for toric
##
## 3-6-2006, changed Star to ToricStar, as a method instead of a
##           global function
##

#############################################################################
##
#F  InDualCone(<v>,<L>)
##
##  returns true if v belongs to the dual of the code generated by
##  the vectors in L
##
InstallGlobalFunction(InDualCone,function(v,L)
 local numgens,dim,i,V;
  TORIC.consistent_vectors(L);
  dim:=Size(v);
  numgens:=Size(L);
# V := Rationals^dim;
  for i in [1..numgens] do
   if TORIC.inner_product(v,L[i],IdentityMat(dim)) < 0 then return false; fi;
  od;
 return true;
end);

#############################################################################
##
#F  DualSemigroupGenerators(<L>)
##
##  Input: L is a list of integral n-vectors
##          generating a cone sigma
##  Output: the generators of S_sigma,
##
##  Idea:  let M be the max of the abs values of the
##  coords of the L[i]'s, for each vector v in
##  [1..M]^n, test if v in sigma^*. If so,
##  add to list of possible generators.
##  Once this for loop is finished, one can check
##  this list for redundant generators. The
##  trick below is to simply omit those elements
##  which are of the form d1+d2, where d1 and d2
##  are "small" elements in the integral dual cone.
##
InstallGlobalFunction(DualSemigroupGenerators,
function(L)
local d,i,dim,V,D,max,v,I,b,DpD,d1,d2,Dgens;
 TORIC.consistent_vectors(L);
 dim:=Size(L[1]);
 V := Rationals^dim;
 max:=TORIC.max_vectors(L);
 D:=[];
 I:= Cartesian(List([1..dim],i->[-max..max]));
 for v in I do
  if InDualCone(v,L) then
   Append(D,[v]);
  fi;
 od;
 DpD:=[];
 for d1 in D do
  if TORIC.inner_product(d1,d1,IdentityMat(dim)) <> 0 then
  for d2 in D do
   if TORIC.inner_product(d2,d2,IdentityMat(dim)) <> 0 then
      Append(DpD,[d1+d2]);
   fi;
  od;
  fi;
 od;
 Dgens:=[];
 for d in D do
  if not(d in DpD) then
     Append(Dgens,[d]);
  fi;
 od;
 return Dgens;
end);

#############################################################################
##
#F  EmbeddingAffineToricVariety(<L>)
##
##  Input: L is a list generating a cone
##        (as in dual_semigp_gens),
##  Output: the toroidal embedding of X=affine_toric_variety(L)
##       (given as a list of multinomials)
##
InstallGlobalFunction(EmbeddingAffineToricVariety,
function(L)
local map0,u,O,i,P1,P2,e,dim,V,R1,R2,hom;
 TORIC.consistent_vectors(L);
 u:=DualSemigroupGenerators(L);
 dim:=Size(u[1]);
 V:=Rationals^dim;
 O:=Zero(V);
 u:=Difference(u,[O]);
 map0:=[];
 for e in u do
  P1:=Filtered([1..dim],i->e[i] < 0);
  P2:=Filtered([1..dim],i->e[i] >= 0);
  if Size(P1) > 0 then
    Add(map0, Product(P2,i->X(Rationals,i)^(e[i]))/Product(P1,i->X(Rationals,i+dim)^(-e[i])));
  fi;
  if Size(P1) = 0 then
    Add(map0, Product(P2,i->X(Rationals,i)^(e[i])));
  fi;
 od;
 return map0;
end);

#############################################################################
##
#F  DivisorPolytope(<D>, <Rays>)
##
##  Input: D is the list of coeffs for the Weil divisor D
##  Rays is the list of vectors in the rays for the fan Delta
##   (Delta is determined by a list of generators L
##    but these are not explicitly needed here)
##  Output: the linear expressions in the affine coordinates of the
##   space of the cone which must be >0 for a point to be in the
##   desired polytope
##
InstallGlobalFunction(DivisorPolytope,
function(D,Rays)
local n,Inequalities,R,i,j;
 TORIC.consistent_vectors(Rays);
 n:=Size(Rays[1]);
 Inequalities:=[];
 R:=PolynomialRing(Rationals,n);
 for i in [1..Size(Rays)] do
  Add(Inequalities,D[i]+Sum([1..n],j->X(Rationals,j)*Rays[i][j]));
 od;
 return Inequalities;
end);

#############################################################################
##
#F  PolytopeLatticePoints(<A>, <Perps>)
##
##  Input: Perps=[v1,...,vk] is the list of "inward normal"
##            vectors perpendicular to the walls of the polytope P,
##         A=[a1,...,ak] is the amount wall is shifted from the
##            origin (ai>=0)
##       Eg, x=0, x=a, y=0, y=b has Perps=[[1,0],[-1,0],[0,1],[0,-1]]
##           and A=[0,a,0,b]
##  Output: the list of points in P \cap L^\perp
##
InstallGlobalFunction(PolytopeLatticePoints,
function(A,Perps)
local R,n,M,Pts,i,j,Inequalities,L0,L1,L2,v,ineq;
 TORIC.consistent_vectors(Perps);
 R:=ShallowCopy(Perps);
 n:=Size(R[1]);
 M:=Maximum(List([1..Size(A)],i->AbsoluteValue(A[i])));
 L0:=List([1..n],i->[-M..M]);
 Pts:=Cartesian(L0);
 L2:=[];
 for v in Pts do
  Inequalities:=[];
  for i in [1..Size(R)] do
   ineq:=A[i]+Sum([1..n],j->v[j]*R[i][j]);
   Add(Inequalities,ineq);
  od;
  if Minimum(Inequalities) >= 0 then Add(L2,v); fi;
 od;
 return L2;
end);

#############################################################################
##
#F  DivisorPolytopeLatticePoints(<D>, <Cones>, <Rays_ordered> )
##
##  Input: Cones is the fan
##         Rays_ordered is the *ordered* list of rays for Cones
##         D is the list of coeffs for the Weil divisor D
##  Output: the list of points in P_D \cap L^\perp
##            which paramterize the elements in L(D)
##
##  Caution: The set of rays do not determine the cones in a fan.
##
InstallGlobalFunction(DivisorPolytopeLatticePoints,
function(D,Cones,Rays_ordered)
local R,n,M,Pts,i,j,Inequalities,L0,L1,L2,v,ineq,Rays;
 TORIC.consistent_vectors(Rays_ordered);
 Rays:=Rays_ordered;
 R:=ShallowCopy(Rays);
 n:=Size(R[1]);
 M:=Maximum(List([1..Size(D)],i->AbsoluteValue(D[i])));
 L0:=List([1..n],i->[-M..M]);
 Pts:=Cartesian(L0);
 L2:=[];
 for v in Pts do
  Inequalities:=List([1..Size(R)],i->D[i]+Sum([1..n],j->v[j]*R[i][j]));
  if Minimum(Inequalities) >= 0 then Add(L2,v); fi;
 od;
 return L2;
end);

#############################################################################
##
#F  RiemannRochBasis(<D>, <Cones>, <Rays> )
##
##  Input: Cones is the fan
##         Rays_ordered is the *ordered* list of rays for Cones
##         D is the list of coeffs for the Weil divisor D
##
##  Output: computes a basis (a list of monomials)
##           for the RR space of the divisor represented by D
##
##
InstallGlobalFunction(RiemannRochBasis,
function(D,Cones,Rays)
local P,map0,d,R,e,i,P1,P2;
 TORIC.consistent_vectors(Rays);
 P:=DivisorPolytopeLatticePoints(D,Cones,Rays);
 map0:=[];
 d:=Size(Rays[1]);
 R:=PolynomialRing(Rationals,d);
 for e in P do
  P1:=Filtered([1..d],i->e[i] < 0);
  P2:=Filtered([1..d],i->e[i] >= 0);
  if Size(P1) > 0 and Size(P2) > 0 then
    Add(map0, Product(P2,i->X(Rationals,i)^(e[i]))/Product(P1,i->X(Rationals,i)^(-e[i])));
  fi;
  if Size(P1)= 0 then
    Add(map0, Product(P2,i->X(Rationals,i)^(e[i])));
  fi;
  if Size(P2) = 0 then
    Add(map0, 1/Product(P1,i->X(Rationals,i)^(-e[i])));
  fi;
 od;
 return map0;
end);

#############################################################################
##
#F  Faces( <Rays> )
##
##  Input: Rays is a list of rays for the fan Delta
##
##  Output: all the normals to the faces (hyperplanes of the cone)
##
##
InstallGlobalFunction(Faces,function(Rays)
local i,normals,n0,N,m,R,dim_sets,dim,v,pos,neg,n1,v0,N0;
 TORIC.consistent_vectors(Rays);
 normals:=[];
 R:=ShallowCopy(Rays);
 dim:=Size(R[1]);
 if dim<=1 then return
   Error("\n Dimension of ambient space for the rays must be >1.\n");
 fi;
 v:=Sum(R);
 dim_sets:=Combinations(R,dim-1); ##### must have dim>1 here!
 for m in dim_sets do
  n0:=TORIC.normal_to_hyperplane(m);
  if TORIC.inner_product(v,n0,IdentityMat(dim))>0 then Add(normals,n0);
    else
    Add(normals,-n0);
  fi;
 od;
 Sort(normals);
 N0:=ShallowCopy(normals);
 N:=ShallowCopy(normals);
 for n1 in N do
    if Minimum(List(Rays,v0->TORIC.inner_product(v0,n1,IdentityMat(dim))))<0 then
        N0:=Difference(N0,[n1]);
    fi;
 od;
 return Set(N0);
end);

#############################################################################
##
#F  InsideCone(<v>, <Rays> )
##
##  Input: Rays is a list of rays for the fan Delta
##
##  Output: true if v is in the cone represented by Rays
##          (a cone is a list of vectors generating it),
##          false otherwise
##
##  Idea: look at all dim-subsets of Rays and test if
##        there is a positive solns vector all the normals
##        to the faces (hyperplanes of the cone)
##
##
InstallGlobalFunction(InsideCone,function(v,Rays)
local w,F,dim,R;
 TORIC.consistent_vectors(Rays);
 R:=ShallowCopy(Rays);
 dim:=Size(R[1]);
 if Length(v)<>dim then
   Error("\n The vector ",v," must have the same dimension as the fan.\n");
 fi;
 if dim<=1 then return false; fi;
 F:=Faces(R);
 if Minimum(List(F,w->TORIC.inner_product(v,w,IdentityMat(dim))))<=0 then
  return false;
 fi;
 return true;
end);

#############################################################################
##
#F  NumberOfConesOfFan( <Delta>, <k> )
##
##  Input: Delta is the fan of cones
##         k is the dimension of the cones counted
##  Output: number of k-diml cones in the fan
##          (each hyperplane of one cone should not form the face
##           of any other cone in the fan)
##
##  Idea:   the fan Delta is represented as a set of max cones.
##          for each max cone, look at the k-diml faces
##          obtained by taking n choose k subsets of the
##          rays describing the cone.
##          **Certain** of these k-subsets yield the
##          desired cones
##
InstallGlobalFunction(NumberOfConesOfFan,
function(Cones,k)
local sigma,R,Rays,n,i,j,C,C0,dim,ell,k_cones,sigma0,N,v0,v;
 if k=0 then return 1; fi;
 C0:=ShallowCopy(Cones);
 Rays:=TORIC.flatten(C0);
 R:=ShallowCopy(Rays);
 if k=1 then return Size(R); fi;
 k_cones:=[];
 dim:=Size(R[1]);
 if k>dim then Print("dimension error\n"); return 0; fi;
 N:=Size(C0);
 if k=dim then return N; fi;
 for i in [1..N] do
  C:=ShallowCopy(Cones[i]);
  sigma:= Combinations(C,k);
  for ell in [1..Size(sigma)] do
     v0:=Sum(sigma[ell]);
     if not(InsideCone(v0,C)) then  Add(k_cones,sigma[ell]); fi;
  od;
 od;
 return Size(Set(k_cones));
end);

#############################################################################
##
#F  ConesOfFan( <Delta>, <k> )
##
##  Input: Delta is the fan of cones
##         k is the dimension of the cones taken
##  Output: the set of k-diml cones in the fan
##          (each hyperplane of one cone should not form the face
##           of any other cone in the fan, ie,
##           only takes those subcones which are *not* interior)
##
##
InstallGlobalFunction(ConesOfFan,
function(Cones,k)
local sigma,R,Rays,n,x,i,j,C,C0,dim,ell,k_cones,sigma0,N,v0,v;
 C0:=ShallowCopy(Cones);
 if k=0 then return 0*C0[1][1]; fi;
 Rays:=TORIC.flatten(C0);
 R:=ShallowCopy(Rays);
 if k=1 then return List(R,x->[x]); fi;
 k_cones:=[];
 dim:=Size(R[1]);
 if k>dim then Print("dimension error\n"); return 0; fi;
 N:=Size(C0);
 if k=dim then return C0; fi;
 for i in [1..N] do
  C:=ShallowCopy(Cones[i]);
  sigma:= Combinations(C,k);
  for ell in [1..Size(sigma)] do
      v0:=Sum(sigma[ell]);
   if not(InsideCone(v0,C)) then  Add(k_cones,sigma[ell]); fi;
  od; ##excludes the "interior" cones
 od;
 return Set(k_cones);
end);

#############################################################################
##
#F  ToricStar( <cone>, <Cones> )
##
##  Input: Cones is the fan of cones
##         <cone> is a cone of <Cones>
##  Output: the star of the cone in a fan
##          ie, the cones tau which have <cone> as a face
##
##
InstallGlobalFunction(ToricStar,
function(cone,Cones)
local T,tau,Taus,i,j,sigma,C0,R,Rays,dim;
 sigma:=ShallowCopy(cone);
 C0:=ShallowCopy(Cones);
 Rays:=TORIC.flatten(C0);
 R:=ShallowCopy(Rays);
 dim:=Size(R[1]);
 Taus:=[];
 for j in [1..dim] do
    tau:=ConesOfFan(C0,j);
    Append(Taus,tau);
 od;
 T:=[];
 for tau in Taus do
    if TORIC.is_sublist(sigma,tau) then Append(T,[tau]); fi;
 od;
 return T;
end);

#############################################################################
##
#F  BettiNumberToric( <Cones>, <k> )
##
##  Input: Cones is the fan of cones
##         k is an integer
##  Output: the k-th betti number of the toric variety
##          X(Delta), where Delta is a fan defined by its maximal
##          cones, Cones
##
##
InstallGlobalFunction(BettiNumberToric,
function(Cones,k0)
local i,j,n,a,C,k;
 if IsOddInt(k0) then return 0; fi;
 k:=Int(k0/2);
 C:=ShallowCopy(Cones)[1][1];
 n:=Size(C);
 a:=Sum( [k..n],i->(-1)^(i-k)*Binomial(i,k)*NumberOfConesOfFan(Cones,n-i));
 return a;
end);

#############################################################################
##
#F  EulerCharacteristic( <Cones> )
##
##  Input: Cones is the fan of cones
##  Output: Euler char of X(Delta), where
##          Delta is a fan defined by its maximal cones, Cones
##
##  Note: X(Delta) **must be non-singular***
##
## was InstallGlobalFunction(EulerCharacteristic,[IsList],
InstallMethod(EulerCharacteristic,[IsList],
function(Cones)
local sigma,R,Rays,C0,dim;
 C0:=ShallowCopy(Cones);
 Rays:=TORIC.flatten(C0);
 R:=ShallowCopy(Rays);
 dim:=Size(R[1]);
 return NumberOfConesOfFan(Cones,dim);
end);

#############################################################################
##
#F  CardinalityOfToricVariety( <Cones>, <q> )
##
##  Input: Cones is the fan of cones
##  Output: the number of elements of X(Delta) over GF(q), where
##          Delta is a fan defined by its maximal cones, Cones,
##          and where q is a prime power
##
##  Note: X(Delta) **must be non-singular***
##
InstallGlobalFunction(CardinalityOfToricVariety,
function(Cones,q)
local i,j,n,a;
 n:=Size(Cones[1][1]);
 a:=Sum([0..n],i->(q-1)^(i)*NumberOfConesOfFan(Cones,n-i));
 return a;
end);


NrQueens := function(n)
    local a, up, down, m, sub;
    a := [1 .. n];
    up := ListWithIdenticalEntries(2*n - 1, true);
    down := ListWithIdenticalEntries(2*n - 1, true);
    m := 0;
    sub := function(i)
        local j, k, p, q;
        for k in [i .. n] do
            j := a[k];
            p := i + j - 1;
            q := i - j + n;
            if up[p] and down[q] then
                if i = n then
                    m := m + 1;
                else
                    up[p] := false;
                    down[q] := false;
                    a[k] := a[i];
                    a[i] := j;
                    sub(i + 1);
                    up[p] := true;
                    down[q] := true;
                    a[i] := a[k];
                    a[k] := j;
                fi;
            fi;
        od;
    end;
    sub(1);
    return m;
end;

Queens := function(n)
    local a, up, down, v, sub;
    a := [1 .. n];
    up := ListWithIdenticalEntries(2*n - 1, true);
    down := ListWithIdenticalEntries(2*n - 1, true);
    v := [];
    sub := function(i)
        local j, k, p, q;
        for k in [i .. n] do
            j := a[k];
            p := i + j - 1;
            q := i - j + n;
            if up[p] and down[q] then
                if i = n then
                    Add(v, ShallowCopy(a));
                else
                    up[p] := false;
                    down[q] := false;
                    a[k] := a[i];
                    a[i] := j;
                    sub(i + 1);
                    up[p] := true;
                    down[q] := true;
                    a[i] := a[k];
                    a[k] := j;
                fi;
            fi;
        od;
    end;
    sub(1);
    return v;
end;

NrQueens(8);
a := Queens(8);;
PrintArray(PermutationMat(PermList(a[1]), 8));

[ [  1,  0,  0,  0,  0,  0,  0,  0 ],
  [  0,  0,  0,  0,  1,  0,  0,  0 ],
  [  0,  0,  0,  0,  0,  0,  0,  1 ],
  [  0,  0,  0,  0,  0,  1,  0,  0 ],
  [  0,  0,  1,  0,  0,  0,  0,  0 ],
  [  0,  0,  0,  0,  0,  0,  1,  0 ],
  [  0,  1,  0,  0,  0,  0,  0,  0 ],
  [  0,  0,  0,  1,  0,  0,  0,  0 ] ]


IsLuhn := function(n)
	local c, d, i, j, r;
	d := "0123456789";
	j := 1;
	r := 0;
	for c in Reversed(String(n)) do
		i := Position(d, c);
		if i = fail then
			continue;
		fi;
		i := j*(i - 1);
		r := r + QuoInt(i, 10) + RemInt(i, 10);
		j := 3 - j;
	od;
	return RemInt(r, 10) = 0;
end;

List([49927398716, 49927398717, 1234567812345678, 1234567812345670], IsLuhn);
# [ true, false, false, true ]

# Will also work on strings, and will skip non-digits
IsLuhn("4-992-739-871-6");
# true


SelectionSort := function(v)
   local i, j, k, n, m;
   n := Size(v);
   for i in [1 .. n] do
      k := i;
      m := v[i];
      for j in [i + 1 .. n] do
         if v[j] < m then
            k := j;
            m := v[j];
         fi;
      od;
      v[k] := v[i];
      v[i] := m;
   od;
end;

v := List([1 .. 100], n -> Random([1 .. 100]));
SelectionSort(v);
v;


TanPlus := function(a, b)
    return (a + b) / (1 - a * b);
end;

TanTimes := function(n, a)
    local x;
    x := 0;
    while n > 0 do
        if IsOddInt(n) then
            x := TanPlus(x, a);
        fi;
        a := TanPlus(a, a);
        n := QuoInt(n, 2);
    od;
    return x;
end;

Check := function(a)
    local x, p;
    x := 0;
    for p in a do
        x := TanPlus(x, SignInt(p[1]) * TanTimes(AbsInt(p[1]), p[2]));
    od;
    return x = 1;
end;

ForAll([
    [[1, 1/2], [1, 1/3]],
    [[2, 1/3], [1, 1/7]],
    [[4, 1/5], [-1, 1/239]],
    [[5, 1/7], [2, 3/79]],
    [[5, 29/278], [7, 3/79]],
    [[1, 1/2], [1, 1/5], [1, 1/8]],
    [[5, 1/7], [4, 1/53], [2, 1/4443]],
    [[6, 1/8], [2, 1/57], [1, 1/239]],
    [[8, 1/10], [-1, 1/239], [-4, 1/515]],
    [[12, 1/18], [8, 1/57], [-5, 1/239]],
    [[16, 1/21], [3, 1/239], [4, 3/1042]],
    [[22, 1/28], [2, 1/443], [-5, 1/1393], [-10, 1/11018]],
    [[22, 1/38], [17, 7/601], [10, 7/8149]],
    [[44, 1/57], [7, 1/239], [-12, 1/682], [24, 1/12943]],
    [[88, 1/172], [51, 1/239], [32, 1/682], [44, 1/5357], [68, 1/12943]]], Check);

Check([[88, 1/172], [51, 1/239], [32, 1/682], [44, 1/5357], [68, 1/12944]]);


roots := n -> List([0 .. n-1], k -> E(n)^k);

r:=roots(7);
# [ 1, E(7), E(7)^2, E(7)^3, E(7)^4, E(7)^5, E(7)^6 ]

List(r, x -> x^7);
# [ 1, 1, 1, 1, 1, 1, 1 ]


Read( "fibonacci.gi" );

ForAll( [ 1 .. 10 ], i -> fibonacci_rec( i ) = fibonacci_internal( i ) );

ForAll( [ 1 .. 10 ], i -> fibonacci_iterative( i ) = fibonacci_internal( i ) );

iterator := fibonacci_iterator( );

ForAll( [ 1 .. 100 ], i -> iterator( ) = fibonacci_internal( i ) );


# Just multiplying a vector by itself yields the sum of squares (it's an inner product)
# It's necessary to check for the empty vector though
SumSq := function(v)
	if Size(v) = 0 then
		return 0;
	else
		return v*v;
	fi;
end;


# Displays the preimages of all the subgroups of the quotient isomorphic to a given group.
# INPUT:
# > G - a finite group which is the domain of the quotient map
# > N - a normal subgroup of G with respect to we take the quotient G/N
# > H - a group which is supposed to be isomorphic to a subgroup of G/N
# OUTPUT:
# > displays the preimages grouped in the corresponding conjugacy classes of subgroups of G
InstallGlobalFunction( AMPreImagesQuotientSubgroup, function( G, N, H )

end );


Mean := function(v)
  local n;
  n := Length(v);
  if n = 0 then
    return 0;
  else
    return Sum(v)/n;
  fi;
end;

Mean([3, 1, 4, 1, 5, 9]);
# 23/6


# GAP knows gaussian integers, gaussian rationals (i.e. Q[i]), and cyclotomic fields. Here are some examples.
# E(n) is an nth primitive root of 1
i := Sqrt(-1);
# E(4)
(3 + 2*i)*(5 - 7*i);
# 29-11*E(4)
1/i;
# -E(4)
Sqrt(-3);
# E(3)-E(3)^2

i in GaussianIntegers;
# true
i/2 in GaussianIntegers;
# false
i/2 in GaussianRationals;
# true
Sqrt(-3) in Cyclotomics;
# true


# Here an implementation with no optimization (O(n^2)).
# In GAP, E(n) = exp(2*i*pi/n), a primitive root of the unity.

Fourier := function(a)
	local n, z;
	n := Size(a);
	z := E(n);
	return List([0 .. n - 1], k -> Sum([0 .. n - 1], j -> a[j + 1]*z^(-k*j)));
end;

InverseFourier := function(a)
	local n, z;
	n := Size(a);
	z := E(n);
	return List([0 .. n - 1], k -> Sum([0 .. n - 1], j -> a[j + 1]*z^(k*j)))/n;
end;

Fourier([1, 1, 1, 1, 0, 0, 0, 0]);
# [ 4, 1-E(8)-E(8)^2-E(8)^3, 0, 1-E(8)+E(8)^2-E(8)^3,
#   0, 1+E(8)-E(8)^2+E(8)^3, 0, 1+E(8)+E(8)^2+E(8)^3 ]

InverseFourier(last);
# [ 1, 1, 1, 1, 0, 0, 0, 0 ]


2/3 in Rationals;
# true
2/3 + 3/4;
# 17/12


originalMatrix := [[1, 1, 1, 1],
                   [2, 4, 8, 16],
                   [3, 9, 27, 81],
                   [4, 16, 64, 256],
                   [5, 25, 125, 625]];
transposedMatrix := TransposedMat(originalMatrix);


#! @Title Skeletal vector spaces
#! @Author Sebastian Gutsche and Sebastian Posur
#! @Date 01/08/2018
#! @Chapter HandsOn

#! @Section Objects and morphisms

LoadPackage( "CAP" );

LoadPackage( "MatricesForHomalg" );

#################################
##
## Technical declarations
##
#################################

## Objects
DeclareCategory( "IsQVectorSpace",
                 IsCapCategoryObject );
## Morphisms
DeclareCategory( "IsQVectorSpaceMorphism",
                 IsCapCategoryMorphism );

#################################
##
## Attributes
##
#################################

#! @Description
#! The argument is an object $V$ in the category of rational vector spaces.
#! The output is its dimension.
#! @Returns a non-negative integer
#! @Arguments V
DeclareAttribute( "Dimension",
                  IsQVectorSpace );

#! @Description
#! The argument is a morphism $\alpha$ in the category of rational vector spaces.
#! The output is its underlying matrix.
#! @Returns a homalg matrix
#! @Arguments alpha
DeclareAttribute( "UnderlyingMatrix",
                  IsQVectorSpaceMorphism );

#################################
##
## Operations
##
#################################

#! @Description
#! The argument is a non-negative integer $d$.
#! The output is a rational vector space of dimension $d$.
#! @Returns an object
#! @Arguments d
DeclareOperation( "QVectorSpace",
                  [ IsInt ] );

#! @Description
#! The first argument is a rational vector space $V$.
#! The second argument $A$ is either a homalg matrix defined over the rationals
#! or an input that can be used as the first argument in the HomalgMatrix constructor.
#! The third argument is a rational vector space $W$.
#! The output is vector space morphism from $V$ to $W$ defined by $A$.
#! @Returns an morphism in $\mathrm{Hom}(V,W)$
#! @Arguments V,A,W
DeclareOperation( "QVectorSpaceMorphism",
                  [ IsQVectorSpace, IsObject, IsQVectorSpace ] );

#################################
##
## Creation of category
##
#################################

BindGlobal( "vecspaces", CreateCapCategory( "QVectorSpaces" ) );

AddObjectRepresentation( vecspaces, IsQVectorSpace );

AddMorphismRepresentation( vecspaces, IsQVectorSpaceMorphism );

SetIsAbelianCategory( vecspaces, true );

#################################
##
## Creation of Q
##
#################################

BindGlobal( "VECTORSPACES_FIELD", HomalgFieldOfRationals( ) );

#################################
##
## Constructors for objects and morphisms
##
#################################

##
InstallMethod( QVectorSpace,
               [ IsInt ],

  function( dim )
    local space;

    if dim < 0 then

        Error( "the argument has to be a non-negative integer" );

    fi;

    space := rec( );

    ObjectifyObjectForCAPWithAttributes( space, vecspaces,
                                         Dimension, dim
    );

    return space;

end );

##
InstallMethod( QVectorSpaceMorphism,
                  [ IsQVectorSpace, IsObject, IsQVectorSpace ],

  function( source, matrix, range )
    local morphism;

    if not IsHomalgMatrix( matrix ) then

      matrix := HomalgMatrix( matrix, Dimension( source ), Dimension( range ), VECTORSPACES_FIELD );

    fi;

    morphism := rec( );

    ObjectifyMorphismForCAPWithAttributes( morphism, vecspaces,
                                         Source, source,
                                         Range, range,
                                         UnderlyingMatrix, matrix
    );

    return morphism;

end );

#################################
##
## View
##
#################################

##
InstallMethod( ViewObj,
               [ IsQVectorSpace ],

  function( obj )

    Print( "<A rational vector space of dimension ", String( Dimension( obj ) ), ">" );

end );

##
InstallMethod( ViewObj,
               [ IsQVectorSpaceMorphism ],

  function( mor )

    Print( "A rational vector space homomorphism with matrix: \n" );

    Display( UnderlyingMatrix( mor ) );

end );

#################################
##
## Functions to be added to category
##
#################################

##
identity_morphism := function( obj )

    return QVectorSpaceMorphism( obj, HomalgIdentityMatrix( Dimension( obj ), VECTORSPACES_FIELD ), obj );

end;

AddIdentityMorphism( vecspaces, identity_morphism );

##
pre_compose := function( mor_left, mor_right )
    local composition;

    composition := UnderlyingMatrix( mor_left ) * UnderlyingMatrix( mor_right );

    return QVectorSpaceMorphism( Source( mor_left ), composition, Range( mor_right ) );

end;

AddPreCompose( vecspaces, pre_compose );

##
is_equal_for_objects := function( vecspace_1, vecspace_2 )

    return Dimension( vecspace_1 ) = Dimension( vecspace_2 );

end;

AddIsEqualForObjects( vecspaces, is_equal_for_objects );

##
is_equal_for_morphisms := function( a, b )

    return UnderlyingMatrix( a ) = UnderlyingMatrix( b );

end;

AddIsEqualForMorphisms( vecspaces, is_equal_for_morphisms );

##
kernel_emb := function( morphism )
    local syzygies, kernel_obj;

    syzygies := SyzygiesOfRows( UnderlyingMatrix( morphism ) );

    kernel_obj := QVectorSpace( NrRows( syzygies ) );

    return QVectorSpaceMorphism( kernel_obj, syzygies, Source( morphism ) );

end;

AddKernelEmbedding( vecspaces, kernel_emb );

##
lift := function( alpha, beta )
    local solution;

    solution := RightDivide( UnderlyingMatrix( alpha ), UnderlyingMatrix( beta ) );

    if solution = fail then

        return fail;

    fi;

    return QVectorSpaceMorphism( Source( alpha ),
           solution,
           Source( beta ) );

end;

AddLift( vecspaces, lift );

##
cokernel_proj := function( morphism )
    local syzygies, cokernel_obj;

    syzygies := SyzygiesOfColumns( UnderlyingMatrix( morphism ) );

    cokernel_obj := QVectorSpace( NrColumns( syzygies ) );

    return QVectorSpaceMorphism( Range( morphism ),
              syzygies, cokernel_obj );

end;

AddCokernelProjection( vecspaces, cokernel_proj );

##
colift := function( alpha, beta )
    local solution;

    solution := LeftDivide( UnderlyingMatrix( alpha ), UnderlyingMatrix( beta ) );

    if solution = fail then

        return fail;

    fi;

    return QVectorSpaceMorphism( Range( alpha ),
              solution,
              Range( beta ) );

end;

AddColift( vecspaces, colift );

##
zero_object := function( )

    return QVectorSpace( 0 );

end;

AddZeroObject( vecspaces, zero_object );

##
universal_morphism_into_zero_object := function( source )

    return QVectorSpaceMorphism( source,
              HomalgZeroMatrix( Dimension( source ), 0, VECTORSPACES_FIELD ),
              QVectorSpace( 0 ) );

end;

AddUniversalMorphismIntoZeroObject( vecspaces, universal_morphism_into_zero_object );

##
universal_morphism_into_zero_object_with_given_zero_object := function( source, terminal_object )

    return QVectorSpaceMorphism( source,
              HomalgZeroMatrix( Dimension( source ), 0, VECTORSPACES_FIELD ),
              terminal_object );

end;

AddUniversalMorphismIntoZeroObjectWithGivenZeroObject( vecspaces, universal_morphism_into_zero_object_with_given_zero_object );

##
universal_morphism_from_zero_object := function( sink )

    return QVectorSpaceMorphism( QVectorSpace( 0 ),
              HomalgZeroMatrix( 0, Dimension( sink ), VECTORSPACES_FIELD ),
              sink );

end;

AddUniversalMorphismFromZeroObject( vecspaces, universal_morphism_from_zero_object );

##
universal_morphism_from_zero_object_with_given_zero_object := function( sink, initial_object )

    return QVectorSpaceMorphism( initial_object,
                   HomalgZeroMatrix( 0, Dimension( sink ), VECTORSPACES_FIELD ),
                   sink );

end;

AddUniversalMorphismFromZeroObjectWithGivenZeroObject( vecspaces, universal_morphism_from_zero_object_with_given_zero_object );

##
addition_for_morphisms := function( a, b )

    return QVectorSpaceMorphism( Source( a ),
              UnderlyingMatrix( a ) + UnderlyingMatrix( b ),
              Range( a ) );

end;

AddAdditionForMorphisms( vecspaces, addition_for_morphisms );

##
additive_inverse_for_morphisms := function( a )

    return QVectorSpaceMorphism( Source( a ),
              - UnderlyingMatrix( a ),
              Range( a ) );

end;

AddAdditiveInverseForMorphisms( vecspaces, additive_inverse_for_morphisms );

##
direct_sum := function( object_product_list )
    local dim;

    dim := Sum( List( object_product_list, c -> Dimension( c ) ) );

    return QVectorSpace( dim );

end;

AddDirectSum( vecspaces, direct_sum );

##
injection_of_cofactor_of_direct_sum := function( object_product_list, injection_number )
    local components, dim, dim_pre, dim_post, dim_cofactor, coproduct, number_of_objects, injection_of_cofactor;

    components := object_product_list;

    number_of_objects := Length( components );

    dim := Sum( components, c -> Dimension( c ) );

    dim_pre := Sum( components{ [ 1 .. injection_number - 1 ] }, c -> Dimension( c ) );

    dim_post := Sum( components{ [ injection_number + 1 .. number_of_objects ] }, c -> Dimension( c ) );

    dim_cofactor := Dimension( object_product_list[ injection_number ] );

    coproduct := QVectorSpace( dim );

    injection_of_cofactor := HomalgZeroMatrix( dim_cofactor, dim_pre ,VECTORSPACES_FIELD );

    injection_of_cofactor := UnionOfColumns( injection_of_cofactor,
                                         HomalgIdentityMatrix( dim_cofactor, VECTORSPACES_FIELD ) );

    injection_of_cofactor := UnionOfColumns( injection_of_cofactor,
                                         HomalgZeroMatrix( dim_cofactor, dim_post, VECTORSPACES_FIELD ) );

    return QVectorSpaceMorphism( object_product_list[ injection_number ], injection_of_cofactor, coproduct );

end;

AddInjectionOfCofactorOfDirectSum( vecspaces, injection_of_cofactor_of_direct_sum );

##
universal_morphism_from_direct_sum := function( diagram, sink )
    local dim, coproduct, components, universal_morphism, morphism;

    components := sink;

    dim := Sum( components, c -> Dimension( Source( c ) ) );

    coproduct := QVectorSpace( dim );

    universal_morphism := UnderlyingMatrix( sink[1] );

    for morphism in components{ [ 2 .. Length( components ) ] } do

      universal_morphism := UnionOfRows( universal_morphism, UnderlyingMatrix( morphism ) );

    od;

    return QVectorSpaceMorphism( coproduct, universal_morphism, Range( sink[1] ) );

end;

AddUniversalMorphismFromDirectSum( vecspaces, universal_morphism_from_direct_sum );

##
projection_in_factor_of_direct_sum := function( object_product_list, projection_number )
    local components, dim, dim_pre, dim_post, dim_factor, direct_product, number_of_objects, projection_in_factor;

    components := object_product_list;

    number_of_objects := Length( components );

    dim := Sum( components, c -> Dimension( c ) );

    dim_pre := Sum( components{ [ 1 .. projection_number - 1 ] }, c -> Dimension( c ) );

    dim_post := Sum( components{ [ projection_number + 1 .. number_of_objects ] }, c -> Dimension( c ) );

    dim_factor := Dimension( object_product_list[ projection_number ] );

    direct_product := QVectorSpace( dim );

    projection_in_factor := HomalgZeroMatrix( dim_pre, dim_factor, VECTORSPACES_FIELD );

    projection_in_factor := UnionOfRows( projection_in_factor,
                                         HomalgIdentityMatrix( dim_factor, VECTORSPACES_FIELD ) );

    projection_in_factor := UnionOfRows( projection_in_factor,
                                         HomalgZeroMatrix( dim_post, dim_factor, VECTORSPACES_FIELD ) );

    return QVectorSpaceMorphism( direct_product, projection_in_factor, object_product_list[ projection_number ] );

end;

AddProjectionInFactorOfDirectSum( vecspaces, projection_in_factor_of_direct_sum );

##
universal_morphism_into_direct_sum := function( diagram, sink )
    local dim, direct_product, components, universal_morphism, morphism;

    components := sink;

    dim := Sum( components, c -> Dimension( Range( c ) ) );

    direct_product := QVectorSpace( dim );

    universal_morphism := UnderlyingMatrix( sink[1] );

    for morphism in components{ [ 2 .. Length( components ) ] } do

      universal_morphism := UnionOfColumns( universal_morphism, UnderlyingMatrix( morphism ) );

    od;

    return QVectorSpaceMorphism( Source( sink[1] ), universal_morphism, direct_product );

end;

AddUniversalMorphismIntoDirectSum( vecspaces, universal_morphism_into_direct_sum );

#################################
##
## Finalize category
##
#################################

Finalize( vecspaces );

#################################
##
## Test the basic operations
##
#################################

# Creating objects and morphisms

V := QVectorSpace( 2 );

CapCategory( V );

Dimension( V );

W := QVectorSpace( 3 );

alpha := QVectorSpaceMorphism( V, [ [ 1, 1, 1 ], [ -1, -1, -1 ] ], W );

CapCategory( alpha );

UnderlyingMatrix( alpha );

# Testing the KernelEmbedding

KernelEmbedding( alpha );

KernelObject( alpha );

# Computing an intersection

M1 := QVectorSpace( 2 );

M2 := QVectorSpace( 2 );

N := QVectorSpace( 3 );

iota1 := QVectorSpaceMorphism( M1, [ [ 1, 0, 0 ], [ 0, 1, 1 ] ], N );

IsMonomorphism( iota1 );

iota2 := QVectorSpaceMorphism( M2, [ [ 1, 1, 0 ], [ 0, 0, 1 ] ], N );

IsMonomorphism( iota2 );

pi1 := ProjectionInFactorOfDirectSum( [ M1, M2 ], 1 );

pi2 := ProjectionInFactorOfDirectSum( [ M1, M2 ], 2 );

lambda := PostCompose( iota1, pi1 );

phi := lambda - PostCompose( iota2, pi2 );

kappa := KernelEmbedding( phi );

PostCompose( lambda, kappa );

PreCompose( ProjectionInFactorOfFiberProduct( [ iota1, iota2 ], 1 ), iota1 );

#################################
##
## A function for computing homology
##
#################################

HomologyObject := function( alpha, beta )
  local iota, lambda;

  if not IsZero( PreCompose( alpha, beta ) ) then

      Error( "the composition of the given morphisms has to be zero" );

  fi;

  iota := ImageEmbedding( alpha );

  lambda := KernelLift( beta, iota );

  return CokernelObject( lambda );

end;

HomologyObject( alpha, CokernelProjection( alpha ) );

HomologyObject( KernelEmbedding( alpha ), alpha );

pi1 := ProjectionInFactorOfDirectSum( [ V, V, V ], 1 );

iota1 := InjectionOfCofactorOfDirectSum( [ V, V, V ], 1 );

pi2 := ProjectionInFactorOfDirectSum( [ V, V, V ], 2 );

iota2 := InjectionOfCofactorOfDirectSum( [ V, V, V ], 2 );

HomologyObject( PreCompose( pi1, iota1 ), PreCompose( pi2, iota2 ) );


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

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

Print("Size(Orbit(cube, 1)) = ", Size(Orbit(cube, 1)), "\n");

stab := Stabilizer(cube, 1);

Print("IsCyclic(stab) = ", IsCyclic(stab), "\n");

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