(* 	:Title: Convert
*)
(* 	:Author: P.H. Lundow
*)
(* 	:Summary:
	A package for converting between various polynomials.
*)
(* 	:Discussion:
	Send comments to
        P.H. Lundow <phl@kth.se>
*)
(*	:Package Version: 0.1, (February 26, 1998).
	:Package Version: 0.2, (1999-10-19) IsingToEuler.
	:Package Version: 0.3, (1999-10-26) EulerToIsing. Clean-up.
	:Package Version: 0.3.1, (1999-11-14) Slight speed-up of IsingToWaerden
										and WaerdenToIsing
	:Package Version: 0.3.2, (1999-11-22) Quantum speed-up of IsingToWaerden
	:Package Version: 1999-12-02 IsingToComplement
	:Package Version: 1999-12-09 IsingToWaerden twice faster. IsingToEuler
							improved, dropped the argument n.
	:Package Version: 1999-12-11 Slight speed-up of IsingToWaerden
	:Package Version: 1999-12-12 WaerdenToIsing and EulerToIsing changed.
	:Package Version: 2000-03-09 IsingToIsing01, Ising01ToIsing.
	:Package Version: 2000-03-13 Protection.
	:Package Version: 2000-04-02 Small change in IsingToIsing01.
	:Package Version: 2000-05-17 Speed-up in coeff* á la Daniel Andren.
	:Package Version: 2006-06-12 Corrected bug in coeff2.
*)
(* 	:Mathematica Version: 3.0
*)

BeginPackage["Convert`",{"GrafPack`Utilities`"}]

EulerToIsing::usage =
	"EulerToIsing[p, t, x, m, n, prgrs] converts the Euler polynomial p
	in variable t to the Ising (y=1) polynomial in variable x for a graph
	on m edges and n vertices.  The argument prgrs is optional and if it
	is set to True the progress is shown. If the graph is connected then
	EulerToIsing[p, x, t, n, prgrs] will give the same result."

IsingToComplement::usage =
	"IsingToComplement[p, {x, y}] returns the Ising polynomial of the 
	complement graph having Ising polynomial p, in variables x and y."

IsingToEuler::usage = 
	"IsingToEuler[p, x, t, prgrs] converts the Ising polynomial p in 
	variable x to the Euler polynomial in t. Argument prgrs is optional 
	and if set to True the progress is shown."

IsingToIsing01::usage =
	"IsingToIsing01[p, {x, y}] converts the +-1 Ising polynomial p in 
	variables x and y to its 01 counterpart. WARNING: The graph upon
	which p is based must be regular."

Ising01ToIsing::usage =
	"Ising01ToIsing[p, {x, y}] converts the 01 Ising polynomial p in 
	variables x and y to its +-1 counterpart. WARNING: The graph upon
	which p is based must be regular."

IsingToWaerden::usage =
	"IsingToWaerden[p, {x, y}, {t, u}, prgrs] converts the Ising polynomial
	p in variables x and y to the Van Der Waerden polynomial in t and u.
	The argument prgrs is optional and if it is set to True the progress
	is shown."

MatchingToMatch::usage =
	"MatchingToMatch[p, x, n] converts the matching polynomial p in
	variable x to the matching generating polynomial in for a graph on
	n vertices."

MatchToMatching::usage =
	"MatchToMatching[p, x, n] converts the matching generating polynomial
	p in variable x to the matching polynomial in x for a graph on n
	vertices."

WaerdenToIsing::usage =
	"WaerdenToIsing[p, {t, u}, {x, y}, n, prgrs] converts the Van Der
	Waerden polynomial p in variables t and u to the Ising polynomial in
	x and y for a graph on n vertices. The argument prgrs is optional and
	if it is set to True the progress is shown. If the graph is connected
	then WaerdenToIsing[p, {t, u}, {x, y}, prgrs] will give the same
	result."

WaerdenToMatch::usage =
	"WaerdenToMatch[p, {t,u}, x] converts the Van Der Waerden polynomial
	p in variables t and u to the matching generating polynomial in x.
	Here the coefficient of x^k is the number of k-matchings."

Begin["`Private`"]

definitions = {EulerToIsing, IsingToComplement, IsingToEuler, 
	IsingToIsing01, Ising01ToIsing, IsingToWaerden, MatchingToMatch, 
	MatchToMatching, WaerdenToIsing, WaerdenToMatch
}

