#
# file:         tensor.gap
# purpose:      GAP function implementing tensor product of algebras
# created:      pasha dec 18 2004
# modified:     pasha feb 19,23,mar 4 2005
# modification: - started to add TensorProductPlusTail()
#               - cosmetics
#


# A,B - algebras; returns A\otimes B
TensorProductOfTwoAlgebras := function (A, B)
	local K, scA, scB, T, list, i, j, k, l, m, n;

	K := LeftActingDomain(A);
	if K <> LeftActingDomain(B) then
		Error ("tensor factors should be defined over the same field");
	fi;

	scA := StructureConstantsTable (Basis(A));
	scB := StructureConstantsTable (Basis(B));
	T := EmptySCTable (Dimension(A) * Dimension(B), Zero(K));  # structure constants of the
															   # resulting algebra

	# assuming (a_i) is a basis of A and (b_i) is a basis B,
	# basis of A\otimes B is a set of pairs (a_i,b_j) numbered in lexicographical order
	# (so (a_i,b_j) is at i + (j-1)*Dimension(A) place)
	for i in [1..Dimension(A)] do
		for j in [1..Dimension(B)] do
			for k in [1..Dimension(A)] do
				for l in [1..Dimension(B)] do
					list := [];  # auxiliary list used to form structure constants
								 # of the resulting algebra
					for n in [1..Length(scA[i][k][1])] do
						for m in [1..Length(scB[j][l][1])] do
							Add (list, scA[i][k][2][n] * scB[j][l][2][m]);
							Add (list, scA[i][k][1][n] + (scB[j][l][1][m] - 1)*Dimension(A));
						od;
					od;
					SetEntrySCTable (T, i+(j-1)*Dimension(A), k+(l-1)*Dimension(A), list);
				od;
			od;
		od;
	od;
	
	return (AlgebraByStructureConstants (K, T));
end;



# tensor product of several algebras as recursive tensor product of two algebras
TensorProductOfAlgebras := function (arg)
	local T, i;
	if Length(arg) = 0 then
		# or should we return a ground field as an 1-dimensional algebra?
		Error ("no arguments supplied to TensorProductOfAlgebras()");
	fi;
	T := arg[1];
	for i in [2..Length(arg)] do
		T := TensorProductOfTwoAlgebras (T, arg[i]);
	od;
	return (T);
end;



# n-fold tensor product of the same algebra A with itself
TensorPower := function (A, n)
	local T, i;
	if n = 0 then
		Error ("the second argument to TensorPower() should be a positive number");
	fi;
	T := A;
	for i in [2..n] do
		T := TensorProductOfTwoAlgebras (T, A);
	od;
	return (T);
end;



# given A, B, and der \subseteq Der(B), construct
# A\otimes B + 1\otimes der
TensorProductPlusTail := function (A, B, der)
	local K, basisB, T, basisT, action, list, dlist, i;

	K := LeftActingDomain (A);
	T := TensorProductOfTwoAlgebras (A, B);
	basisB := Basis(B);
	basisT := Basis(T); # a_i\otimes b_j in lexicographical order
	                    # (so a_i\otimes b_j is at i + (j-1)*Dimension(A) place)


	
	# build list of mapping acting via a\otimes b -> a\otimes d(b)
	# for d in basis of der
	list := [];
	for i in [1..Dimension(der)] do
		Add (list, Zero (End (K,T)));
	od;

	action := LeftModuleHomomorphismByImagesNC (der, End (K, T), Basis(der), list);

	return (Image (action, Basis(der)[1]));


	## define an action of der on A\otimes B: d(a\otimes b) = a\otimes d(b)
	#action := function (d)
	#	local matrix, i, j, k, cf;
	#	matrix := NullMat (Dimension(T), Dimension(T), K);
	#	for j in [1..Dimension(B)] do
	#		cf := Coefficients (basisB, Image (d, basisB[j]));
	#		for i in [1..Dimension(A)] do
	#			for k in [1..Dimension(B)] do
	#				matrix[i + (j-1)*Dimension(A)][i + (k-1)*Dimension(A)] := cf[k];
	#			od;
	#		od;
	#	od;
	#	return (matrix);
	#end;

	#return (SemidirectProductOfAlgebras (T, der, MappingByFunction 
	#			(der, End (K, T), action)));
	#return (SemidirectProductOfAlgebras (T, der, LeftModuleHomomorphismByImagesNC
	#			(der, End (K, T), Basis(der), list)));
end;

# end of tensor.gap