Theory Matrix_Aggregation_Algebras

(* Title:      Matrix Algebras for Aggregation and Minimisation
   Author:     Walter Guttmann
   Maintainer: Walter Guttmann <walter.guttmann at canterbury.ac.nz>
*)

section ‹Matrix Algebras for Aggregation and Minimisation›

text ‹
This theory formalises aggregation orders and lattices as introduced in cite"Guttmann2018a".
Aggregation in these algebras is an associative and commutative operation satisfying additional properties related to the partial order and its least element.
We apply the aggregation operation to finite matrices over the aggregation algebras, which shows that they form an s-algebra.
By requiring the aggregation algebras to be linearly ordered, we also obtain that the matrices form an m-algebra.

This is an intermediate step in demonstrating that weighted graphs form an s-algebra and an m-algebra.
The present theory specifies abstract properties for the edge weights and shows that matrices over such weights form an instance of s-algebras and m-algebras.
A second step taken in a separate theory gives concrete instances of edge weights satisfying the abstract properties introduced here.

Lifting the aggregation to matrices requires finite sums over elements taken from commutative semigroups with an element that is a unit on the image of the semigroup operation.
Because standard sums assume a commutative monoid we have to derive a number of properties of these generalised sums as their statements or proofs are different.
›

theory Matrix_Aggregation_Algebras

imports Stone_Kleene_Relation_Algebras.Matrix_Kleene_Algebras Aggregation_Algebras Semigroups_Big

begin

no_notation
  inf (infixl "" 70)
  and uminus ("- _" [81] 80)

subsection ‹Aggregation Orders and Finite Sums›

text ‹
An aggregation order is a partial order with a least element and an associative commutative operation satisfying certain properties.
Axiom add_add_bot› introduces almost a commutative monoid; we require that bot› is a unit only on the image of the aggregation operation.
This is necessary since it is not a unit of a number of aggregation operations we are interested in.
Axiom add_right_isotone› states that aggregation is $\leq$-isotone on the image of the aggregation operation.
Its assumption $x \neq bot$ is necessary because the introduction of new edges can decrease the aggregated value.
Axiom add_bot› expresses that aggregation is zero-sum-free.
›

class aggregation_order = order_bot + ab_semigroup_add +
  assumes add_right_isotone: "x  bot  x + bot  y + bot  x + z  y + z"
  assumes add_add_bot [simp]: "x + y + bot = x + y"
  assumes add_bot: "x + y = bot  x = bot"
begin

abbreviation "zero  bot + bot"

sublocale aggregation: ab_semigroup_add_0 where plus = plus and zero = zero
  apply unfold_locales
  using add_assoc add_add_bot by auto

lemma add_bot_bot_bot:
  "x + bot + bot + bot = x + bot"
  by simp

end

text ‹
We introduce notation for finite sums over aggregation orders.
The index variable of the summation ranges over the finite universe of its type.
Finite sums are defined recursively using the binary aggregation and $\bot + \bot$ for the empty sum.
›

syntax (xsymbols)
  "_sum_ab_semigroup_add_0" :: "idt  'a::bounded_semilattice_sup_bot  'a" ("(∑⇩_ _)" [0,10] 10)

translations
  "∑⇩x t" => "XCONST ab_semigroup_add_0.sum_0 XCONST plus (XCONST plus XCONST bot XCONST bot) (λx . t) { x . CONST True }"

text ‹
The following are basic properties of such sums.
›

lemma agg_sum_bot:
  "(∑⇩k bot::'a::aggregation_order) = bot + bot"
proof (induct rule: infinite_finite_induct)
  case (infinite A)
  thus ?case
    by simp
next
  case empty
  thus ?case
    by simp
next
  case (insert x F)
  thus ?case
    by (metis add.commute add_add_bot aggregation.sum_0.insert)
qed

lemma agg_sum_bot_bot:
  "(∑⇩k bot + bot::'a::aggregation_order) = bot + bot"
  by (rule aggregation.sum_0.neutral_const)

lemma agg_sum_not_bot_1:
  fixes f :: "'a::finite  'b::aggregation_order"
  assumes "f i  bot"
    shows "(∑⇩k f k)  bot"
  by (metis assms add_bot aggregation.sum_0.remove finite_code mem_Collect_eq)

lemma agg_sum_not_bot:
  fixes f :: "('a::finite,'b::aggregation_order) square"
  assumes "f (i,j)  bot"
    shows "(∑⇩k ∑⇩l f (k,l))  bot"
  by (metis assms agg_sum_not_bot_1)

lemma agg_sum_distrib:
  fixes f g :: "'a  'b::aggregation_order"
  shows "(∑⇩k f k + g k) = (∑⇩k f k) + (∑⇩k g k)"
  by (rule aggregation.sum_0.distrib)

lemma agg_sum_distrib_2:
  fixes f g :: "('a,'b::aggregation_order) square"
  shows "(∑⇩k ∑⇩l f (k,l) + g (k,l)) = (∑⇩k ∑⇩l f (k,l)) + (∑⇩k ∑⇩l g (k,l))"