Scan[Unprotect, definitions]


(***************************** OLD VERSION
EulerToIsing[p_, t_, x_, m_Integer, n_Integer, prgrs_Symbol:False] :=
	Module[{q, i=1, poly=0},
		q = PolynomialToList[p, {t}];
		If[prgrs, Print[Length[q], " terms"]];
		Scan[
			(
				If[prgrs, Print[i++]];
				poly += Expand[
					Times[
						#[[1]],
						(x^2 - 1)^#[[2]],
						(x^2 + 1)^(m - #[[2]])
					]
				]
			)&,
			q
		];
		Expand[poly / 2^(m - n) / x^m]
	]
******************************)

EulerToIsing[p_, t_, x_, n_Integer, prgrs_Symbol:False] :=
	Module[{m},
		m = n - 1 + Log[2, p /. t -> 1];
		EulerToIsing[p, t, x, m, n, prgrs]
	]

EulerToIsing[p_, t_, x_, m_Integer, n_Integer, prgrs_Symbol:False] :=
	Module[{q, i=1, poly=0},
		q = PolynomialToList[p, {t}];
		If[prgrs, Print[Length[q], " terms"]];
		Scan[
			(
				If[prgrs, Print[i++]];
				poly = poly + #[[1]]*coeff3[m, #[[2]]]; (* coeff3 below *)
			)&,
			q
		];
		poly = poly / 2^(m - n);
		Sum[poly[[i+1]] * x^(2*i - m), {i, 0, Length[poly] - 1}]
	]


IsingToComplement[p_, {x_, y_}] :=
	Module[{n, q},
		q = PolynomialToList[p, {x, y}];
		n = Max[Map[Last, q]];
		q = Map[{#[[1]], (#[[3]]^2 - n)/2 - #[[2]], #[[3]]}&, q];
		ListToPolynomial[q, {x, y}]
	]


IsingToEuler[p_, x_, t_, prgrs_Symbol:False] :=
	Module[{q, m, i=1, poly=0},
		q = PolynomialToList[p, {x}];
		m = Exponent[p, x];
		If[prgrs, Print[Length[q], " terms"]];
		Scan[
			(
				If[prgrs, Print[i++]];
				poly = poly + #[[1]]*coeff1[m, #[[2]]]; (* coeff1 below *)
			)&,
			q
		];
		poly = poly / poly[[1]]; (* poly[[1]] = 2^n *)
		Sum[poly[[i+1]] * t^i, {i, 0, Length[poly] - 1}]
	]

IsingToIsing01[p_, {x_, y_}] :=
	Module[{d, m, n, q},
		m = Exponent[p, x];
		n = Exponent[p, y];
		d = 2*m/n;
		q = PolynomialToList[p, {x, y}];
		q = Map[
			{#[[1]], (m + d*#[[3]] + #[[2]])/4, (n + #[[3]])/2}&,
			q
		];
		ListToPolynomial[q, {x, y}]
	]


Ising01ToIsing[p_, {x_, y_}] :=
	Module[{d, m, n, q},
		m = Exponent[p, x];
		n = Exponent[p, y];
		d = 2*m/n;
		q = PolynomialToList[p, {x, y}];
		q = Map[{#[[1]], m + 4*#[[2]] - 2*d*#[[3]], 2*#[[3]] - n}&, q];
		ListToPolynomial[q, {x, y}]
	]


(***************************** OLD VERSIONS
IsingToWaerden[p_, {x_,y_}, {t_,u_}, prgrs_Symbol:False] :=
	Module[{q,m,n,i=1,poly=0},
		q = PolynomialToList[p,{x,y}];
		m = Max[Map[(#[[2]])&,q]];
		n = Max[Map[Last,q]];
		If[prgrs,Print[Length[q]," terms."]];
		Scan[
			(If[prgrs,Print[i++]];
			poly += Expand[
				Times[
					#[[1]],
					Expand[(1+t)^((m+#[[2]])/2)*(1-t)^((m-#[[2]])/2)],
					Expand[(1+u)^((n+#[[3]])/2)*(1-u)^((n-#[[3]])/2)]
				]
			])&,
			q
		];
		Expand[poly/2^n]
	]
*****************************)

IsingToWaerden[p_, {x_, y_}, {t_, u_}, prgrs_Symbol:False] :=
	Module[{a, i, j, k, m, n, q, mat=0},
		q = PolynomialToList[p, {x, y}];
		{m, n} = Exponent[p, {x, y}];
		q = Cases[q, {_, _, _?NonNegative}];
		If[prgrs, k = 1; Print[Length[q]," terms."]];
		Scan[
			(
				If[prgrs, Print[k++]];
				{a, i, j} = #;
				mat = mat + Outer[Times, coeff1[m, i], a*coeff2[n, j]]
			)&,
			q
		];
		mat = mat / 2^n;
		Apply[Plus,
			mat * Table[t^i * u^j, {i, 0, m}, {j, 0, n}],
			{0, 1}
		]
	]

coeff1[m_, i_?NonNegative] := (* private function *)
	Module[{x},
		CoefficientList[(1 + x)^i * (1 - x^2)^((m - i)/2), x]
	]

coeff1[m_, i_] := (* private function *)
	Module[{x},
		CoefficientList[(1 - x^2)^((m + i)/2) * (1 - x)^(-i), x]
	]

coeff2[n_, 0] := (* private function *)
	Module[{x},
		CoefficientList[(1 - x^2)^(n/2), x]
	]

coeff2[n_?EvenQ, j_?Positive] := (* private function *)
	Module[{x},
		CoefficientList[((1 + x)^j + (1 - x)^j) * (1 - x^2)^((n - j)/2), x]
	]

coeff2[n_?OddQ, j_?Positive] := (* private function *)
	Module[{x},
	       Join[CoefficientList[((1 + x)^j + (1 - x)^j) * (1 - x^2)^((n - j)/2), x], {0}]
	]

MatchingToMatch[p_, x_, n_]:=
	Expand[p/x^n] /. x^k_ -> (-x)^(-k/2)


MatchToMatching[p_, x_, n_]:=
	Expand[x^n (p /. x->(x*I)^(-2))]


(***************************** OLD VERSION
WaerdenToIsing[p_, {t_,u_}, {x_,y_}, n_, prgrs_Symbol:False]:=
	Module[{i, m, q, poly=0},
		q = PolynomialToList[p,{t,u}];
		m = Exponent[p, t];
		If[prgrs,i=1;Print[Length[q]," terms."]];
		Scan[
			(If[prgrs,Print[i++]];
			poly += Expand[
				Times[
					#[[1]],
					Expand[(x^2-1)^#[[2]]*(x^2+1)^(m-#[[2]])],
					Expand[(y^2-1)^#[[3]]*(y^2+1)^(n-#[[3]])]
				]
			])&,
			q
		];
		Expand[poly/2^m/x^m/y^n]
	]
******************************)

WaerdenToIsing[p_, {t_, u_}, {x_, y_}, prgrs_Symbol:False] :=
	Module[{n},
		n = 1 + Exponent[p, t] - Log[2, p /. {t -> 1, u -> 0}];
		WaerdenToIsing[p, {t, u}, {x, y}, n, prgrs]
	]

WaerdenToIsing[p_, {t_, u_}, {x_, y_}, n_Integer, prgrs_Symbol:False] :=
	Module[{b, i, j, m, q, k=0, mat=0},
		q = PolynomialToList[p, {t, u}];
		m = Exponent[p, t];
		If[prgrs, Print[Length[q]," terms."]];
		Scan[
			(
				If[prgrs, Print[k++]];
				{b, i, j} = #;
				mat = mat + Outer[Times, coeff3[m, i], b*coeff3[n, j]]
			)&,
			q
		];
		mat = mat / 2^m;
		Apply[Plus,
			mat * Table[x^(2*i - m) * y^(2*j - n), {i, 0, m}, {j, 0, n}],
			{0, 1}
		]
	]

coeff3[m_, i_] := (* private function *)
	Module[{x},
		CoefficientList[(x^2 - 1)^i * (x + 1)^(m - 2*i), x]
	] /; m-i > i

coeff3[m_, i_] := (* private function *)
	Module[{x},
		CoefficientList[(x^2 - 1)^(m - i) * (x - 1)^(2*i - m), x]
	]


WaerdenToMatch[p_, {t_, u_}, x_] :=
	Apply[Plus,
		Map[
			If[ #[[3]] == 2*#[[2]], #[[1]] * x^#[[2]], 0 ]&,
			PolynomialToList[p,{t,u}]
		]
	]


Scan[Protect, definitions]


End[]

EndPackage[]