Theory Kleene_Algebra_Converse

(* 
Title: Kleene algebra with converse
Author: Cameron Calk, Georg Struth
Maintainer: Georg Struth <g.struth at sheffield.ac.uk>
*)

section ‹Kleene algebra with converse›

theory "Kleene_Algebra_Converse"
  imports Kleene_Algebra.Kleene_Algebra

begin

text ‹We start from involutive dioids and Kleene algebra and then add a so-called strong Gelfand property 
to obtain an operation of converse that is closer to algebras of paths and relations.›

subsection ‹Involutive Kleene algebra›

class invol_op = 
  fixes invol :: "'a ⇒ 'a" (‹_∘› [101] 100)

class involutive_dioid = dioid_one_zero + invol_op +
  assumes inv_invol [simp]: "(x∘)∘ = x"
  and inv_contrav [simp]: "(x ⋅ y)∘ = y∘ ⋅ x∘"
  and inv_sup [simp]: "(x + y)∘ = x∘ + y∘"

begin

lemma inv_zero [simp]: "0∘ = 0"
proof-
  have "0∘ = (0∘ ⋅ 0)∘"
    by simp
  also have "… = 0∘ ⋅ (0∘)∘"
    using local.inv_contrav by blast
  also have "… =  0∘ ⋅ 0"
    by simp
  also have "… = 0"
    by simp
  finally show ?thesis.
qed

lemma inv_one [simp]: "1∘ = 1"
proof-
  have "1∘ = 1∘ ⋅ (1∘)∘"
    by simp
  also have "… = (1∘ ⋅ 1)∘"
    using local.inv_contrav by presburger
  also have "… = (1∘)∘"
    by simp
  also have "… = 1"
    by simp
  finally show ?thesis.
qed

lemma inv_iso: "x ≤ y ⟹ x∘ ≤ y∘"
  by (metis local.inv_sup local.less_eq_def)

lemma inv_adj: "(x∘ ≤ y) = (x ≤ y∘)"
  using inv_iso by fastforce

end

text ‹Here is an equivalent axiomatisation from Doornbos, Backhouse and van der Woude's paper
on a calculational approach to mathematical induction.›

class involutive_dioid_alt = dioid_one_zero +
  fixes inv_alt :: "'a ⇒ 'a" 
  assumes inv_alt: "(inv_alt x ≤ y) = (x ≤ inv_alt y)"
  and inv_alt_contrav [simp]: "inv_alt (x ⋅ y) = inv_alt y ⋅ inv_alt x"

begin 

lemma inv_alt_invol [simp]: "inv_alt (inv_alt x) = x"
proof-
  have "inv_alt (inv_alt x) ≤ x"
    by (simp add: inv_alt)
  thus ?thesis
    by (meson inv_alt order_antisym)
qed

lemma inv_alt_add: "inv_alt (x + y) = inv_alt x + inv_alt y"
proof-
  {fix z
  have "(inv_alt (x + y) ≤ z) = (x + y ≤ inv_alt z)"
    by (simp add: inv_alt)
  also have "… = (x ≤ inv_alt z ∧ y ≤ inv_alt z)"
    by simp
  also have "… = (inv_alt x ≤ z ∧ inv_alt y ≤ z)"
    by (simp add: inv_alt)
  also have "… = (inv_alt x + inv_alt y ≤ z)"
    by force
  finally have "(inv_alt (x + y) ≤ z) = (inv_alt x + inv_alt y ≤ z)".}
  thus ?thesis
    using order_antisym by blast
qed

sublocale altinv: involutive_dioid _ _ _ _ _ _ inv_alt
  by unfold_locales (simp_all add: inv_alt_add)

end

sublocale involutive_dioid ⊆ altinv: involutive_dioid_alt _ _ _ _ _ _ invol
  by unfold_locales (simp_all add: local.inv_adj) 

class involutive_kleene_algebra = involutive_dioid + kleene_algebra

begin

lemma inv_star: "(x⋆)∘ = (x∘)⋆"
proof (rule order.antisym)
  have "((x∘)⋆)∘ = (1 + (x∘)⋆ ⋅ x∘)∘"
    by simp
  also have "… = 1 + (x∘)∘ ⋅ ((x∘)⋆)∘"
    using local.inv_contrav local.inv_one local.inv_sup by presburger
  finally have "1 + x ⋅ ((x∘)⋆)∘ ≤ ((x∘)⋆)∘"
    by simp
  hence "x⋆ ≤ ((x∘)⋆)∘"
    using local.star_inductl by force
  thus "(x⋆)∘ ≤ (x∘)⋆" 
    by (simp add: local.inv_adj)
next
  have "(x⋆)∘ = (1 + x⋆ ⋅ x)∘"
    by simp
  also have "… = 1 + x∘ ⋅ (x⋆)∘"
    using local.inv_contrav local.inv_one local.inv_sup by presburger
  finally have "1 + x∘ ⋅ (x⋆)∘ ≤ (x⋆)∘"
    by simp
  thus "(x∘)⋆ ≤ (x⋆)∘"
    using local.star_inductl by force
qed

end


subsection ‹Kleene algebra with converse›

text ‹The name "strong Gelfand property" has been borrowed from Palmigiano and Re.›

class dioid_converse = involutive_dioid +
  assumes strong_gelfand: "x ≤ x ⋅ x∘ ⋅ x"

lemma (in dioid_converse) subid_conv: "x ≤ 1 ⟹ x∘ = x"
proof (rule order.antisym)
  assume h: "x ≤ 1"
  have "x ≤ x ⋅ x∘ ⋅ x"
    by (simp add: local.strong_gelfand)
  also have "… ≤ 1 ⋅ x∘ ⋅ 1"
    using h local.mult_isol_var by blast
  also have "… =  x∘"
    by simp
  finally show "x ≤ x∘"
    by simp
  thus "x∘ ≤ x"
    by (simp add: local.inv_adj)
qed

class kleene_algebra_converse = involutive_kleene_algebra + dioid_converse

end