(************** Content-type: application/mathematica ************** CreatedBy='Mathematica 4.2' Mathematica-Compatible Notebook This notebook can be used with any Mathematica-compatible application, such as Mathematica, MathReader or Publicon. The data for the notebook starts with the line containing stars above. To get the notebook into a Mathematica-compatible application, do one of the following: * Save the data starting with the line of stars above into a file with a name ending in .nb, then open the file inside the application; * Copy the data starting with the line of stars above to the clipboard, then use the Paste menu command inside the application. Data for notebooks contains only printable 7-bit ASCII and can be sent directly in email or through ftp in text mode. Newlines can be CR, LF or CRLF (Unix, Macintosh or MS-DOS style). NOTE: If you modify the data for this notebook not in a Mathematica- compatible application, you must delete the line below containing the word CacheID, otherwise Mathematica-compatible applications may try to use invalid cache data. For more information on notebooks and Mathematica-compatible applications, contact Wolfram Research: web: http://www.wolfram.com email: info@wolfram.com phone: +1-217-398-0700 (U.S.) Notebook reader applications are available free of charge from Wolfram Research. *******************************************************************) (*CacheID: 232*) (*NotebookFileLineBreakTest NotebookFileLineBreakTest*) (*NotebookOptionsPosition[ 29515, 656]*) (*NotebookOutlinePosition[ 30303, 683]*) (* CellTagsIndexPosition[ 30259, 679]*) (*WindowFrame->Normal*) Notebook[{ Cell["\<\ oddq[] and evenq[] extend Oddq[] and Evenq[] to variables. \ \>", "Text"], Cell[BoxData[{ \(\(oddq[a_\ b_ /; oddq[a] && oddq[b]] := True;\)\), "\[IndentingNewLine]", \(\(oddq[ a_ + b_ /; \((oddq[a] && evenq[b])\) || \((evenq[a] && oddq[b])\)] := True;\)\), "\[IndentingNewLine]", \(\(\(oddq[a_] := OddQ[a];\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(\(evenq[ a_\ b_ /; \((evenq[a] && IntegerQ[b])\) || \((evenq[b] && IntegerQ[a])\)] := True;\)\ \), "\[IndentingNewLine]", \(\(evenq[ a_ + b_ /; \((evenq[a] && evenq[b])\) || \((oddq[a] && oddq[b])\)] := True;\)\), "\[IndentingNewLine]", \(\(evenq[a_] := EvenQ[a];\)\), "\[IndentingNewLine]", \(\)}], "Input"], Cell["\<\ quantum integers and their factorials are left unevaluated. lambdas, thetas, \ and tets are evaluated as in Kauffman-Lins. \ \>", "Text"], Cell[BoxData[{ \(qi[0] = 0; qi[1] = 1;\[IndentingNewLine]\), "\[IndentingNewLine]", \(qif[0] = 1; qif[n_ /; n \[GreaterEqual] 1] := qif[n - 1]\ qi[n];\), "\[IndentingNewLine]", \(\(\(qif[n_ + x_ /; n \[GreaterEqual] 1] := qif[n + x - 1]\ qi[n + x];\)\(\[IndentingNewLine]\) \)\), "\n", \(\(delta[ n_] := \ \((\(-1\))\)^n\ qi[ n + 1]\ ;\)\[IndentingNewLine]\[IndentingNewLine]\), "\ \[IndentingNewLine]", \(\(adm[a1_, b1_, c1_] := \ Module[{a = Simplify[a1], b = Simplify[b1], c = Simplify[c1]}, Simplify[ a \[GreaterEqual] 0 && b \[GreaterEqual] 0 && c \[GreaterEqual] 0 && Abs[a - b] \[LessEqual] c && c \[LessEqual] a + b, given] && evenq[a + b + c]];\)\[IndentingNewLine]\[IndentingNewLine]\), "\ \[IndentingNewLine]", \(\(lambda[a_, b_, c_] := \ \((\(-1\))\)^\((\((a + b - c)\)/ 2)\)\ A^\((\((a\ \((a + 2)\) + b\ \ \((b + 2)\) - c\ \((c + 2)\))\)/ 2)\);\)\[IndentingNewLine]\[IndentingNewLine]\), "\ \[IndentingNewLine]", \(\(theta[a_, b_, c_] := Module[{\[IndentingNewLine]m = \((a + b - c)\)/2 // Simplify, \[IndentingNewLine]n = \((b + c - a)\)/2 // Simplify, \[IndentingNewLine]p = \((a + c - b)\)/2 // Simplify\[IndentingNewLine]}, \[IndentingNewLine]\ \[IndentingNewLine]If[ adm[a, b, c], \[IndentingNewLine]\((\(-1\))\)^\((m + n + p)\)\ qif[ m + n + p + 1]\ qif[m]\ qif[ n]\ \(\(qif[p]/qif[m + n]\)/qif[n + p]\)/qif[m + p]\ // Simplify, \ \[IndentingNewLine]0]\[IndentingNewLine]];\)\), "\ \[IndentingNewLine]", \(\)}], "Input"], Cell[BoxData[ \(\(\(\[IndentingNewLine]\)\(\(admtet[a_, b_, c_, d_, e_, f_] := adm[a, d, e] && adm[b, c, e] && adm[a, b, f] && adm[c, d, f];\)\[IndentingNewLine]\[IndentingNewLine]\[IndentingNewLine] \(tet[a_, b_, c_, d_, e_, f_] := Module[{\[IndentingNewLine]a1 = \((a + d + e)\)/2 // Simplify, \[IndentingNewLine]a2 = \((b + c + e)\)/2 // Simplify, \[IndentingNewLine]a3 = \((a + b + f)\)/2 // Simplify, \[IndentingNewLine]a4 = \((c + d + f)\)/2 // Simplify, \[IndentingNewLine]av, \[IndentingNewLine]\ \[IndentingNewLine]b1 = \((b + d + e + f)\)/2 // Simplify, \[IndentingNewLine]b2 = \((a + c + e + f)\)/2 // Simplify, \[IndentingNewLine]b3 = \((a + b + c + d)\)/2 // Simplify, \[IndentingNewLine]bv, \[IndentingNewLine]\ \[IndentingNewLine]m, M, cv, s\[IndentingNewLine]}, \[IndentingNewLine]\[IndentingNewLine]av = \ {a1, a2, a3, a4}; bv = {b1, b2, b3}; \[IndentingNewLine]m = Max[a1, a2, a3, a4]; M = Min[b1, b2, b3]; \[IndentingNewLine]\[IndentingNewLine]If[ admtet[a, b, c, d, e, f], \[IndentingNewLine]intfac = Product[qif[bv[\([j]\)] - av[\([i]\)]], {i, 1, 4}, {j, 1, 3}]; \[IndentingNewLine]extfac = qif[a]\ qif[b]\ qif[c]\ qif[d]\ qif[e]\ qif[ f]; \[IndentingNewLine]cv = Intersection[av, bv]; \[IndentingNewLine]\((intfac/extfac)\)\ If[ Length[cv] > 0, \ s = cv[\([1]\)]; \((\(-1\))\)^ s\ \(qif[s + 1]/ Product[qif[s - av[\([i]\)]], {i, 1, 4}]\)/ Product[qif[bv[\([j]\)] - s], {j, 1, 3}], Sum[\((\(-1\))\)^ s\ \(qif[s + 1]/ Product[qif[s - av[\([i]\)]], {i, 1, 4}]\)/ Product[qif[bv[\([j]\)] - s], {j, 1, 3}], {s, m, M}]] // Simplify, \ \[IndentingNewLine]0]\[IndentingNewLine]];\)\ \[IndentingNewLine]\[IndentingNewLine] \)\)\)], "Input"], Cell[BoxData[{ \(\(norm[a_, b_, c_] := theta[a, a, b]\ \(\(theta[b, c, c]/delta[a]\)/delta[b]\)/ delta[c];\)\[IndentingNewLine]\[IndentingNewLine]\), "\ \[IndentingNewLine]", \(\(\(lhsr1[x_, y_, z_, a_, b_, c_] := If[adm[c, z, 1] && a \[Equal] x && b \[Equal] y, \[IndentingNewLine]theta[x, x, y]\ \(\(tet[c, z, z, c, y, 1]/delta[x]\)/delta[y]\)/ theta[c, z, 1], \[IndentingNewLine]0];\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(\(\(rhsr1[x_, y_, z_, a_, b_, c_] := \[IndentingNewLine]If[ adm[b, y - 1, 1] && adm[c, z, 1] && adm[c, z, y - 1], \[IndentingNewLine]delta[y - 1]\ tet[c, y - 1, 1, c, b, z]\ tet[1, y - 1, z, z, c, y]\ \(\(\(\(\(\((If[ adm[x, x - 1, y - 1], \[IndentingNewLine]delta[ x - 1]\ \((lambda[x, 1, x - 1]^2)\)\ tet[ y - 1, x - 1, x, b, 1, x]\ \(tet[1, x - 1, x, y, y - 1, x]/ theta[x, x - 1, 1]\)/ theta[x, x - 1, y - 1], \[IndentingNewLine]0] + If[adm[x, x + 1, y - 1], \[IndentingNewLine]delta[ x + 1]\ \((lambda[x, 1, x + 1]^2)\)\ tet[ y - 1, x + 1, x, b, 1, x]\ \(tet[1, x + 1, x, y, y - 1, x]/ theta[x, x + 1, 1]\)/ theta[x, x + 1, y - 1], \[IndentingNewLine]0])\)/ delta[x]\)/lambda[b, 1, y - 1]\)/ theta[y, y - 1, 1]\)/theta[b, y - 1, 1]\)/ theta[c, z, 1]\)/ theta[c, z, y - 1], \[IndentingNewLine]0] + If[adm[b, y + 1, 1] && adm[c, z, 1] && adm[c, z, y + 1], \[IndentingNewLine]delta[y + 1]\ tet[c, y + 1, 1, c, b, z]\ tet[1, y + 1, z, z, c, y]\ \(\(\(\(\(\((If[ adm[x, x - 1, y + 1], \[IndentingNewLine]delta[ x - 1]\ \((lambda[x, 1, x - 1]^2)\)\ tet[ y + 1, x - 1, x, b, 1, x]\ \(tet[1, x - 1, x, y, y + 1, x]/ theta[x, x - 1, 1]\)/ theta[x, x - 1, y + 1], \[IndentingNewLine]0] + If[adm[x, x + 1, y + 1], \[IndentingNewLine]delta[ x + 1]\ \((lambda[x, 1, x + 1]^2)\)\ tet[ y + 1, x + 1, x, b, 1, x]\ \(tet[1, x + 1, x, y, y + 1, x]/ theta[x, x + 1, 1]\)/ theta[x, x + 1, y + 1], \[IndentingNewLine]0])\)/ delta[x]\)/lambda[b, 1, y + 1]\)/ theta[y, y + 1, 1]\)/theta[b, y + 1, 1]\)/ theta[c, z, 1]\)/ theta[c, z, y + 1], \[IndentingNewLine]0];\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(\(\(r1[x_, y_, z_, a_, b_, c_] := If[adm[x, x, y] && adm[z, z, y] && adm[a, a, b] && adm[c, c, b], \((rhsr1[x, y, z, a, b, c] - lhsr1[x, y, z, a, b, c])\)/ norm[a, b, c], 0] // Simplify;\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(\(r2[x_, y_, z_, a_, b_, c_] := r1[z, y, x, c, b, a];\)\), "\[IndentingNewLine]", \(\)}], "Input"], Cell[BoxData[ \(\(\(\[IndentingNewLine]\)\(\(lhsr3[x_, z_, a_, b_, c_] := If[\(adm[a, x, 1] && adm[b, 1, 1]\) && adm[c, z, 1], \[IndentingNewLine]tet[1, a, a, 1, b, x]\ \(\(tet[c, 1, 1, c, b, z]/theta[a, x, 1]\)/theta[b, 1, 1]\)/ theta[c, z, 1], \[IndentingNewLine]0];\)\[IndentingNewLine]\ \[IndentingNewLine] \(rhsr3[x_, z_, a_, b_, c_] := If[\(adm[a, x, 1] && adm[b, 1, 1]\) && adm[c, z, 1], \[IndentingNewLine]\(-A^3\)\ tet[c, 1, 1, c, b, z]\ \(\(\(\((If[ adm[b, x, a - 1], \[IndentingNewLine]delta[a - 1]\ tet[ a - 1, a, a, x, b, 1]\ tet[x, 1, 1, a - 1, b, a]\ \(lambda[a, 1, a - 1]/theta[a, a - 1, 1]\)/ theta[b, x, a - 1], \[IndentingNewLine]0] + If[adm[b, x, a + 1], \[IndentingNewLine]delta[a + 1]\ tet[ a + 1, a, a, x, b, 1]\ tet[x, 1, 1, a + 1, b, a]\ \(lambda[a, 1, a + 1]/theta[a, a + 1, 1]\)/ theta[b, x, a + 1], \[IndentingNewLine]0])\)/ lambda[x, 1, a]\)/theta[a, x, 1]\)/theta[b, 1, 1]\)/ theta[c, z, 1], \[IndentingNewLine]0];\)\[IndentingNewLine]\ \[IndentingNewLine] \(r3[x_, z_, a_, b_, c_] := If[adm[a, a, b] && adm[c, c, b], \[IndentingNewLine]\((rhsr3[x, z, a, b, c] - lhsr3[x, z, a, b, c])\)/norm[a, b, c], 0] // Simplify;\)\[IndentingNewLine] \)\)\)], "Input"], Cell[BoxData[ \(\(\(\[IndentingNewLine]\)\(\(rhsr4[x_, a_, b_, c_] := \(-A^\((\(-3\))\)\)\ If[ adm[a, x, 1] && adm[c, 1, 1], \[IndentingNewLine]\(\((If[ adm[b, c - 1, 1] && adm[c, c - 1, 1] && adm[a, c - 1, x], delta[c - 1]\ tet[c, c - 1, 1, c, b, 1]\ tet[a, a, c - 1, 1, x, b]\ \(\(\((If[adm[a, a - 1, 1] && adm[x, c, a - 1], delta[a - 1]\ lambda[a, 1, a - 1]^2\ tet[ 1, a - 1, x, 1, c, a]\ \(\(tet[c, a - 1, a, c - 1, 1, x]/ lambda[c - 1, 1, c]\)/ theta[a, a - 1, 1]\)/ theta[x, c, a - 1], 0] + If[adm[a, a + 1, 1] && adm[x, c, a + 1], delta[a + 1]\ lambda[a, 1, a + 1]^2\ tet[ 1, a + 1, x, 1, c, a]\ \(\(tet[c, a + 1, a, c - 1, 1, x]/ lambda[c - 1, 1, c]\)/ theta[a, a + 1, 1]\)/ theta[x, c, a + 1], 0])\)/ theta[b, c - 1, 1]\)/theta[c, c - 1, 1]\)/ theta[a, c - 1, x], 0] + If[adm[b, c + 1, 1] && adm[c, c + 1, 1] && adm[a, c + 1, x], delta[c + 1]\ tet[c, c + 1, 1, c, b, 1]\ tet[a, a, c + 1, 1, x, b]\ \(\(\((If[adm[a, a - 1, 1] && adm[x, c, a - 1], delta[a - 1]\ lambda[a, 1, a - 1]^2\ tet[ 1, a - 1, x, 1, c, a]\ \(\(tet[c, a - 1, a, c + 1, 1, x]/ lambda[c + 1, 1, c]\)/ theta[a, a - 1, 1]\)/ theta[x, c, a - 1], 0] + If[adm[a, a + 1, 1] && adm[x, c, a + 1], delta[a + 1]\ lambda[a, 1, a + 1]^2\ tet[ 1, a + 1, x, 1, c, a]\ \(\(tet[c, a + 1, a, c + 1, 1, x]/ lambda[c + 1, 1, c]\)/ theta[a, a + 1, 1]\)/ theta[x, c, a + 1], 0])\)/ theta[b, c + 1, 1]\)/theta[c, c + 1, 1]\)/ theta[a, c + 1, x], 0])\)/theta[a, x, 1]\)/ theta[c, 1, 1], \[IndentingNewLine]0];\)\[IndentingNewLine]\ \[IndentingNewLine] \(r4[x_, a_, b_, c_] := If[adm[a, a, b] && adm[c, c, b], \[IndentingNewLine]\((rhsr4[x, a, b, c] - If[\(adm[a, x, 1] && b \[Equal] 0\) && c \[Equal] 0, 1, 0])\)/norm[a, b, c], 0] // Simplify;\)\[IndentingNewLine]\[IndentingNewLine]\[IndentingNewLine]\ \(r5[z_, a_, b_, c_] := r4[z, c, b, a];\)\[IndentingNewLine] \)\)\)], "Input"], Cell[BoxData[ \(\(\(\[IndentingNewLine]\)\(\(lhsr6[x_, a_, b_, c_] := If[a == x && c \[Equal] x && b \[Equal] 0, delta[1], 0];\)\[IndentingNewLine]\[IndentingNewLine] \(rhsr6f[x_, a_, b_, c_, p_, q_, q1_, r_] := theta[x, 1, p]\ theta[a, 1, p]\ theta[q1, 1, 1]\ theta[q, q1, 1]\ theta[b, q, 1]\ theta[x, r, 1]\ \(\(\(theta[c, r, 1]/delta[p]\)/delta[q]\)/delta[q1]\)/ delta[r];\)\[IndentingNewLine]\[IndentingNewLine] \(rhsr6r[x_, a_, b_, c_, q_, q1_, r_] := If[adm[x, q1, c] && adm[r, q, c], tet[1, c, x, 1, q1, r]\ tet[q1, c, r, 1, q, x]\ \(tet[q, b, c, r, c, 1]/theta[x, q1, c]\)/theta[r, q, c], 0];\)\[IndentingNewLine]\[IndentingNewLine] \(rhsr6l[x_, a_, b_, c_, p_, q_, q1_] := If[adm[a, x - 1, 1] && adm[a - 1, x - 1, q1] && adm[x, q, a - 1] && adm[p, b, a - 1], delta[x - 1]\ delta[a - 1]\ lambda[a, 1, a - 1]\ tet[p, 1, x - 1, 1, a, x]\ tet[1, q1, x - 1, a, a - 1, 1]\ tet[q1, q, x, x - 1, a - 1, 1]\ tet\ [q, b, p, x, a - 1, 1]\ \(\(\(\(\(\(tet[a - 1, a, a, p, b, 1]/ lambda[x, 1, x - 1]\)/theta[x, x - 1, 1]\)/ theta[a, a - 1, 1]\)/theta[a, x - 1, 1]\)/ theta[a - 1, x - 1, q1]\)/theta[x, q, a - 1]\)/ theta[p, b, a - 1], 0] + If[adm[a, x - 1, 1] && adm[a + 1, x - 1, q1] && adm[x, q, a + 1] && adm[p, b, a + 1], delta[x - 1]\ delta[a + 1]\ lambda[a, 1, a + 1]\ tet[p, 1, x - 1, 1, a, x]\ tet[1, q1, x - 1, a, a + 1, 1]\ tet[q1, q, x, x - 1, a + 1, 1]\ tet\ [q, b, p, x, a + 1, 1]\ \(\(\(\(\(\(tet[a + 1, a, a, p, b, 1]/ lambda[x, 1, x - 1]\)/theta[x, x - 1, 1]\)/ theta[a, a + 1, 1]\)/theta[a, x - 1, 1]\)/ theta[a + 1, x - 1, q1]\)/theta[x, q, a + 1]\)/ theta[p, b, a + 1], 0] + If[adm[a, x + 1, 1] && adm[a - 1, x + 1, q1] && adm[x, q, a - 1] && adm[p, b, a - 1], delta[x + 1]\ delta[a - 1]\ lambda[a, 1, a - 1]\ tet[p, 1, x + 1, 1, a, x]\ tet[1, q1, x + 1, a, a - 1, 1]\ tet[q1, q, x, x + 1, a - 1, 1]\ tet\ [q, b, p, x, a - 1, 1]\ \(\(\(\(\(\(tet[a - 1, a, a, p, b, 1]/ lambda[x, 1, x + 1]\)/theta[x, x + 1, 1]\)/ theta[a, a - 1, 1]\)/theta[a, x + 1, 1]\)/ theta[a - 1, x + 1, q1]\)/theta[x, q, a - 1]\)/ theta[p, b, a - 1], 0] + If[adm[a, x + 1, 1] && adm[a + 1, x + 1, q1] && adm[x, q, a + 1] && adm[p, b, a + 1], delta[x + 1]\ delta[a + 1]\ lambda[a, 1, a + 1]\ tet[p, 1, x + 1, 1, a, x]\ tet[1, q1, x + 1, a, a + 1, 1]\ tet[q1, q, x, x + 1, a + 1, 1]\ tet\ [q, b, p, x, a + 1, 1]\ \(\(\(\(\(\(tet[a + 1, a, a, p, b, 1]/ lambda[x, 1, x + 1]\)/theta[x, x + 1, 1]\)/ theta[a, a + 1, 1]\)/theta[a, x + 1, 1]\)/ theta[a + 1, x + 1, q1]\)/theta[x, q, a + 1]\)/ theta[p, b, a + 1], 0];\)\[IndentingNewLine]\[IndentingNewLine] \(rhsr6term[x_, a_, b_, c_, p_, q_, q1_, r_] := If[adm[a, p, 1] && adm[b, q, 1] && adm[c, r, 1], rhsr6l[x, a, b, c, p, q, q1]\ rhsr6r[x, a, b, c, q, q1, r]/ rhsr6f[x, a, b, c, p, q, q1, r], 0];\)\[IndentingNewLine]\[IndentingNewLine] \(rhsr6[x_, a_, b_, c_] := rhsr6term[x, a, b, c, x - 1, 1, 0, x - 1] + rhsr6term[x, a, b, c, x - 1, 1, 0, x + 1] + rhsr6term[x, a, b, c, x - 1, 1, 2, x - 1] + rhsr6term[x, a, b, c, x - 1, 1, 2, x + 1] + rhsr6term[x, a, b, c, x - 1, 3, 2, x - 1] + rhsr6term[x, a, b, c, x - 1, 3, 2, x + 1] + rhsr6term[x, a, b, c, x + 1, 1, 0, x - 1] + rhsr6term[x, a, b, c, x + 1, 1, 0, x + 1] + rhsr6term[x, a, b, c, x + 1, 1, 2, x - 1] + rhsr6term[x, a, b, c, x + 1, 1, 2, x + 1] + rhsr6term[x, a, b, c, x + 1, 3, 2, x - 1] + rhsr6term[x, a, b, c, x + 1, 3, 2, x + 1];\)\[IndentingNewLine]\[IndentingNewLine] \(r6[x_, a_, b_, c_] := If[adm[a, a, b] && adm[c, c, b], \[IndentingNewLine]\((rhsr6[x, a, b, c] - lhsr6[x, a, b, c])\)/norm[a, b, c], 0] // Simplify;\)\[IndentingNewLine] \)\)\)], "Input"], Cell["\<\ Case 1 \ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(\(eref1[ e_] := \(ReplaceRepeated[\ e\ // Expand, {qif[x + y\/2] \[Rule] qi[x + y\/2]\ qif[x + y\/2 - 1], qif[y\/2 + z] \[Rule] qi[y\/2 + z]\ qif[y\/2 + z - 1], qif[x] \[Rule] qi[x]\ qif[x - 1], qif[y] \[Rule] qi[y]\ qif[y - 1], qi[n_] \[Rule] \((A^\((2\ n)\) - A^\((\(-2\)\ n)\))\)/\((A^2 - A^\((\(-2\))\))\)}] // Expand\) // Factor;\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(IntegerQ[x] ^= True; EvenQ[y] ^= True; IntegerQ[z] ^= True;\), "\[IndentingNewLine]", \(\(given = x \[GreaterEqual] 1 && y \[GreaterEqual] 2 && z \[GreaterEqual] 1 && y \[LessEqual] 2\ x && y \[LessEqual] 2\ z;\)\), "\[IndentingNewLine]", \(r1[x, y - 2, z - 1, x, y, z] // eref1\)}], "Input"], Cell[BoxData[ \(A\^\(\(-2\) - 2\ x - 2\ y\)\ \((A\^\(2 + 2\ x\) - A\^y)\)\ \((A\^\(2 + 2\ x\) + A\^y)\)\)], "Output"] }, Open ]], Cell["\<\ This is nonzero. \ \>", "Text"], Cell["\<\ Case 2 \ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(\(eref2[ e_] := \(ReplaceRepeated[\ e\ // Expand, {qif[x] \[Rule] qi[x]\ qif[x - 1], qif[z] \[Rule] qi[z]\ qif[z - 1], qi[n_] \[Rule] \((A^\((2\ n)\) - A^\((\(-2\)\ n)\))\)/\((A^2 - A^\((\(-2\))\))\)}] // Expand\) // Factor;\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(IntegerQ[x] ^= True; IntegerQ[z] ^= True;\), "\[IndentingNewLine]", \(\(given = x \[GreaterEqual] 1 && z \[GreaterEqual] 1;\)\), "\[IndentingNewLine]", \(r1[x, 0, z - 1, x, 2, z]\ r2[x - 1, 0, z, x, 0, z] - \ r1[x, 0, z - 1, x, 0, z]\ r2[x - 1, 0, z, x, 2, z] // eref2\)}], "Input"], Cell[BoxData[ \(\(-A\^\(\(-2\) - 2\ x - 2\ z\)\)\ \((\(-1\) + A\^x)\)\ \((1 + A\^x)\)\ \((A\^x - A\^z)\)\ \((\(-1\) + A\^z)\)\ \((1 + A\^z)\)\ \((A\^x + A\^z)\)\)], "Output"] }, Open ]], Cell["\<\ For x \[NotEqual] z, this is nonzero. \ \>", "Text"], Cell["\<\ Case 3 \ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(\(eref3[ e_] := \(ReplaceRepeated[\ e\ // Expand, {qif[x] \[Rule] qi[x]\ qif[x - 1], qif[x - 1] \[Rule] qi[x - 1]\ qif[x - 2], qi[n_] \[Rule] \((A^\((2\ n)\) - A^\((\(-2\)\ n)\))\)/\((A^2 - A^\((\(-2\))\))\)}] // Expand\) // Factor;\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(IntegerQ[x] ^= True; given = x \[GreaterEqual] 2;\), "\[IndentingNewLine]", \(\(mat[1, 1] = r1[x, 2, 1, x, 4, 2];\)\), "\[IndentingNewLine]", \(\(mat[1, 2] = r1[x, 2, 1, x, 2, 2];\)\), "\[IndentingNewLine]", \(\(mat[1, 3] = r1[x, 2, 1, x, 0, 2];\)\), "\[IndentingNewLine]", \(\(mat[1, 4] = r1[x, 2, 1, x, 0, 0];\)\), "\[IndentingNewLine]", \(\(mat[2, 1] = 0;\)\), "\[IndentingNewLine]", \(\(mat[2, 2] = r2[x - 1, 0, 2, x, 2, 2];\)\), "\[IndentingNewLine]", \(\(mat[2, 3] = r2[x - 1, 0, 2, x, 0, 2];\)\), "\[IndentingNewLine]", \(\(mat[2, 4] = 0;\)\), "\[IndentingNewLine]", \(\(mat[3, 1] = 0;\)\), "\[IndentingNewLine]", \(\(mat[3, 2] = r3[x - 1, 1, x, 2, 2];\)\), "\[IndentingNewLine]", \(\(mat[3, 3] = r3[x - 1, 1, x, 0, 2];\)\), "\[IndentingNewLine]", \(\(mat[3, 4] = r3[x - 1, 1, x, 0, 0];\)\), "\[IndentingNewLine]", \(\(mat[4, 1] = r4[x - 1, x, 4, 2];\)\), "\[IndentingNewLine]", \(\(mat[4, 2] = r4[x - 1, x, 2, 2];\)\), "\[IndentingNewLine]", \(\(mat[4, 3] = r4[x - 1, x, 0, 2];\)\), "\[IndentingNewLine]", \(\(mat[4, 4] = r4[x - 1, x, 0, 0];\)\), "\[IndentingNewLine]", \(Det[Table[mat[i, j], {i, 1, 4}, {j, 1, 4}]] // eref3\)}], "Input"], Cell[BoxData[ \(\((\(-1\) + A)\)\ A\^\(\(-10\) - 2\ x\)\ \((1 + A)\)\ \((1 + A\^2)\)\ \((\(-A\) + A\^x)\)\^2\ \((A + A\^x)\)\^2\ \((A\^2 + \ A\^\(2\ x\))\)\^2\)], "Output"] }, Open ]], Cell["\<\ For x>=2, nonzero. \ \>", "Text"], Cell["\<\ Case 4 \ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(\(eref4[ e_] := \(ReplaceRepeated[\ e\ // Expand, {qif[z] \[Rule] qi[z]\ qif[z - 1], qif[z - 1] \[Rule] qi[z - 1]\ qif[z - 2], qif[z - 2] \[Rule] qi[z - 2]\ qif[z - 3], qi[n_] \[Rule] \((A^\((2\ n)\) - A^\((\(-2\)\ n)\))\)/\((A^2 - A^\((\(-2\))\))\)}] // Expand\) // Factor;\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(IntegerQ[z] ^= True; given = z > 2;\), "\[IndentingNewLine]", \(\(mat[1, 1] = r1[2, 2, z - 1, 2, 4, z];\)\), "\[IndentingNewLine]", \(\(mat[1, 2] = r1[2, 2, z - 1, 2, 2, z];\)\), "\[IndentingNewLine]", \(\(mat[1, 3] = r1[2, 2, z - 1, 2, 0, z];\)\), "\[IndentingNewLine]", \(\(mat[1, 4] = 0;\)\), "\[IndentingNewLine]", \(\(mat[2, 1] = 0;\)\), "\[IndentingNewLine]", \(\(mat[2, 2] = r2[1, 0, z, 2, 2, z];\)\), "\[IndentingNewLine]", \(\(mat[2, 3] = r2[1, 0, z, 2, 0, z];\)\), "\[IndentingNewLine]", \(\(mat[2, 4] = r2[1, 0, z, 0, 0, z];\)\), "\[IndentingNewLine]", \(\(mat[3, 1] = 0;\)\), "\[IndentingNewLine]", \(\(mat[3, 2] = r3[1, z - 1, 2, 2, z];\)\), "\[IndentingNewLine]", \(\(mat[3, 3] = r3[1, z - 1, 2, 0, z];\)\), "\[IndentingNewLine]", \(\(mat[3, 4] = r3[1, z - 1, 0, 0, z];\)\), "\[IndentingNewLine]", \(\(mat[4, 1] = r5[z - 1, 2, 4, z];\)\), "\[IndentingNewLine]", \(\(mat[4, 2] = r5[z - 1, 2, 2, z];\)\), "\[IndentingNewLine]", \(\(mat[4, 3] = r5[z - 1, 2, 0, z];\)\), "\[IndentingNewLine]", \(\(mat[4, 4] = r5[z - 1, 0, 0, z];\)\), "\[IndentingNewLine]", \(Det[Table[mat[i, j], {i, 1, 4}, {j, 1, 4}]] // eref4\)}], "Input"], Cell[BoxData[ \(\(-\((\(-1\) + A)\)\)\ A\^\(\(-6\) - 2\ z\)\ \((1 + A)\)\ \((1 + A\^2)\)\ \((\(-1\) + A\^z)\)\ \((1 + A\^z)\)\ \((\(-A\) + A\^z)\)\ \((A + A\^z)\)\ \((A\^2 + A\^\(2\ z\))\)\)], "Output"] }, Open ]], Cell["\<\ z > 2, so this is nonzero. \ \>", "Text"], Cell[BoxData[ \(\(\(\[IndentingNewLine]\)\(\[IndentingNewLine]\)\)\)], "Input"], Cell["\<\ Case 5 \ \>", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(\(eref5a[e_] := e /. qi[n_] \[Rule] \((A^\((2\ n)\) - A^\((\(-2\)\ n)\))\)/\((A^2 - A^\((\(-2\))\))\) // Factor;\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(\(mat[1, 1] = r2[1, 2, 2, 2, 4, 2];\)\), "\[IndentingNewLine]", \(\(mat[1, 2] = r2[1, 2, 2, 2, 2, 2];\)\), "\[IndentingNewLine]", \(\(mat[1, 3] = r2[1, 2, 2, 2, 0, 2];\)\), "\[IndentingNewLine]", \(\(mat[2, 1] = 0;\)\), "\[IndentingNewLine]", \(\(mat[2, 2] = r3[1, 1, 2, 2, 2];\)\), "\[IndentingNewLine]", \(\(mat[2, 3] = r3[1, 1, 2, 0, 2];\)\), "\[IndentingNewLine]", \(\(mat[3, 1] = r6[0, 2, 4, 2];\)\), "\[IndentingNewLine]", \(\(mat[3, 2] = r6[0, 2, 2, 2];\)\), "\[IndentingNewLine]", \(\(mat[3, 3] = r6[0, 2, 0, 2];\)\), "\[IndentingNewLine]", \(Det[Table[mat[i, j], {i, 1, 3}, {j, 1, 3}]] // eref5a\)}], "Input"], Cell[BoxData[ \(\((\(-1\) + A)\)\ \((1 + A)\)\ \((1 + A\^2)\)\)], "Output"] }, Open ]], Cell["For x = z = 2, nonzero.", "Text"], Cell[CellGroupData[{ Cell[BoxData[{ \(\(\(eref5b[ e_] := \(ReplaceRepeated[\ e\ // Expand, {qif[x] \[Rule] qi[x]\ qif[x - 1], qif[x - 1] \[Rule] qi[x - 1]\ qif[x - 2], qif[x - 2] \[Rule] qi[x - 2]\ qif[x - 3], qi[n_] \[Rule] \((A^\((2\ n)\) - A^\((\(-2\)\ n)\))\)/\((A^2 - A^\((\(-2\))\))\)}] // Expand\) // Factor;\)\(\[IndentingNewLine]\) \)\), "\[IndentingNewLine]", \(IntegerQ[x] ^= True; given = x \[GreaterEqual] 3;\), "\[IndentingNewLine]", \(\(mat[1, 1] = r2[x - 1, 2, x, x, 4, x];\)\), "\[IndentingNewLine]", \(\(mat[1, 2] = r2[x - 1, 2, x, x, 2, x];\)\), "\[IndentingNewLine]", \(\(mat[1, 3] = r2[x - 1, 2, x, x, 0, x];\)\), "\[IndentingNewLine]", \(\(mat[2, 1] = 0;\)\), "\[IndentingNewLine]", \(\(mat[2, 2] = r3[x - 1, x - 1, x, 2, x];\)\), "\[IndentingNewLine]", \(\(mat[2, 3] = r3[x - 1, x - 1, x, 0, x];\)\), "\[IndentingNewLine]", \(\(mat[3, 1] = r6[x - 2, x, 4, x];\)\), "\[IndentingNewLine]", \(\(mat[3, 2] = r6[x - 2, x, 2, x];\)\), "\[IndentingNewLine]", \(\(mat[3, 3] = r6[x - 2, x, 0, x];\)\), "\[IndentingNewLine]", \(Det[Table[mat[i, j], {i, 1, 3}, {j, 1, 3}]] // eref5b\)}], "Input"], Cell[BoxData[ \(A\^\(\(-4\) + 2\ x\)\ \((\(-1\) + A\^x)\)\ \((1 + A\^x)\)\)], "Output"] }, Open ]], Cell["\<\ For x = z > 2, nonzero.\ \>", "Text"] }, FrontEndVersion->"4.2 for Microsoft Windows", ScreenRectangle->{{0, 1024}, {0, 681}}, ScreenStyleEnvironment->"Working", WindowSize->{983, 647}, WindowMargins->{{0, Automatic}, {Automatic, 0}}, PrintingCopies->1, PrintingPageRange->{Automatic, Automatic}, CellLabelAutoDelete->True, Magnification->1.25 ] (******************************************************************* Cached data follows. If you edit this Notebook file directly, not using Mathematica, you must remove the line containing CacheID at the top of the file. The cache data will then be recreated when you save this file from within Mathematica. *******************************************************************) (*CellTagsOutline CellTagsIndex->{} *) (*CellTagsIndex CellTagsIndex->{} *) (*NotebookFileOutline Notebook[{ Cell[1754, 51, 83, 3, 59, "Text"], Cell[1840, 56, 710, 15, 182, "Input"], Cell[2553, 73, 148, 4, 59, "Text"], Cell[2704, 79, 1826, 39, 560, "Input"], Cell[4533, 120, 2208, 39, 728, "Input"], Cell[6744, 161, 4031, 71, 770, "Input"], Cell[10778, 234, 1720, 32, 392, "Input"], Cell[12501, 268, 3412, 58, 581, "Input"], Cell[15916, 328, 4681, 81, 1001, "Input"], Cell[20600, 411, 31, 3, 59, "Text"], Cell[CellGroupData[{ Cell[20656, 418, 912, 18, 211, "Input"], Cell[21571, 438, 132, 2, 35, "Output"] }, Open ]], Cell[21718, 443, 62, 7, 143, "Text"], Cell[21783, 452, 31, 3, 59, "Text"], Cell[CellGroupData[{ Cell[21839, 459, 739, 15, 182, "Input"], Cell[22581, 476, 200, 3, 35, "Output"] }, Open ]], Cell[22796, 482, 64, 5, 101, "Text"], Cell[22863, 489, 31, 3, 59, "Text"], Cell[CellGroupData[{ Cell[22919, 496, 1655, 27, 476, "Input"], Cell[24577, 525, 187, 3, 36, "Output"] }, Open ]], Cell[24779, 531, 50, 10, 206, "Text"], Cell[24832, 543, 31, 3, 59, "Text"], Cell[CellGroupData[{ Cell[24888, 550, 1699, 27, 497, "Input"], Cell[26590, 579, 228, 3, 35, "Output"] }, Open ]], Cell[26833, 585, 51, 3, 59, "Text"], Cell[26887, 590, 83, 1, 77, "Input"], Cell[26973, 593, 31, 3, 59, "Text"], Cell[CellGroupData[{ Cell[27029, 600, 894, 14, 266, "Input"], Cell[27926, 616, 79, 1, 35, "Output"] }, Open ]], Cell[28020, 620, 39, 0, 38, "Text"], Cell[CellGroupData[{ Cell[28084, 624, 1270, 21, 350, "Input"], Cell[29357, 647, 91, 1, 35, "Output"] }, Open ]], Cell[29463, 651, 48, 3, 59, "Text"] } ] *) (******************************************************************* End of Mathematica Notebook file. *******************************************************************)