proof -
  have "(∑⇩k ∑⇩l f (k,l) + g (k,l)) = (∑⇩k (∑⇩l f (k,l)) + (∑⇩l g (k,l)))"
    by (metis (no_types) aggregation.sum_0.distrib)
  also have "... = (∑⇩k ∑⇩l f (k,l)) + (∑⇩k ∑⇩l g (k,l))"
    by (metis (no_types) aggregation.sum_0.distrib)
  finally show ?thesis
    .
qed

lemma agg_sum_add_bot:
  fixes f :: "'a  'b::aggregation_order"
  shows "(∑⇩k f k) = (∑⇩k f k) + bot"
  by (metis (no_types) add_add_bot aggregation.sum_0.F_one)

lemma agg_sum_add_bot_2:
  fixes f :: "'a  'b::aggregation_order"
  shows "(∑⇩k f k + bot) = (∑⇩k f k)"
proof -
  have "(∑⇩k f k + bot) = (∑⇩k f k) + (∑⇩k::'a bot::'b)"
    using agg_sum_distrib by simp
  also have "... = (∑⇩k f k) + (bot + bot)"
    by (metis agg_sum_bot)
  also have "... = (∑⇩k f k)"
    by simp
  finally show ?thesis
    by simp
qed

lemma agg_sum_commute:
  fixes f :: "('a,'b::aggregation_order) square"
  shows "(∑⇩k ∑⇩l f (k,l)) = (∑⇩l ∑⇩k f (k,l))"
  by (rule aggregation.sum_0.swap)

lemma agg_delta:
  fixes f :: "'a::finite  'b::aggregation_order"
  shows "(∑⇩l if l = j then f l else zero) = f j + bot"
  apply (subst aggregation.sum_0.delta)
  apply simp
  by (metis add.commute add.left_commute add_add_bot mem_Collect_eq)

lemma agg_delta_1:
  fixes f :: "'a::finite  'b::aggregation_order"
  shows "(∑⇩l if l = j then f l else bot) = f j + bot"
proof -
  let ?f = "(λl . if l = j then f l else bot)"
  let ?S = "{l::'a . True}"
  show ?thesis
  proof (cases "j  ?S")
    case False
    thus ?thesis by simp
  next
    case True
    let ?A = "?S - {j}"
    let ?B = "{j}"
    from True have eq: "?S = ?A  ?B"
      by blast
    have dj: "?A  ?B = {}"
      by simp
    have fAB: "finite ?A" "finite ?B"
      by auto
    have "aggregation.sum_0 ?f ?S = aggregation.sum_0 ?f ?A + aggregation.sum_0 ?f ?B"
      using aggregation.sum_0.union_disjoint[OF fAB dj, of ?f, unfolded eq [symmetric]] by simp
    also have "... = aggregation.sum_0 (λl . bot) ?A + aggregation.sum_0 ?f ?B"
      by (subst aggregation.sum_0.cong[where ?B="?A"]) simp_all
    also have "... = zero + aggregation.sum_0 ?f ?B"
      by (metis (no_types, lifting) add.commute add_add_bot aggregation.sum_0.F_g_one aggregation.sum_0.neutral)
    also have "... = zero + (f j + zero)"
      by simp
    also have "... = f j + bot"
      by (metis add.commute add.left_commute add_add_bot)
    finally show ?thesis
      .
  qed
qed

lemma agg_delta_2:
  fixes f :: "('a::finite,'b::aggregation_order) square"
  shows "(∑⇩k ∑⇩l if k = i  l = j then f (k,l) else bot) = f (i,j) + bot"
proof -
  have "k . (∑⇩l if k = i  l = j then f (k,l) else bot) = (if k = i then f (k,j) + bot else zero)"
  proof
    fix k
    have "(∑⇩l if k = i  l = j then f (k,l) else bot) = (∑⇩l if l = j then if k = i then f (k,l) else bot else bot)"
      by meson
    also have "... = (if k = i then f (k,j) else bot) + bot"
      by (rule agg_delta_1)
    finally show "(∑⇩l if k = i  l = j then f (k,l) else bot) = (if k = i then f (k,j) + bot else zero)"
      by simp
  qed
  hence "(∑⇩k ∑⇩l if k = i  l = j then f (k,l) else bot) = (∑⇩k if k = i then f (k,j) + bot else zero)"
    using aggregation.sum_0.cong by auto
  also have "... = f (i,j) + bot"
    apply (subst agg_delta)
    by simp
  finally show ?thesis
    .
qed

subsection ‹Matrix Aggregation›

