The Miracle of Integer Eigenvalues is a paper that shows how any partially-ordered set can be used to generate a matrix with integer eigenvalues.

R. Kenyon et al, Funct. Anal. Its Appl. 58, 182–194 (2024)  doi: 10.1134/S0016266324020072, arXiv:2401.05291v2

Here I outline the process and give two examples.

restart

PartiallyOrdered sets is after GraphTheory so its DrawGraph gets priority.

with(GraphTheory); with(LinearAlgebra); with(PartiallyOrderedSets)

Example (the first example in the paper): Poset in 3 elements with one relation {u < v, {u, v, w}}.

vars := [u, v, w]; n := nops(vars); rels := {u < v}

[u, v, w]

3

{u < v}

Some derived things we will need.

translate := `~`[`=`](vars, [`$`(1 .. n)]); arcs := map(`@`(`[]`, op), rels); A := AdjacencyMatrix(Graph(vars, arcs))

translate := [u = 1, v = 2, w = 3]

arcs := {[u, v]}

Matrix(%id = 36893490746138016812)

p := PartiallyOrderedSet(vars, A)

module PosetObject () local numElems::':-integer', height::':-integer', width::':-integer', comparator::procedure, comparatorExists::boolean, transitiveClosure::Matrix, transitiveClosureExists::boolean, transitiveReduction::Matrix, transitiveReductionExists::boolean, elementMap::table, minimalElements::set, minimalElementsExists::boolean, leastElement::':-integer', maximalElements::set, maximalElementsExists::boolean, greatestElement::':-integer', closureGraph::Graph, closureGraphExists::boolean, connectedComponents::(set(set)), connectedComponentsExists::boolean, reductionGraph::Graph, reductionGraphExists::boolean, adjList::Array, adjListExists::boolean, isLattice::boolean, isFaceLattice::boolean, grade::':-integer', isGraded::boolean, isRanked::boolean, rankFuction::procedure, rankTable::Array, rankFuctionExists::boolean; option object; end module

We can represent this as a directed graph.

DrawGraph(p, size = [200, 200])

There are three linear extensions; roughly these are linear orders/chains with all of {u, v, w} that maintain u < v. In this case there are three: u < v and v < w, u < w and w < v, w < u and u < v. In other words, we want to find all permutations of [1,2,3] in which 1 (=u) precedes 2 (=v). We can use the iterator TopologicalSort, which finds all permutations satisfying some relations.

T := Iterator:-TopologicalSorts(n, subs(translate, rels))

_m2598758943744

The three permutations that have u before v are given below both numerically and symbolically.

extnums := [seq([seq(t)], `in`(t, T))]; exts := [seq(vars[[seq(t)]], `in`(t, T))]

[[1, 2, 3], [1, 3, 2], [3, 1, 2]]

[[u, v, w], [u, w, v], [w, u, v]]

Choose two of these, P and Q, say the first two.

Pnum, Qnum := extnums[1 .. 2][]; P, Q := exts[1 .. 2][]

[1, 2, 3], [1, 3, 2]

[u, v, w], [u, w, v]

Then the kth node in Q is a (P,Q) disagreement node or descent node if the k-1th node in Q is greater than the kth node, considered as a relation in P.  For example, for k = 2 (w in Q), so k-1 = 1 (u in Q) then in P we have u < w and w is a (P,Q) agreement node. For k = 3 (v) and k-1 = 2 (w) we have w > v in P and disagreement. The first node in Q is defined to be an agreement node. So u = agree, w = agree, v = disagree. We make a list of agreements (0) and disagreements (1) from k = 2 to k = n and find [0,1].

As a procedure we have

eps := proc(P::permlist, Q::permlist)
local k, i, j, L;
for k from 2 to nops(Q) do
  member(Q[k-1], P, 'i');
  member(Q[k], P, 'j');
  if i < j then L[k] := 0 else L[k] := 1 end if;
end do;
convert(L, list);
end proc:

eps(Pnum, Qnum)

[0, 1]

So now we do this for all P,Q pairs and fill a 3x3 matrix with a variable indexed with the generated lists

M := Matrix(nops(extnums), proc (i, j) options operator, arrow; index(a, eps(extnums[i], extnums[j])[]) end proc)

:=

And we find this matrix has eigenvalues that are linear combinations of these variables, with integer coefficients

Eigenvalues(M, output = list)

[a[0, 0]-a[1, 0], a[0, 0]-a[0, 1], a[0, 0]+a[1, 0]+a[0, 1]]

And of course if these variables had integer values, the matrix would have all integer eigenvalues.

inds := indets(M); r := rand(-20 .. 20); M2 := eval(M, `~`[`=`](inds, {seq(r(), 1 .. nops(inds))})); Eigenvalues(M2, output = list)

Matrix(%id = 36893490746138039948)

[7, -7, -6]

Example 2: A poset with the Hasse diagram: (generated below)

It is convenient to enter only the arcs shown (not b<e)

vars := [a, b, c, d, e]; n := nops(vars); rels := {a < c, b < c, b < d, d < e}

[a, b, c, d, e]

5

{a < c, b < c, b < d, d < e}

Specify input = transitivereduction so the missing relation doesn't throw an error.

translate := `~`[`=`](vars, [`$`(1 .. n)]); arcs := map(`@`(`[]`, op), rels); A := AdjacencyMatrix(Graph(vars, arcs)); p := PartiallyOrderedSet(vars, A, input = transitivereduction)

translate := [a = 1, b = 2, c = 3, d = 4, e = 5]

arcs := {[a, c], [b, c], [b, d], [d, e]}

Matrix(%id = 36893490746159485164)

module PosetObject () local numElems::':-integer', height::':-integer', width::':-integer', comparator::procedure, comparatorExists::boolean, transitiveClosure::Matrix, transitiveClosureExists::boolean, transitiveReduction::Matrix, transitiveReductionExists::boolean, elementMap::table, minimalElements::set, minimalElementsExists::boolean, leastElement::':-integer', maximalElements::set, maximalElementsExists::boolean, greatestElement::':-integer', closureGraph::Graph, closureGraphExists::boolean, connectedComponents::(set(set)), connectedComponentsExists::boolean, reductionGraph::Graph, reductionGraphExists::boolean, adjList::Array, adjListExists::boolean, isLattice::boolean, isFaceLattice::boolean, grade::':-integer', isGraded::boolean, isRanked::boolean, rankFuction::procedure, rankTable::Array, rankFuctionExists::boolean; option object; end module

The graph is the transitive reduction (Hasse diagram).

DrawGraph(p, size = [200, 200])

Update the relations to include all those in the transitive closure (including b<e)

Edges(ToGraph(p, reduction = false)); rels := map(`@`(`<`, op), %)

{[a, c], [b, c], [b, d], [b, e], [d, e]}

{a < c, b < c, b < d, b < e, d < e}

Find the 9 linear extensions

T := Iterator:-TopologicalSorts(n, subs(translate, rels)); extnums := [seq([seq(t)], `in`(t, T))]; exts := [seq(vars[[seq(t)]], `in`(t, T))]

_m2598743159552

[[1, 2, 3, 4, 5], [1, 2, 4, 3, 5], [1, 2, 4, 5, 3], [2, 1, 3, 4, 5], [2, 1, 4, 3, 5], [2, 1, 4, 5, 3], [2, 4, 1, 3, 5], [2, 4, 1, 5, 3], [2, 4, 5, 1, 3]]

[[a, b, c, d, e], [a, b, d, c, e], [a, b, d, e, c], [b, a, c, d, e], [b, a, d, c, e], [b, a, d, e, c], [b, d, a, c, e], [b, d, a, e, c], [b, d, e, a, c]]

Leading to the matrix

M := Matrix(nops(extnums), proc (i, j) options operator, arrow; index(a, eps(extnums[i], extnums[j])[]) end proc)

Matrix(%id = 36893490746138048980)

The eigenvalues

Eigenvalues(M, output = list)

[a[0, 0, 0, 0]-a[0, 0, 1, 0], a[0, 0, 0, 0]-a[0, 0, 1, 0]-a[1, 0, 0, 0]+a[1, 0, 1, 0], a[0, 0, 0, 0]-a[0, 0, 1, 0]+a[1, 0, 0, 0]-a[1, 0, 1, 0], a[0, 0, 0, 0]-a[0, 0, 0, 1]-a[1, 0, 0, 0]+a[1, 0, 0, 1], a[0, 0, 0, 0]-a[0, 0, 0, 1]-a[0, 1, 0, 0]+a[0, 1, 0, 1], a[0, 0, 0, 0]+a[0, 0, 0, 1]-a[0, 1, 0, 0]-a[0, 1, 0, 1], a[0, 0, 0, 0]-a[0, 0, 0, 1]+a[0, 1, 0, 0]-a[0, 1, 0, 1]+a[1, 0, 0, 0]-a[1, 0, 0, 1], a[0, 0, 0, 0]+a[0, 0, 0, 1]+a[0, 0, 1, 0]-a[1, 0, 0, 0]-a[1, 0, 0, 1]-a[1, 0, 1, 0], a[0, 0, 0, 0]+a[0, 0, 0, 1]+2*a[0, 0, 1, 0]+a[0, 1, 0, 0]+a[0, 1, 0, 1]+a[1, 0, 0, 0]+a[1, 0, 0, 1]+a[1, 0, 1, 0]]

and with some integer entries

inds := indets(M); M2 := eval(M, `~`[`=`](inds, {seq(r(), 1 .. nops(inds))})); Eigenvalues(M2, output = list)

M2 :=

[0, -68, -32, 3, -12, 8, -8, -6, -2]

NULL

Download IntegerEigenvalues.mw


Please Wait...