text ‹
The following definitions introduce the matrix of unit elements, componentwise aggregation and aggregation on matrices.
The aggregation of a matrix is a single value, but because s-algebras are single-sorted the result has to be encoded as a matrix of the same type (size) as the input.
We store the aggregated matrix value in the `first' entry of a matrix, setting all other entries to the unit value.
The first entry is determined by requiring an enumeration of indices.
It does not have to be the first entry; any fixed location in the matrix would work as well.
›

definition zero_matrix :: "('a,'b::{plus,bot}) square" ("mzero") where "mzero = (λe . bot + bot)"

definition plus_matrix :: "('a,'b::plus) square  ('a,'b) square  ('a,'b) square" (infixl "M" 65) where "plus_matrix f g = (λe . f e + g e)"

definition sum_matrix :: "('a::enum,'b::{plus,bot}) square  ('a,'b) square" ("sumM _" [80] 80) where "sum_matrix f = (λ(i,j) . if i = hd enum_class.enum  j = i then ∑⇩k ∑⇩l f (k,l) else bot + bot)"

text ‹
Basic properties of these operations are given in the following.
›

lemma bot_plus_bot:
  "mbot M mbot = mzero"
  by (simp add: plus_matrix_def bot_matrix_def zero_matrix_def)

lemma sum_bot:
  "sumM (mbot :: ('a::enum,'b::aggregation_order) square) = mzero"
proof (rule ext, rule prod_cases)
  fix i j :: "'a"
  have "(sumM mbot :: ('a,'b) square) (i,j) = (if i = hd enum_class.enum  j = i then ∑⇩(k::'a) ∑⇩(l::'a) bot else bot + bot)"
    by (unfold sum_matrix_def bot_matrix_def) simp
  also have "... = bot + bot"
    using agg_sum_bot aggregation.sum_0.neutral by fastforce
  also have "... = mzero (i,j)"
    by (simp add: zero_matrix_def)
  finally show "(sumM mbot :: ('a,'b) square) (i,j) = mzero (i,j)"
    .
qed

lemma sum_plus_bot:
  fixes f :: "('a::enum,'b::aggregation_order) square"
  shows "sumM f M mbot = sumM f"
proof (rule ext, rule prod_cases)
  let ?h = "hd enum_class.enum"
  fix i j
  have "(sumM f M mbot) (i,j) = (if i = ?h  j = i then (∑⇩k ∑⇩l f (k,l)) + bot else zero + bot)"
    by (simp add: plus_matrix_def bot_matrix_def sum_matrix_def)
  also have "... = (if i = ?h  j = i then ∑⇩k ∑⇩l f (k,l) else zero)"
    by (metis (no_types, lifting) add_add_bot aggregation.sum_0.F_one)
  also have "... = (sumM f) (i,j)"
    by (simp add: sum_matrix_def)
  finally show "(sumM f M mbot) (i,j) = (sumM f) (i,j)"
    by simp
qed

lemma sum_plus_zero:
  fixes f :: "('a::enum,'b::aggregation_order) square"
  shows "sumM f M mzero = sumM f"
  by (rule ext, rule prod_cases) (simp add: plus_matrix_def zero_matrix_def sum_matrix_def)

lemma agg_matrix_bot:
  fixes f :: "('a,'b::aggregation_order) square"
  assumes "i j . f (i,j) = bot"
    shows "f = mbot"
  apply (unfold bot_matrix_def)
  using assms by auto

text ‹
We consider a different implementation of matrix aggregation which stores the aggregated value in all entries of the matrix instead of a particular one.
This does not require an enumeration of the indices.
All results continue to hold using this alternative implementation.
›

definition sum_matrix_2 :: "('a,'b::{plus,bot}) square  ('a,'b) square" ("sum2M _" [80] 80) where "sum_matrix_2 f = (λe . ∑⇩k ∑⇩l f (k,l))"

lemma sum_bot_2:
  "sum2M (mbot :: ('a,'b::aggregation_order) square) = mzero"
proof
  fix e
  have "(sum2M mbot :: ('a,'b) square) e = (∑⇩(k::'a) ∑⇩(l::'a) bot)"
    by (unfold sum_matrix_2_def bot_matrix_def) simp
  also have "... = bot + bot"
    using agg_sum_bot aggregation.sum_0.neutral by fastforce
  also have "... = mzero e"
    by (simp add: zero_matrix_def)
  finally show "(sum2M mbot :: ('a,'b) square) e = mzero e"
    .
qed

lemma sum_plus_bot_2:
  fixes f :: "('a,'b::aggregation_order) square"
  shows "sum2M f M mbot = sum2M f"
proof
  fix e
  have "(sum2M f M mbot) e = (∑⇩k ∑⇩l f (k,l)) + bot"
    by (simp add: plus_matrix_def bot_matrix_def sum_matrix_2_def)
  also have "... = (∑⇩k ∑⇩l f (k,l))"
    by (metis (no_types, lifting) add_add_bot aggregation.sum_0.F_one)
  also have "... = (sum2M f) e"
    by (simp add: sum_matrix_2_def)
  finally show "(sum2M f M mbot) e = (sum2M f) e"
    by simp
qed

lemma sum_plus_zero_2:
  fixes f :: "('a,'b::aggregation_order) square"
  shows "sum2M f M mzero = sum2M f"
  by (simp add: plus_matrix_def zero_matrix_def sum_matrix_2_def)

subsection ‹Aggregation Lattices›

text ‹
We extend aggregation orders to dense bounded distributive lattices.
Axiom add_lattice› implements the inclusion-exclusion principle at the level of edge weights.
›

class aggregation_lattice = bounded_distrib_lattice + dense_lattice + aggregation_order +
  assumes add_lattice: "x + y = (x  y) + (x  y)"

text ‹
Aggregation lattices form a Stone relation algebra by reusing the meet operation as composition, using identity as converse and a standard implementation of pseudocomplement.
›

class aggregation_algebra = aggregation_lattice + uminus + one + times + conv +
  assumes uminus_def [simp]: "-x = (if x = bot then top else bot)"
  assumes one_def [simp]: "1 = top"
  assumes times_def [simp]: "x * y = x  y"
  assumes conv_def [simp]: "xT = x"
begin

subclass stone_algebra
  apply unfold_locales
  using bot_meet_irreducible bot_unique by auto

subclass stone_relation_algebra
  apply unfold_locales
  prefer 9 using bot_meet_irreducible apply auto[1]
  by (simp_all add: inf.assoc le_infI2 inf_sup_distrib1 inf_sup_distrib2 inf.commute inf.left_commute)

end

text ‹
We show that matrices over aggregation lattices form an s-algebra using the above operations.
›

interpretation agg_square_s_algebra: s_algebra where sup = sup_matrix and inf = inf_matrix and less_eq = less_eq_matrix and less = less_matrix and bot = "bot_matrix::('a::enum,'b::aggregation_algebra) square" and top = top_matrix and uminus = uminus_matrix and one = one_matrix and times = times_matrix and conv = conv_matrix and plus = plus_matrix and sum = sum_matrix
proof
  fix f g h :: "('a,'b) square"
  show "f  mbot  sumM f  sumM g  h M sumM f  h M sumM g"
  proof
    let ?h = "hd enum_class.enum"
    assume 1: "f  mbot  sumM f  sumM g"
    hence "k l . f (k,l)  bot"
      by (meson agg_matrix_bot)
    hence 2: "(∑⇩k ∑⇩l f (k,l))  bot"
      using agg_sum_not_bot by blast
    have "(∑⇩k ∑⇩l f (k,l)) = (sumM f) (?h,?h)"
      by (simp add: sum_matrix_def)
    also have "...  (sumM g) (?h,?h)"
      using 1 by (simp add: less_eq_matrix_def)
    also have "... = (∑⇩k ∑⇩l g (k,l))"
      by (simp add: sum_matrix_def)
    finally have "(∑⇩k ∑⇩l f (k,l))  (∑⇩k ∑⇩l g (k,l))"
      by simp
    hence 3: "(∑⇩k ∑⇩l f (k,l)) + bot  (∑⇩k ∑⇩l g (k,l)) + bot"
      by (metis (no_types, lifting) add_add_bot aggregation.sum_0.F_one)
    show "h M sumM f  h M sumM g"
    proof (unfold less_eq_matrix_def, rule allI, rule prod_cases, unfold plus_matrix_def)
      fix i j
      have 4: "h (i,j) + (∑⇩k ∑⇩l f (k,l))  h (i,j) + (∑⇩k ∑⇩l g (k,l))"
        using 2 3 by (metis (no_types, lifting) add_right_isotone add.commute)
      have "h (i,j) + (sumM f) (i,j) = h (i,j) + (if i = ?h  j = i then ∑⇩k ∑⇩l f (k,l) else zero)"
        by (simp add: sum_matrix_def)
      also have "... = (if i = ?h  j = i then h (i,j) + (∑⇩k ∑⇩l f (k,l)) else h (i,j) + zero)"
        by simp
      also have "...  (if i = ?h  j = i then h (i,j) + (∑⇩k ∑⇩l g (k,l)) else h (i,j) + zero)"
        using 4 order.eq_iff by auto
      also have "... = h (i,j) + (if i = ?h  j = i then ∑⇩k ∑⇩l g (k,l) else zero)"
        by simp
      finally show "h (i,j) + (sumM f) (i,j)  h (i,j) + (sumM g) (i,j)"
        by (simp add: sum_matrix_def)
    qed
  qed
next
  fix f :: "('a,'b) square"
  show "sumM f M sumM mbot = sumM f"
    by (simp add: sum_bot sum_plus_zero)
next
  fix f g :: "('a,'b) square"
  show "sumM f M sumM g = sumM (f  g) M sumM (f  g)"
  proof (rule ext, rule prod_cases)
    fix i j
    let ?h = "hd enum_class.enum"
    have "(sumM f M sumM g) (i,j) = (sumM f) (i,j) + (sumM g) (i,j)"
      by (simp add: plus_matrix_def)
    also have "... = (if i = ?h  j = i then ∑⇩k ∑⇩l f (k,l) else zero) + (if i = ?h  j = i then ∑⇩k ∑⇩l g (k,l) else zero)"
      by (simp add: sum_matrix_def)
    also have "... = (if i = ?h  j = i then (∑⇩k ∑⇩l f (k,l)) + (∑⇩k ∑⇩l g (k,l)) else zero)"
      by simp
    also have "... = (if i = ?h  j = i then ∑⇩k ∑⇩l f (k,l) + g (k,l) else zero)"
      using agg_sum_distrib_2 by (metis (no_types))
    also have "... = (if i = ?h  j = i then ∑⇩k ∑⇩l (f (k,l)  g (k,l)) + (f (k,l)  g (k,l)) else zero)"
      using add_lattice aggregation.sum_0.cong by (metis (no_types, lifting))
    also have "... = (if i = ?h  j = i then ∑⇩k ∑⇩l (f  g) (k,l) + (f  g) (k,l) else zero)"
      by (simp add: sup_matrix_def inf_matrix_def)
    also have "... = (if i = ?h  j = i then (∑⇩k ∑⇩l (f  g) (k,l)) + (∑⇩k ∑⇩l (f  g) (k,l)) else zero)"
      using agg_sum_distrib_2 by (metis (no_types))
    also have "... = (if i = ?h  j = i then ∑⇩k ∑⇩l (f  g) (k,l) else zero) + (if i = ?h  j = i then ∑⇩k ∑⇩l (f  g) (k,l) else zero)"
      by simp
    also have "... = (sumM (f  g)) (i,j) + (sumM (f  g)) (i,j)"
      by (simp add: sum_matrix_def)
    also have "... = (sumM (f  g) M sumM (f  g)) (i,j)"
      by (simp add: plus_matrix_def)
    finally show "(sumM f M sumM g) (i,j) = (sumM (f  g) M sumM (f  g)) (i,j)"
      .
  qed
next
  fix f :: "('a,'b) square"
  show "sumM (ft) = sumM f"
  proof (rule ext, rule prod_cases)
    fix i j
    let ?h = "hd enum_class.enum"
    have "(sumM (ft)) (i,j) = (if i = ?h  j = i then ∑⇩k ∑⇩l (ft) (k,l) else zero)"
      by (simp add: sum_matrix_def)
    also have "... = (if i = ?h  j = i then ∑⇩k ∑⇩l (f (l,k))T else zero)"
      by (simp add: conv_matrix_def)
    also have "... = (if i = ?h  j = i then ∑⇩k ∑⇩l f (l,k) else zero)"
      by simp
    also have "... = (if i = ?h  j = i then ∑⇩l ∑⇩k f (l,k) else zero)"
      by (metis agg_sum_commute)
    also have "... = (sumM f) (i,j)"
      by (simp add: sum_matrix_def)
    finally show "(sumM (ft)) (i,j) = (sumM f) (i,j)"
      .
  qed
qed

text ‹
We show the same for the alternative implementation that stores the result of aggregation in all elements of the matrix.
›

interpretation agg_square_s_algebra_2: s_algebra where sup = sup_matrix and inf = inf_matrix and less_eq = less_eq_matrix and less = less_matrix and bot = "bot_matrix::('a::finite,'b::aggregation_algebra) square" and top = top_matrix and uminus = uminus_matrix and one = one_matrix and times = times_matrix and conv = conv_matrix and plus = plus_matrix and sum = sum_matrix_2
proof
  fix f g h :: "('a,'b) square"
  show "f  mbot  sum2M f  sum2M g  h M sum2M f  h M sum2M g"
  proof
    assume 1: "f  mbot  sum2M f  sum2M g"
    hence "k l . f (k,l)  bot"
      by (meson agg_matrix_bot)
    hence 2: "(∑⇩k ∑⇩l f (k,l))  bot"
      using agg_sum_not_bot by blast
    obtain c :: 'a where True
      by simp
    have "(∑⇩k ∑⇩l f (k,l)) = (sum2M f) (c,c)"
      by (simp add: sum_matrix_2_def)
    also have "...  (sum2M g) (c,c)"
      using 1 by (simp add: less_eq_matrix_def)
    also have "... = (∑⇩k ∑⇩l g (k,l))"
      by (simp add: sum_matrix_2_def)
    finally have "(∑⇩k ∑⇩l f (k,l))  (∑⇩k ∑⇩l g (k,l))"
      by simp
    hence 3: "(∑⇩k ∑⇩l f (k,l)) + bot  (∑⇩k ∑⇩l g (k,l)) + bot"
      by (metis (no_types, lifting) add_add_bot aggregation.sum_0.F_one)
    show "h M sum2M f  h M sum2M g"
    proof (unfold less_eq_matrix_def, rule allI, unfold plus_matrix_def)
      fix e
      have "h e + (sum2M f) e = h e + (∑⇩k ∑⇩l f (k,l))"
        by (simp add: sum_matrix_2_def)
      also have "...  h e + (∑⇩k ∑⇩l g (k,l))"
        using 2 3 by (metis (no_types, lifting) add_right_isotone add.commute)
      finally show "h e + (sum2M f) e  h e + (sum2M g) e"
        by (simp add: sum_matrix_2_def)
    qed
  qed
next
  fix f :: "('a,'b) square"
  show "sum2M f M sum2M mbot = sum2M f"
    by (simp add: sum_bot_2 sum_plus_zero_2)
next
  fix f g :: "('a,'b) square"
  show "sum2M f M sum2M g = sum2M (f  g) M sum2M (f  g)"
  proof
    fix e
    have "(sum2M f M sum2M g) e = (sum2M f) e + (sum2M g) e"
      by (simp add: plus_matrix_def)
    also have "... = (∑⇩k ∑⇩l f (k,l)) + (∑⇩k ∑⇩l g (k,l))"
      by (simp add: sum_matrix_2_def)
    also have "... = (∑⇩k ∑⇩l f (k,l) + g (k,l))"
      using agg_sum_distrib_2 by (metis (no_types))
    also have "... = (∑⇩k ∑⇩l (f (k,l)  g (k,l)) + (f (k,l)  g (k,l)))"
      using add_lattice aggregation.sum_0.cong by (metis (no_types, lifting))
    also have "... = (∑⇩k ∑⇩l (f  g) (k,l) + (f  g) (k,l))"
      by (simp add: sup_matrix_def inf_matrix_def)
    also have "... = (∑⇩k ∑⇩l (f  g) (k,l)) + (∑⇩k ∑⇩l (f  g) (k,l))"
      using agg_sum_distrib_2 by (metis (no_types))
    also have "... = (sum2M (f  g)) e + (sum2M (f  g)) e"
      by (simp add: sum_matrix_2_def)
    also have "... = (sum2M (f  g) M sum2M (f  g)) e"
      by (simp add: plus_matrix_def)
    finally show "(sum2M f M sum2M g) e = (sum2M (f  g) M sum2M (f  g)) e"
      .
  qed
next
  fix f :: "('a,'b) square"
  show "sum2M (ft) = sum2M f"
  proof
    fix e
    have "(sum2M (ft)) e = (∑⇩k ∑⇩l (ft) (k,l))"
      by (simp add: sum_matrix_2_def)
    also have "... = (∑⇩k ∑⇩l (f (l,k))T)"
      by (simp add: conv_matrix_def)
    also have "... = (∑⇩k ∑⇩l f (l,k))"
      by simp
    also have "... = (∑⇩l ∑⇩k f (l,k))"
      by (metis agg_sum_commute)
    also have "... = (sum2M f) e"
      by (simp add: sum_matrix_2_def)
    finally show "(sum2M (ft)) e = (sum2M f) e"
      .
  qed
qed

subsection ‹Matrix Minimisation›

text ‹
We construct an operation that finds the minimum entry of a matrix.
Because a matrix can have several entries with the same minimum value, we introduce a lexicographic order on the indices to make the operation deterministic.
The order is obtained by enumerating the universe of the index.
›

primrec enum_pos' :: "'a list  'a::enum  nat" where
  "enum_pos' Nil x = 0"
| "enum_pos' (y#ys) x = (if x = y then 0 else 1 + enum_pos' ys x)"

lemma enum_pos'_inverse:
  "List.member xs x  xs!(enum_pos' xs x) = x"
  apply (induct xs)
  apply (simp add: member_rec(2))
  by (metis diff_add_inverse enum_pos'.simps(2) less_one member_rec(1) not_add_less1 nth_Cons')

text ‹
The following function finds the position of an index in the enumerated universe.
›

fun enum_pos :: "'a::enum  nat" where "enum_pos x = enum_pos' (enum_class.enum::'a list) x"

lemma enum_pos_inverse [simp]:
  "enum_class.enum!(enum_pos x) = x"
  apply (unfold enum_pos.simps)
  apply (rule enum_pos'_inverse)
  by (metis in_enum List.member_def)

lemma enum_pos_injective [simp]:
  "enum_pos x = enum_pos y  x = y"
  by (metis enum_pos_inverse)

text ‹
The position in the enumerated universe determines the order.
›

abbreviation enum_pos_less_eq :: "'a::enum  'a  bool" where "enum_pos_less_eq x y  (enum_pos x  enum_pos y)"
abbreviation enum_pos_less :: "'a::enum  'a  bool" where "enum_pos_less x y  (enum_pos x < enum_pos y)"

sublocale enum < enum_order: order where less_eq = "λx y . enum_pos_less_eq x y" and less = "λx y . enum_pos x < enum_pos y"
  apply unfold_locales
  by auto

text ‹
Based on this, a lexicographic order is defined on pairs, which represent locations in a matrix.
›

abbreviation enum_lex_less :: "'a::enum × 'a  'a × 'a  bool" where "enum_lex_less  (λ(i,j) (k,l) . enum_pos_less i k  (i = k  enum_pos_less j l))"
abbreviation enum_lex_less_eq :: "'a::enum × 'a  'a × 'a  bool" where "enum_lex_less_eq  (λ(i,j) (k,l) . enum_pos_less i k  (i = k  enum_pos_less_eq j l))"

text ‹
The $m$-operation determines the location of the non-$\bot$ minimum element which is first in the lexicographic order.
The result is returned as a regular matrix with $\top$ at that location and $\bot$ everywhere else.
In the weighted-graph model, this represents a single unweighted edge of the graph.
›

definition minarc_matrix :: "('a::enum,'b::{bot,ord,plus,top}) square  ('a,'b) square" ("minarcM _" [80] 80) where "minarc_matrix f = (λe . if f e  bot  (d . (f d  bot  (f e + bot  f d + bot  (enum_lex_less d e  f e + bot  f d + bot)))) then top else bot)"

lemma minarc_at_most_one:
  fixes f :: "('a::enum,'b::{aggregation_order,top}) square"
  assumes "(minarcM f) e  bot"
      and "(minarcM f) d  bot"
    shows "e = d"
proof -
  have 1: "f e + bot  f d + bot"
    by (metis assms minarc_matrix_def)
  have "f d + bot  f e + bot"
    by (metis assms minarc_matrix_def)
  hence "f e + bot = f d + bot"
    using 1 by simp
  hence "¬ enum_lex_less d e  ¬ enum_lex_less e d"
    using assms by (unfold minarc_matrix_def) (metis (lifting))
  thus ?thesis
    using enum_pos_injective less_linear by auto
qed

subsection ‹Linear Aggregation Lattices›

text ‹
We now assume that the aggregation order is linear and forms a bounded lattice.
It follows that these structures are aggregation lattices.
A linear order on matrix entries is necessary to obtain a unique minimum entry.
›

class linear_aggregation_lattice = linear_bounded_lattice + aggregation_order
begin

subclass aggregation_lattice
  apply unfold_locales
  by (metis add_commute sup_inf_selective)

sublocale heyting: bounded_heyting_lattice where implies = "λx y . if x  y then top else y"
  apply unfold_locales
  by (simp add: inf_less_eq)

end

text ‹
Every non-empty set with a transitive total relation has a least element with respect to this relation.
›

lemma least_order:
  assumes transitive: "x y z . le x y  le y z  le x z"
      and total: "x y . le x y  le y x"
    shows "finite A  A  {}  x . x  A  (y . y  A  le x y)"
proof (induct A rule: finite_ne_induct)
  case singleton
  thus ?case
    using total by auto
next
  case insert
  thus ?case
    by (metis insert_iff transitive total)
qed

lemma minarc_at_least_one:
  fixes f :: "('a::enum,'b::linear_aggregation_lattice) square"
  assumes "f  mbot"
    shows "e . (minarcM f) e = top"
proof -
  let ?nbe = "{ (e,f e) | e . f e  bot }"
  have 1: "finite ?nbe"
    using finite_code finite_image_set by blast
  have 2: "?nbe  {}"
    using assms agg_matrix_bot by fastforce
  let ?le = "λ(e::'a × 'a,fe::'b) (d::'a × 'a,fd) . fe + bot  fd + bot"
  have 3: "x y z . ?le x y  ?le y z  ?le x z"
    by auto
  have 4: "x y . ?le x y  ?le y x"
    by (simp add: linear)
  have "x . x  ?nbe  (y . y  ?nbe  ?le x y)"
    by (rule least_order, rule 3, rule 4, rule 1, rule 2)
  then obtain e fe where 5: "(e,fe)  ?nbe  (y . y  ?nbe  ?le (e,fe) y)"
    by auto
  let ?me = "{ e . f e  bot  f e + bot = fe + bot }"
  have 6: "finite ?me"
    using finite_code finite_image_set by blast
  have 7: "?me  {}"
    using 5 by auto
  have 8: "x y z . enum_lex_less_eq x y  enum_lex_less_eq y z  enum_lex_less_eq x z"
    by auto
  have 9: "x y . enum_lex_less_eq x y  enum_lex_less_eq y x"
    by auto
  have "x . x  ?me  (y . y  ?me  enum_lex_less_eq x y)"
    by (rule least_order, rule 8, rule 9, rule 6, rule 7)
  then obtain m where 10: "m  ?me  (y . y  ?me  enum_lex_less_eq m y)"
    by auto
  have 11: "f m  bot"
    using 10 5 by auto
  have 12: "d. f d  bot  f m + bot  f d + bot"
    using 10 5 by simp
  have "d. f d  bot  enum_lex_less d m  f m + bot  f d + bot"
    using 10 by fastforce
  hence "(minarcM f) m = top"
    using 11 12 by (simp add: minarc_matrix_def)
  thus ?thesis
    by blast
qed

text ‹
Linear aggregation lattices form a Stone relation algebra by reusing the meet operation as composition, using identity as converse and a standard implementation of pseudocomplement.
›

class linear_aggregation_algebra = linear_aggregation_lattice + uminus + one + times + conv +
  assumes uminus_def_2 [simp]: "-x = (if x = bot then top else bot)"
  assumes one_def_2 [simp]: "1 = top"
  assumes times_def_2 [simp]: "x * y = x  y"
  assumes conv_def_2 [simp]: "xT = x"
begin

subclass aggregation_algebra
  apply unfold_locales
  using inf_dense by auto

lemma regular_bot_top_2:
  "regular x  x = bot  x = top"
  by simp

sublocale heyting: heyting_stone_algebra where implies = "λx y . if x  y then top else y"
  apply unfold_locales
  apply (simp add: order.antisym)
  by auto

end

text ‹
We show that matrices over linear aggregation lattices form an m-algebra using the above operations.
›

interpretation agg_square_m_algebra: m_algebra where sup = sup_matrix and inf = inf_matrix and less_eq = less_eq_matrix and less = less_matrix and bot = "bot_matrix::('a::enum,'b::linear_aggregation_algebra) square" and top = top_matrix and uminus = uminus_matrix and one = one_matrix and times = times_matrix and conv = conv_matrix and plus = plus_matrix and sum = sum_matrix and minarc = minarc_matrix
proof
  fix f :: "('a,'b) square"
  show "minarcM f  f"
  proof (unfold less_eq_matrix_def, rule allI)
    fix e :: "'a × 'a"
    have "(minarcM f) e  (if f e  bot then top else --(f e))"
      by (simp add: minarc_matrix_def)
    also have "... = --(f e)"
      by simp
    also have "... = (f) e"
      by (simp add: uminus_matrix_def)
    finally show "(minarcM f) e  (f) e"
      .
  qed
next
  fix f :: "('a,'b) square"
  let ?at = "bounded_distrib_allegory_signature.arc mone times_matrix less_eq_matrix mtop conv_matrix"
  show "f  mbot  ?at (minarcM f)"
  proof
    assume 1: "f  mbot"
    have "minarcM f  mtop  (minarcM f  mtop)t = minarcM f  mtop  (minarcM f)t"
      by (metis matrix_bounded_idempotent_semiring.surjective_top_closed matrix_monoid.mult_assoc matrix_stone_relation_algebra.conv_dist_comp matrix_stone_relation_algebra.conv_top)
    also have "...  mone"
    proof (unfold less_eq_matrix_def, rule allI, rule prod_cases)
      fix i j
      have "(minarcM f  mtop  (minarcM f)t) (i,j) = (⨆⇩l (⨆⇩k (minarcM f) (i,k) * mtop (k,l)) * ((minarcM f)t) (l,j))"
        by (simp add: times_matrix_def)
      also have "... = (⨆⇩l (⨆⇩k (minarcM f) (i,k) * top) * ((minarcM f) (j,l))T)"
        by (simp add: top_matrix_def conv_matrix_def)
      also have "... = (⨆⇩l ⨆⇩k (minarcM f) (i,k) * top * ((minarcM f) (j,l))T)"
        by (metis comp_right_dist_sum)
      also have "... = (⨆⇩l ⨆⇩k if i = j  l = k then (minarcM f) (i,k) * top * ((minarcM f) (j,l))T else bot)"
        apply (rule sup_monoid.sum.cong)
        apply simp
        by (metis (no_types, lifting) comp_left_zero comp_right_zero conv_bot prod.inject minarc_at_most_one)
      also have "... = (if i = j then (⨆⇩l ⨆⇩k if l = k then (minarcM f) (i,k) * top * ((minarcM f) (j,l))T else bot) else bot)"
        by auto
      also have "...  (if i = j then top else bot)"
        by simp
      also have "... = mone (i,j)"
        by (simp add: one_matrix_def)
      finally show "(minarcM f  mtop  (minarcM f)t) (i,j)  mone (i,j)"
        .
    qed
    finally have 2: "minarcM f  mtop  (minarcM f  mtop)t  mone"
      .
    have 3: "mtop  (minarcM f  mtop) = mtop"
    proof (rule ext, rule prod_cases)
      fix i j
      from minarc_at_least_one obtain ei ej where "(minarcM f) (ei,ej) = top"
        using 1 by force
      hence 4: "top * top  (⨆⇩l (minarcM f) (ei,l) * top)"
        by (metis comp_inf.ub_sum)
      have "top * (⨆⇩l (minarcM f) (ei,l) * top)  (⨆⇩k top * (⨆⇩l (minarcM f) (k,l) * top))"
        by (rule comp_inf.ub_sum)
      hence "top  (⨆⇩k top * (⨆⇩l (minarcM f) (k,l) * top))"
        using 4 by auto
      also have "... = (⨆⇩k mtop (i,k) * (⨆⇩l (minarcM f) (k,l) * mtop (l,j)))"
        by (simp add: top_matrix_def)
      also have "... = (mtop  (minarcM f  mtop)) (i,j)"
        by (simp add: times_matrix_def)
      finally show "(mtop  (minarcM f  mtop)) (i,j) = mtop (i,j)"
        by (simp add: eq_iff top_matrix_def)
    qed
    have "(minarcM f)t  mtop  ((minarcM f)t  mtop)t = (minarcM f)t  mtop  (minarcM f)"
      by (metis matrix_stone_relation_algebra.comp_associative matrix_stone_relation_algebra.conv_dist_comp matrix_stone_relation_algebra.conv_involutive matrix_stone_relation_algebra.conv_top matrix_bounded_idempotent_semiring.surjective_top_closed)
    also have "...  mone"
    proof (unfold less_eq_matrix_def, rule allI, rule prod_cases)
      fix i j
      have "((minarcM f)t  mtop  minarcM f) (i,j) = (⨆⇩l (⨆⇩k ((minarcM f)t) (i,k) * mtop (k,l)) * (minarcM f) (l,j))"
        by (simp add: times_matrix_def)
      also have "... = (⨆⇩l (⨆⇩k ((minarcM f) (k,i))T * top) * (minarcM f) (l,j))"
        by (simp add: top_matrix_def conv_matrix_def)
      also have "... = (⨆⇩l ⨆⇩k ((minarcM f) (k,i))T * top * (minarcM f) (l,j))"
        by (metis comp_right_dist_sum)
      also have "... = (⨆⇩l ⨆⇩k if i = j  l = k then ((minarcM f) (k,i))T * top * (minarcM f) (l,j) else bot)"
        apply (rule sup_monoid.sum.cong)
        apply simp
        by (metis (no_types, lifting) comp_left_zero comp_right_zero conv_bot prod.inject minarc_at_most_one)
      also have "... = (if i = j then (⨆⇩l ⨆⇩k if l = k then ((minarcM f) (k,i))T * top * (minarcM f) (l,j) else bot) else bot)"
        by auto
      also have "...  (if i = j then top else bot)"
        by simp
      also have "... = mone (i,j)"
        by (simp add: one_matrix_def)
      finally show "((minarcM f)t  mtop  (minarcM f)) (i,j)  mone (i,j)"
        .
    qed
    finally have 5: "(minarcM f)t  mtop  ((minarcM f)t  mtop)t  mone"
      .
    have "mtop  ((minarcM f)t  mtop) = mtop"