(* Author: Alexander Maletzky *)

section \<open>Computing Gr\"obner Bases by Triangularizing Macaulay Matrices\<close>

theory Groebner_Macaulay
  imports Groebner_Bases.Macaulay_Matrix Groebner_Bases.Groebner_PM Degree_Section Degree_Bound_Utils
begin

text \<open>Relationship between Gr\"obner bases and Macaulay matrices, following
  @{cite "Wiesinger-Widi2015"}.\<close>

subsection \<open>Gr\"obner Bases\<close>

lemma (in gd_term) Macaulay_list_is_GB:
  assumes "is_Groebner_basis G" and "pmdl (set ps) = pmdl G" and "G \<subseteq> phull (set ps)"
  shows "is_Groebner_basis (set (Macaulay_list ps))"
proof (simp only: GB_alt_3_finite[OF finite_set] pmdl_Macaulay_list, intro ballI impI)
  fix f
  assume "f \<in> pmdl (set ps)"
  also from assms(2) have "\<dots> = pmdl G" .
  finally have "f \<in> pmdl G" .
  assume "f \<noteq> 0"
  with assms(1) \<open>f \<in> pmdl G\<close> obtain g where "g \<in> G" and "g \<noteq> 0" and "lt g adds\<^sub>t lt f"
    by (rule GB_adds_lt)
  from assms(3) \<open>g \<in> G\<close> have "g \<in> phull (set ps)" ..
  from this \<open>g \<noteq> 0\<close> obtain g' where "g' \<in> set (Macaulay_list ps)" and "g' \<noteq> 0" and "lt g = lt g'"
    by (rule Macaulay_list_lt)
  show "\<exists>g\<in>set (Macaulay_list ps). g \<noteq> 0 \<and> lt g adds\<^sub>t lt f"
  proof (rule, rule)
    from \<open>lt g adds\<^sub>t lt f\<close> show "lt g' adds\<^sub>t lt f" by (simp only: \<open>lt g = lt g'\<close>)
  qed fact+
qed

subsection \<open>Bounds\<close>

context pm_powerprod
begin

context
  fixes X :: "'x set"
  assumes fin_X: "finite X"
begin

definition deg_shifts :: "nat \<Rightarrow> (('x \<Rightarrow>\<^sub>0 nat) \<Rightarrow>\<^sub>0 'b) list \<Rightarrow> (('x \<Rightarrow>\<^sub>0 nat) \<Rightarrow>\<^sub>0 'b::semiring_1) list"
  where "deg_shifts d fs = concat (map (\<lambda>f. (map (\<lambda>t. punit.monom_mult 1 t f)
                                        (punit.pps_to_list (deg_le_sect X (d - poly_deg f))))) fs)"

lemma set_deg_shifts:
  "set (deg_shifts d fs) = (\<Union>f\<in>set fs. (\<lambda>t. punit.monom_mult 1 t f) ` (deg_le_sect X (d - poly_deg f)))"
proof -
  from fin_X have "finite (deg_le_sect X d0)" for d0 by (rule finite_deg_le_sect)
  thus ?thesis by (simp add: deg_shifts_def punit.set_pps_to_list)
qed

corollary set_deg_shifts_singleton:
  "set (deg_shifts d [f]) = (\<lambda>t. punit.monom_mult 1 t f) ` (deg_le_sect X (d - poly_deg f))"
  by (simp add: set_deg_shifts)

lemma deg_shifts_superset: "set fs \<subseteq> set (deg_shifts d fs)"
proof -
  have "set fs = (\<Union>f\<in>set fs. {punit.monom_mult 1 0 f})" by simp
  also have "\<dots> \<subseteq> set (deg_shifts d fs)" unfolding set_deg_shifts using subset_refl
  proof (rule UN_mono)
    fix f
    assume "f \<in> set fs"
    have "punit.monom_mult 1 0 f \<in> (\<lambda>t. punit.monom_mult 1 t f) ` deg_le_sect X (d - poly_deg f)"
      using zero_in_deg_le_sect by (rule imageI)
    thus "{punit.monom_mult 1 0 f} \<subseteq> (\<lambda>t. punit.monom_mult 1 t f) ` deg_le_sect X (d - poly_deg f)"
      by simp
  qed
  finally show ?thesis .
qed

lemma deg_shifts_mono:
  assumes "set fs \<subseteq> set gs"
  shows "set (deg_shifts d fs) \<subseteq> set (deg_shifts d gs)"
  using assms by (auto simp add: set_deg_shifts)

lemma ideal_deg_shifts [simp]: "ideal (set (deg_shifts d fs)) = ideal (set fs)"
proof
  show "ideal (set (deg_shifts d fs)) \<subseteq> ideal (set fs)"
    by (rule ideal.span_subset_spanI, simp add: set_deg_shifts UN_subset_iff,
        intro ballI image_subsetI) (metis ideal.span_scale times_monomial_left ideal.span_base)
next
  from deg_shifts_superset show "ideal (set fs) \<subseteq> ideal (set (deg_shifts d fs))"
    by (rule ideal.span_mono)
qed

lemma thm_2_3_6:
  assumes "set fs \<subseteq> P[X]" and "is_GB_cofactor_bound (set fs) b"
  shows "punit.is_Groebner_basis (set (punit.Macaulay_list (deg_shifts b fs)))"
proof -
  from assms(2) finite_set assms(1) obtain G where "punit.is_Groebner_basis G"
    and ideal_G: "ideal G = ideal (set fs)" and G_sub: "G \<subseteq> P[X]"
    and 1: "\<And>g. g \<in> G \<Longrightarrow> \<exists>q. g = (\<Sum>f\<in>set fs. q f * f) \<and> (\<forall>f. q f \<in> P[X] \<and> poly_deg (q f * f) \<le> b)"
    by (rule is_GB_cofactor_boundE_finite_Polys) blast
  from this(1) show ?thesis
  proof (rule punit.Macaulay_list_is_GB)
    show "G \<subseteq> phull (set (deg_shifts b fs))" (is "_ \<subseteq> ?H")
    proof
      fix g
      assume "g \<in> G"
      hence "\<exists>q. g = (\<Sum>f\<in>set fs. q f * f) \<and> (\<forall>f. q f \<in> P[X] \<and> poly_deg (q f * f) \<le> b)" by (rule 1)
      then obtain q where g: "g = (\<Sum>f\<in>set fs. q f * f)" and "\<And>f. q f \<in> P[X]"
        and "\<And>f. poly_deg (q f * f) \<le> b" by blast
      show "g \<in> ?H" unfolding g
      proof (rule phull.span_sum)
        fix f
        assume "f \<in> set fs"
        have "1 \<noteq> (0::'a)" by simp
        show "q f * f \<in> ?H"
        proof (cases "f = 0 \<or> q f = 0")
          case True
          thus ?thesis by (auto simp add: phull.span_zero)
        next
          case False
          hence "q f \<noteq> 0" and "f \<noteq> 0" by simp_all
          with \<open>poly_deg (q f * f) \<le> b\<close> have "poly_deg (q f) \<le> b - poly_deg f"
            by (simp add: poly_deg_times)
          with \<open>q f \<in> P[X]\<close> have "keys (q f) \<subseteq> deg_le_sect X (b - poly_deg f)"
            by (rule keys_subset_deg_le_sectI)
          with finite_deg_le_sect[OF fin_X]
          have "q f * f = (\<Sum>t\<in>deg_le_sect X (b - poly_deg f). punit.monom_mult (lookup (q f) t) t f)"
            unfolding punit.mult_scalar_sum_monomials[simplified]
            by (rule sum.mono_neutral_left) (simp add: in_keys_iff)
          also have "\<dots> = (\<Sum>t\<in>deg_le_sect X (b - poly_deg f).
                              (lookup (q f) t) \<cdot> (punit.monom_mult 1 t f))"
            by (simp add: punit.monom_mult_assoc punit.map_scale_eq_monom_mult)
          also have "\<dots> = (\<Sum>t\<in>deg_le_sect X (b - poly_deg f).
                          ((\<lambda>f0. (lookup (q f) (punit.lp f0 - punit.lp f)) \<cdot> f0) \<circ>
                          (\<lambda>t. punit.monom_mult 1 t f)) t)"
            using refl by (rule sum.cong) (simp add: punit.lt_monom_mult[OF \<open>1 \<noteq> 0\<close> \<open>f \<noteq> 0\<close>])
          also have "\<dots> = (\<Sum>f0\<in>set (deg_shifts b [f]). (lookup (q f) (punit.lp f0 - punit.lp f)) \<cdot> f0)"
            unfolding set_deg_shifts_singleton
          proof (intro sum.reindex[symmetric] inj_onI)
            fix s t
            assume "punit.monom_mult 1 s f = punit.monom_mult 1 t f"
            thus "s = t" using \<open>1 \<noteq> 0\<close> \<open>f \<noteq> 0\<close> by (rule punit.monom_mult_inj_2)
          qed
          finally have "q f * f \<in> phull (set (deg_shifts b [f]))"
            by (simp add: phull.sum_in_spanI)
          also have "\<dots> \<subseteq> ?H" by (rule phull.span_mono, rule deg_shifts_mono, simp add: \<open>f \<in> set fs\<close>)
          finally show ?thesis .
        qed
      qed
    qed
  qed (simp add: ideal_G)
qed

lemma thm_2_3_7:
  assumes "set fs \<subseteq> P[X]" and "is_GB_cofactor_bound (set fs) b"
  shows "1 \<in> ideal (set fs) \<longleftrightarrow> 1 \<in> set (punit.Macaulay_list (deg_shifts b fs))" (is "?L \<longleftrightarrow> ?R")
proof
  assume ?L
  let ?G = "set (punit.Macaulay_list (deg_shifts b fs))"
  from assms have "punit.is_Groebner_basis ?G" by (rule thm_2_3_6)
  moreover from \<open>?L\<close> have "1 \<in> ideal ?G" by (simp add: punit.pmdl_Macaulay_list[simplified])
  moreover have "1 \<noteq> (0::_ \<Rightarrow>\<^sub>0 'a)" by simp
  ultimately obtain g where "g \<in> ?G" and "g \<noteq> 0" and "punit.lt g adds punit.lt (1::_ \<Rightarrow>\<^sub>0 'a)"
    by (rule punit.GB_adds_lt[simplified])
  from this(3) have lp_g: "punit.lt g = 0" by (simp add: punit.lt_monomial adds_zero flip: single_one)
  from punit.Macaulay_list_is_monic_set \<open>g \<in> ?G\<close> \<open>g \<noteq> 0\<close> have lc_g: "punit.lc g = 1"
    by (rule punit.is_monic_setD)
  have "g = 1"
  proof (rule poly_mapping_eqI)
    fix t
    show "lookup g t = lookup 1 t"
    proof (cases "t = 0")
      case True
      thus ?thesis using lc_g by (simp add: lookup_one punit.lc_def lp_g)
    next
      case False
      with zero_min[of t] have "\<not> t \<preceq> punit.lt g" by (simp add: lp_g)
      with punit.lt_max_keys have "t \<notin> keys g" by blast
      with False show ?thesis by (simp add: lookup_one in_keys_iff)
    qed
  qed
  with \<open>g \<in> ?G\<close> show "1 \<in> ?G" by simp
next
  assume ?R
  also have "\<dots> \<subseteq> phull (set (punit.Macaulay_list (deg_shifts b fs)))"
    by (rule phull.span_superset)
  also have "\<dots> = phull (set (deg_shifts b fs))" by (fact punit.phull_Macaulay_list)
  also have "\<dots> \<subseteq> ideal (set (deg_shifts b fs))" using punit.phull_subset_module by force
  finally show ?L by simp
qed

end

lemma thm_2_3_6_indets:
  assumes "is_GB_cofactor_bound (set fs) b"
  shows "punit.is_Groebner_basis (set (punit.Macaulay_list (deg_shifts (\<Union>(indets ` (set fs))) b fs)))"
  using _ _ assms
proof (rule thm_2_3_6)
  from finite_set show "finite (\<Union>(indets ` (set fs)))" by (simp add: finite_indets)
next
  show "set fs \<subseteq> P[\<Union>(indets ` (set fs))]" by (auto simp: Polys_alt)
qed

lemma thm_2_3_7_indets:
  assumes "is_GB_cofactor_bound (set fs) b"
  shows "1 \<in> ideal (set fs) \<longleftrightarrow> 1 \<in> set (punit.Macaulay_list (deg_shifts (\<Union>(indets ` (set fs))) b fs))"
  using _ _ assms
proof (rule thm_2_3_7)
  from finite_set show "finite (\<Union>(indets ` (set fs)))" by (simp add: finite_indets)
next
  show "set fs \<subseteq> P[\<Union>(indets ` (set fs))]" by (auto simp: Polys_alt)
qed

end (* pm_powerprod *)

end (* theory *)


section \<open>Checking for Valid Network\<close>
theory NetCheck
imports
  "Lib/Refine_Add_Fofu"
  Network
  Graph_Impl
  DFS_Framework.Reachable_Nodes
begin
text \<open>
  This theory contains code to read a network from an edge list,
  and verify that the network is a valid input for the
  Edmonds Karp Algorithm.
\<close>

(*<*)
  declare [[coercion_delete int]]
  declare [[coercion_delete "real::nat\<Rightarrow>real"]]
(*>*)

  subsection \<open>Graphs as Lists of Edges\<close>
  text \<open>Graphs can be represented as lists of edges, each edge being a triple of
    start node, end node, and capacity. Capacities must be positive, and there
    must not be multiple edges with the same start and end node. \<close>

  type_synonym edge_list = "(node \<times> node \<times> capacity_impl) list"

  definition ln_invar :: "edge_list \<Rightarrow> bool" where
    "ln_invar el \<equiv>
      distinct (map (\<lambda>(u, v, _). (u,v)) el)
    \<and> (\<forall>(u,v,c)\<in>set el. c>0)
    "
  definition ln_\<alpha> :: "edge_list \<Rightarrow> capacity_impl graph" where
    "ln_\<alpha> el \<equiv> \<lambda>(u,v).
      if \<exists>c. (u, v, c) \<in> set el \<and> c \<noteq> 0 then
        SOME c. (u, v, c) \<in> set el \<and> c \<noteq> 0
      else 0"

  definition "ln_rel \<equiv> br ln_\<alpha> ln_invar"

  lemma ln_equivalence: "(el, c') \<in> ln_rel \<longleftrightarrow> ln_invar el \<and> c' = ln_\<alpha> el"
    unfolding ln_rel_def br_def by auto

  definition ln_N :: "(node\<times>node\<times>_) list \<Rightarrow> nat"
    \<comment> \<open>Maximum node number plus one. I.e. the size of an array to be indexed by nodes.\<close>
    where "ln_N el \<equiv> Max ((fst`set el) \<union> ((fst o snd)`set el)) + 1"

  lemma ln_\<alpha>_imp_in_set: "\<lbrakk>ln_\<alpha> el (u,v)\<noteq>(0)\<rbrakk> \<Longrightarrow> (u,v,ln_\<alpha> el (u,v))\<in>set el"
    apply (auto simp: ln_\<alpha>_def split: if_split_asm)
    apply (metis (mono_tags, lifting) someI_ex)
    done

  lemma ln_N_correct: "Graph.V (ln_\<alpha> el) \<subseteq> {0..<ln_N el}"
    apply (clarsimp simp: Graph.V_def Graph.E_def)
    apply (safe dest!: ln_\<alpha>_imp_in_set)
    apply (fastforce simp: ln_N_def less_Suc_eq_le intro: Max_ge)
    apply (force simp: ln_N_def less_Suc_eq_le intro: Max_ge)
    done

  subsection \<open>Pre-Networks\<close>
  text \<open>This data structure is used to convert an edge-list to a network and
    check validity. It maintains additional information, like a adjacency maps. \<close>

  record pre_network =
    pn_c :: "capacity_impl graph"
    pn_V :: "nat set"
    pn_succ :: "nat \<Rightarrow> nat list"
    pn_pred :: "nat \<Rightarrow> nat list"
    pn_adjmap :: "nat \<Rightarrow> nat list"
    pn_s_node :: bool
    pn_t_node :: bool

  fun read :: "edge_list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> pre_network option"
    \<comment> \<open>Read a pre-network from an edge list, and source/sink node numbers.\<close>
  where
    "read [] _ _ = Some \<lparr>
      pn_c = (\<lambda> _. 0),
      pn_V = {},
      pn_succ = (\<lambda> _. []),
      pn_pred = (\<lambda> _. []),
      pn_adjmap = (\<lambda> _. []),
      pn_s_node = False,
      pn_t_node = False
    \<rparr>"
  | "read ((u, v, c) # es) s t = ((case (read es s t) of
      Some x \<Rightarrow>
        (if (pn_c x) (u, v) = 0 \<and> (pn_c x) (v, u) = 0 \<and> c > 0 then
          (if u = v \<or> v = s \<or> u = t then
            None
          else
            Some (x\<lparr>
              pn_c := (pn_c x) ((u, v) := c),
              pn_V := insert u (insert v (pn_V x)),
              pn_succ := (pn_succ x) (u := v # ((pn_succ x) u)),
              pn_pred := (pn_pred x) (v := u # ((pn_pred x) v)),
              pn_adjmap := (pn_adjmap x) (
                u := v # (pn_adjmap x) u,
                v := u # (pn_adjmap x) v),
              pn_s_node := pn_s_node x \<or> u = s,
              pn_t_node := pn_t_node x \<or> v = t
            \<rparr>))
        else
          None)
    | None \<Rightarrow> None))"

  (* TODO: These proofs look overly verbose. *)
  lemma read_correct1: "read es s t = Some \<lparr>pn_c = c, pn_V = V, pn_succ = succ,
    pn_pred = pred , pn_adjmap = adjmap, pn_s_node = s_n, pn_t_node = t_n\<rparr> \<Longrightarrow>
    (es, c) \<in> ln_rel \<and> Graph.V c = V \<and> finite V \<and>
    (s_n \<longrightarrow> s \<in> V) \<and> (t_n \<longrightarrow> t \<in> V) \<and> (\<not>s_n \<longrightarrow> s \<notin> V) \<and> (\<not>t_n \<longrightarrow> t \<notin> V) \<and>
    (\<forall>u v. c (u,v) \<ge> 0) \<and>
    (\<forall>u. c(u, u) = 0) \<and> (\<forall>u. c (u, s) = 0) \<and> (\<forall>u. c (t, u) = 0) \<and>
    (\<forall>u v. c (u, v) \<noteq> 0 \<longrightarrow> c (v, u) = 0) \<and>
    (\<forall>u. set (succ u) = Graph.E c``{u} \<and> distinct (succ u)) \<and>
    (\<forall>u. set (pred u) = (Graph.E c)\<inverse>``{u} \<and> distinct (pred u)) \<and>
    (\<forall>u. set (adjmap u) = Graph.E c``{u} \<union> (Graph.E c)\<inverse>``{u}
      \<and> distinct (adjmap u))"
    proof (induction es arbitrary: c V succ pred adjmap s_n t_n)
      case Nil
        thus ?case
          unfolding Graph.V_def Graph.E_def ln_rel_def br_def
            ln_\<alpha>_def ln_invar_def
          by auto
    next
      case (Cons e es)
        obtain u1 v1 c1 where obt1: "e = (u1, v1, c1)" by (meson prod_cases3)
        obtain x where obt2: "read es s t = Some x"
          using Cons.prems obt1 by (auto split: option.splits)
        have fct0: "(pn_c x) (u1, v1) = 0 \<and> (pn_c x) (v1, u1) = 0 \<and> c1 > 0"
          using Cons.prems obt1 obt2 by (auto split: option.splits if_splits)
        have fct1: "c1 > 0 \<and> u1 \<noteq> v1 \<and> v1 \<noteq> s \<and> u1 \<noteq> t"
          using Cons.prems obt1 obt2 by (auto split: option.splits if_splits)

        obtain c' V' sc' ps' pd' s_n' t_n' where obt3:
          "x = \<lparr>pn_c = c', pn_V = V',
                pn_succ = sc', pn_pred = pd',  pn_adjmap = ps',
                pn_s_node = s_n', pn_t_node = t_n'\<rparr>"
          apply (cases x) by auto
        then have "read es s t = Some \<lparr>pn_c = c', pn_V = V',
          pn_succ = sc', pn_pred = pd',
          pn_adjmap = ps', pn_s_node = s_n', pn_t_node = t_n'\<rparr>"
          using obt2 by blast
        note fct = Cons.IH[OF this]
        have fct2: "s_n = (s_n' \<or> u1 = s)"
          using fct0 fct1 Cons.prems obt1 obt2 obt3 by simp
        have fct3: "t_n = (t_n' \<or> v1 = t)"
          using fct0 fct1 Cons.prems obt1 obt2 obt3 by simp
        have fct4: "c = c' ((u1, v1) := c1)"
          using fct0 fct1 Cons.prems obt1 obt2 obt3 by simp
        have fct5: "V = V' \<union> {u1, v1}"
          using fct0 fct1 Cons.prems obt1 obt2 obt3 by simp
        have fct6: "succ = sc' (u1 := v1 # sc' u1)"
          using fct0 fct1 Cons.prems obt1 obt2 obt3 by simp
        have fct7: "pred = pd' (v1 := u1 # pd' v1)"
          using fct0 fct1 Cons.prems obt1 obt2 obt3 by simp
        have fct8: "adjmap = (ps' (u1 := v1 # ps' u1)) (v1 := u1 # ps' v1)"
          using fct0 fct1 Cons.prems obt1 obt2 obt3 by simp

        {
          have "(es, c') \<in> ln_rel" using fct by blast
          then have "ln_invar es" and "c' = ln_\<alpha> es"
            unfolding ln_rel_def br_def by auto

          have "ln_invar (e # es)"
            proof (rule ccontr)
              assume "\<not> ?thesis"
              have f1: "\<forall>(u, v, c) \<in> set (e # es). c>0"
                using \<open>ln_invar es\<close> fct0 obt1
                unfolding ln_invar_def by auto
              have f2: "distinct (map (\<lambda>(u, v, _). (u,v)) es)"
                using \<open>ln_invar es\<close>
                unfolding ln_invar_def by auto

              have "\<exists>c1'. (u1, v1, c1') \<in> (set es) \<and> c1' \<noteq> 0"
                proof (rule ccontr)
                  assume "\<not> ?thesis"
                  then have "\<forall>c1'. (u1, v1, c1') \<notin> (set es) \<or> c1' = 0" by blast
                  then have "distinct (map (\<lambda>(u, v, _). (u,v)) (e # es))"
                    using obt1 f2 f1 by auto
                  then have "ln_invar (e # es)"
                    unfolding ln_invar_def using f1 by simp
                  thus "False" using \<open>\<not> ln_invar (e # es)\<close> by blast
                qed
              then obtain c1' where "(u1, v1, c1') \<in> (set es) \<and> c1' \<noteq> 0"
                by blast
              then have "c' (u1, v1) = (SOME c. (u1, v1, c) \<in> set es \<and> c \<noteq> 0)"
                using \<open>c' = ln_\<alpha> es\<close> unfolding ln_\<alpha>_def by auto
              then have "c' (u1, v1) \<noteq> 0"
                using \<open>(u1, v1, c1') \<in> (set es) \<and> c1' \<noteq> 0\<close> f1
                by (metis (mono_tags, lifting) tfl_some)
              thus "False" using fct0 obt3 by simp
            qed
          moreover {
            {
              fix a
              have f1: "distinct (map (\<lambda>(u, v, _). (u,v)) (e # es))"
                and f2: "\<forall>u v. (u, v, 0) \<notin> set (e # es)"
                using \<open>ln_invar (e # es)\<close> unfolding ln_invar_def by auto
              have "c a = ln_\<alpha> (e # es) a"
                proof (cases "a = (u1, v1)")
                  case True
                    have "c a = c1" using fct4 True by simp
                    moreover {
                      have "(ln_\<alpha> (e # es)) a
                        = (SOME c. (u1, v1, c) \<in> set (e # es) \<and> c \<noteq> 0)"
                        (is "?L = ?R")
                        unfolding ln_\<alpha>_def using obt1 fct0 True by auto
                      moreover have "?R = c1"
                        proof (rule ccontr)
                          assume "\<not> ?thesis"
                          then obtain c1' where
                            "(u1, v1, c1') \<in> set (e # es) \<and> c1' \<noteq> 0 \<and> c1' \<noteq> c1"
                            using fct0 obt1 by auto
                          then have
                            "\<not>distinct (map (\<lambda>(u, v, _). (u,v)) (e # es))"
                            using obt1
                            by (metis (mono_tags, lifting) Pair_inject
                              distinct_map_eq list.set_intros(1) split_conv)
                          thus "False" using f1 by blast
                        qed
                      ultimately have "?L = c1" by blast
                    }
                    ultimately show ?thesis by simp
                next
                  case False
                    have f1:
                      "\<forall>u1' v1' c1'. u1' \<noteq> u1 \<or> v1' \<noteq> v1
                      \<longrightarrow> ((u1', v1', c1') \<in> set (e # es)
                            \<longleftrightarrow> (u1', v1', c1') \<in> set es)"
                      using obt1 by auto
                    obtain u1' v1' where "a = (u1', v1')" by (cases a)
                    {
                      have "(ln_\<alpha> (e # es)) (u1', v1') = (ln_\<alpha> es) (u1', v1')"
                        proof (cases
                            "\<exists> c1'. (u1', v1', c1') \<in> set (e # es) \<and> c1' \<noteq> 0")
                          case True
                            thus ?thesis unfolding ln_\<alpha>_def
                              using f1 False True \<open>a = (u1', v1')\<close> by auto
                        next
                          case False
                            thus ?thesis unfolding ln_\<alpha>_def by auto
                        qed
                      then have "(ln_\<alpha> (e # es)) a = (ln_\<alpha> es) a"
                        using \<open>a = (u1', v1')\<close> by simp
                    }
                    moreover have "c a = c' a" using False fct4 by simp
                    moreover have "c' a = ln_\<alpha> es a" using \<open>c' = ln_\<alpha> es\<close>
                      by simp
                    ultimately show ?thesis by simp
                qed
            }
            then have "c = ln_\<alpha> (e # es)" by auto
          }
          ultimately have "(e # es, c) \<in> ln_rel" unfolding ln_rel_def br_def
            by simp
        }
        moreover {
          have "Graph.V c = Graph.V c' \<union> {u1, v1}"
            unfolding Graph.V_def Graph.E_def using fct0 fct4 by auto
          moreover have "Graph.V c' = V'" using fct by blast
          ultimately have "Graph.V c = V" using fct5 by auto
        }
        moreover {
          have "finite V'" using fct by blast
          then have "finite V" using fct5 by auto
        }
        moreover {
          assume "s_n"
          then have "s_n' \<or> u1 = s" using fct2 by blast
          then have "s \<in> V"
            proof
              assume "s_n'"
                thus ?thesis using fct fct5 by auto
            next
              assume "u1 = s"
                thus ?thesis using fct5 by simp
            qed
        }
        moreover {
          assume "t_n"
          then have "t_n' \<or> v1 = t" using fct3 by blast
          then have "t \<in> V"
            proof
              assume "t_n'"
                thus ?thesis using fct fct5 by auto
            next
              assume "v1 = t"
                thus ?thesis using fct5 by simp
            qed
        }
        moreover {
          assume "\<not>s_n"
          then have "\<not>s_n' \<and> u1 \<noteq> s" using fct2 by blast
          then have "s \<notin> V" using fct fct5 fct1  by auto
        }
        moreover {
          assume "\<not>t_n"
          then have "\<not>t_n' \<and> v1 \<noteq> t" using fct3 by blast
          then have "t \<notin> V" using fct fct5 fct1  by auto
        }
        moreover have "\<forall>u v. (c (u, v) \<ge> 0)" using fct fct4 fct1 fct0 by auto
        moreover have "\<forall>u. c (u, u) = 0" using fct fct4 fct1 fct0 by auto
        moreover have "\<forall>u. c (u, s) = 0" using fct fct4 fct1 fct0 by auto
        moreover have "\<forall>u. c (t, u) = 0" using fct fct4 fct1 fct0 by auto
        moreover {
          fix a b
          assume "c (a, b) \<noteq> 0"
          then have "a \<noteq> b" using \<open>\<forall>u. c (u, u) = 0\<close> by auto
          have "c (b, a) = 0"
            proof (cases "(a, b) = (u1, v1)")
              case True
                then have "c (b, a) = c' (v1, u1)" using fct4 \<open>a \<noteq> b\<close> by auto
                moreover have "c' (v1, u1) = 0" using fct0 obt3 by auto
                ultimately show ?thesis by simp
            next
              case False
                thus ?thesis
                  proof (cases "(b, a) = (u1, v1)")
                    case True
                      then have "c (a, b) = c' (v1, u1)" using fct4 \<open>a \<noteq> b\<close>
                        by auto
                      moreover have "c' (v1, u1) = 0" using fct0 obt3 by auto
                      ultimately show ?thesis using \<open>c (a, b) \<noteq> 0\<close> by simp
                  next
                    case False
                      then have "c (b, a) = c' (b, a)" using fct4 by auto
                      moreover have "c (a, b) = c' (a, b)"
                        using False \<open>(a, b) \<noteq> (u1, v1)\<close> fct4 by auto
                      ultimately show ?thesis using fct \<open>c (a, b) \<noteq> 0\<close> by auto
                  qed
            qed
        } note n_fct = this
        moreover {
          {
            fix a
            assume "a \<noteq> u1"
            then have "succ a = sc' a" using fct6 by simp
            moreover have "set (sc' a) = Graph.E c' `` {a} \<and> distinct (sc' a)"
              using fct by blast
            ultimately have "set (succ a) = Graph.E c``{a} \<and> distinct (succ a)"
              unfolding Graph.E_def using fct4 \<open>a \<noteq> u1\<close> by auto
          }
          moreover {
            fix a
            assume "a = u1"
            have "set (succ a) = Graph.E c``{a} \<and> distinct (succ a)"
              proof (cases "c' (u1, v1) = 0")
                case True
                  have fct: "set (sc' a) = Graph.E c' `` {a} \<and> distinct (sc' a)"
                    using fct by blast

                  have "succ a = v1 # sc' a" using \<open>a = u1\<close> fct6 True by simp
                  moreover have "Graph.E c = Graph.E c' \<union> {(u1, v1)}"
                    unfolding Graph.E_def using fct4 fct0 by auto
                  moreover have "v1 \<notin> set (sc' a)"
                    proof (rule ccontr)
                      assume "\<not> ?thesis"
                      then have "c' (a, v1) \<noteq> 0"
                        using fct unfolding Graph.E_def by auto
                      thus "False" using True \<open>a = u1\<close> by simp
                    qed
                  ultimately show ?thesis using \<open>a = u1\<close> fct by auto
              next
                case False
                  thus ?thesis using fct0 obt3 by auto
              qed
        }
        ultimately have
          "\<forall>u. set (succ u) = Graph.E c `` {u} \<and> distinct (succ u)"
          by metis
      }
        moreover {
          {
            fix a
            assume "a \<noteq> v1"
            then have "pred a = pd' a" using fct7 by simp
            moreover have
              "set (pd' a) = (Graph.E c')\<inverse> `` {a} \<and> distinct (pd' a)"
              using fct by blast
            ultimately have
              "set (pred a) = (Graph.E c)\<inverse>``{a} \<and> distinct (pred a)"
              unfolding Graph.E_def using fct4 \<open>a \<noteq> v1\<close> by auto
          }
          moreover {
            fix a
            assume "a = v1"
            have "set (pred a) = (Graph.E c)\<inverse>``{a} \<and> distinct (pred a)"
              proof (cases "c' (u1, v1) = 0")
                case True
                  have fct:
                    "set (pd' a) = (Graph.E c')\<inverse> `` {a} \<and> distinct (pd' a)"
                    using fct by blast

                  have "pred a = u1 # pd' a" using \<open>a = v1\<close> fct7 True by simp
                  moreover have "Graph.E c = Graph.E c' \<union> {(u1, v1)}"
                    unfolding Graph.E_def using fct4 fct0 by auto
                  moreover have "u1 \<notin> set (pd' a)"
                    proof (rule ccontr)
                      assume "\<not> ?thesis"
                      then have "c' (u1, a) \<noteq> 0"
                        using fct unfolding Graph.E_def by auto
                      thus "False" using True \<open>a = v1\<close> by simp
                    qed
                  ultimately show ?thesis using \<open>a = v1\<close> fct by auto
              next
                case False
                  thus ?thesis using fct0 obt3 by auto
              qed
        }
        ultimately have
          "\<forall>u. set (pred u) = (Graph.E c)\<inverse>`` {u} \<and> distinct (pred u)"
          by metis
      }
      moreover {
        {
          fix a
          assume "a \<noteq> u1 \<and> a \<noteq> v1"
          then have "adjmap a = ps' a" using fct8 by simp
            moreover have "set (ps' a) =
              Graph.E c'``{a} \<union> (Graph.E c')\<inverse>``{a} \<and> distinct (ps' a)"
              using fct by blast
            ultimately have
              "set (adjmap a) = Graph.E c``{a} \<union> (Graph.E c)\<inverse>``{a}
                \<and> distinct (adjmap a)"
              unfolding Graph.E_def using fct4 \<open>a \<noteq> u1 \<and> a \<noteq> v1\<close> by auto
        }
        moreover {
          fix a
          assume "a = u1 \<or> a = v1"
          then have
            "set (adjmap a) = Graph.E c``{a} \<union> (Graph.E c)\<inverse>``{a}
              \<and> distinct (adjmap a)"
            proof
              assume "a = u1"
              show ?thesis
                proof (cases "c' (u1, v1) = 0 \<and> c' (v1, u1) = 0")
                  case True
                    have fct:
                      "set (ps' a) = Graph.E c' `` {a} \<union> (Graph.E c')\<inverse> `` {a}
                      \<and> distinct (ps' a)"
                      using fct by blast

                    have "adjmap a = v1 # ps' a"
                      using \<open>a = u1\<close> fct8 True by simp
                    moreover have "Graph.E c = Graph.E c' \<union> {(u1, v1)}"
                      unfolding Graph.E_def using fct4 fct0 by auto
                    moreover have "v1 \<notin> set (ps' a)"
                      proof (rule ccontr)
                        assume "\<not> ?thesis"
                        then have "c' (a, v1) \<noteq> 0 \<or> c' (v1, a) \<noteq> 0"
                          using fct unfolding Graph.E_def by auto
                        thus "False" using True \<open>a = u1\<close> by simp
                      qed
                    ultimately show ?thesis using \<open>a = u1\<close> fct by auto
                next
                  case False
                    thus ?thesis using fct0 obt3 by auto
                qed
            next
              assume "a = v1"
              show ?thesis
                proof (cases "c' (u1, v1) = 0 \<and> c' (v1, u1) = 0")
                  case True
                    have fct:
                      "set (ps' a) = Graph.E c' `` {a} \<union> (Graph.E c')\<inverse> `` {a}
                      \<and> distinct (ps' a)"
                      using fct by blast

                    have "adjmap a = u1 # ps' a"
                      using \<open>a = v1\<close> fct8 True by simp
                    moreover have "Graph.E c = Graph.E c' \<union> {(u1, v1)}"
                      unfolding Graph.E_def using fct4 fct0 by auto
                    moreover have "u1 \<notin> set (ps' a)"
                      proof (rule ccontr)
                        assume "\<not> ?thesis"
                        then have "c' (u1, a) \<noteq> 0 \<or> c' (a, u1) \<noteq> 0"
                          using fct unfolding Graph.E_def by auto
                        thus "False" using True \<open>a = v1\<close> by simp
                      qed
                    ultimately show ?thesis using \<open>a = v1\<close> fct by auto
                next
                  case False
                    thus ?thesis using fct0 obt3 by auto
                qed
            qed
        }
        ultimately have
          "\<forall>u. set (adjmap u) = Graph.E c``{u} \<union> (Graph.E c)\<inverse>``{u}
          \<and> distinct (adjmap u)"
          by metis
      }
      ultimately show ?case by simp
    qed

  lemma read_correct2: "read el s t = None \<Longrightarrow> \<not>ln_invar el
    \<or> (\<exists>u v c. (u,v,c) \<in> set el \<and> \<not>(c > 0))
    \<or> (\<exists>u c. (u, u, c) \<in> set el \<and> c \<noteq> 0) \<or>
    (\<exists>u c. (u, s, c) \<in> set el \<and> c \<noteq> 0) \<or> (\<exists>u c. (t, u, c) \<in> set el \<and> c \<noteq> 0) \<or>
    (\<exists>u v c1 c2. (u, v, c1) \<in> set el \<and> (v, u, c2) \<in> set el \<and> c1 \<noteq> 0 \<and> c2 \<noteq> 0)"
    proof (induction el)
      case Nil
        thus ?case by auto
    next
      case (Cons e el)
        thus ?case
          proof (cases "read el s t = None")
            case True
              note Cons.IH[OF this]
              thus ?thesis
                proof
                  assume "\<not>ln_invar el"
                  then have "\<not>distinct (map (\<lambda>(u, v, _). (u,v)) (e # el)) \<or>
                    (\<exists>(u, v, c) \<in> set (e # el). \<not>(c>0))"
                    unfolding ln_invar_def by fastforce
                  thus ?thesis unfolding ln_invar_def by fastforce
                next
                  assume "
                    (\<exists>u v c. (u, v, c) \<in> set (el) \<and> \<not>(c > 0))
                  \<or> (\<exists>u c. (u, u, c) \<in> set el \<and> c \<noteq> 0)
                  \<or> (\<exists>u c. (u, s, c) \<in> set el \<and> c \<noteq> 0)
                  \<or> (\<exists>u c. (t, u, c) \<in> set el \<and> c \<noteq> 0)
                  \<or> (\<exists>u v c1 c2. (u, v, c1) \<in> set el \<and> (v, u, c2) \<in> set el
                      \<and> c1 \<noteq> 0 \<and> c2 \<noteq> 0)"

                  moreover {
                    assume "(\<exists>u v c. (u, v, c) \<in> set el \<and> \<not>(c > 0))"
                    then have "(\<exists>u v c. (u, v, c) \<in> set (e # el) \<and> \<not>(c > 0))"
                      by auto
                  }
                  moreover {
                    assume "(\<exists>u c. (u, u, c) \<in> set el \<and> c \<noteq> 0)"
                    then have "(\<exists>u c. (u, u, c) \<in> set (e # el) \<and> c \<noteq> 0)"
                      by auto
                  }
                  moreover {
                    assume "(\<exists>u c. (u, s, c) \<in> set el \<and> c \<noteq> 0)"
                    then have "(\<exists>u c. (u, s, c) \<in> set (e # el) \<and> c \<noteq> 0)"
                      by auto
                  }
                  moreover {
                    assume "(\<exists>u c. (t, u, c) \<in> set el \<and> c \<noteq> 0)"
                    then have "(\<exists>u c. (t, u, c) \<in> set (e # el) \<and> c \<noteq> 0)"
                      by auto
                  }
                  moreover {
                    assume "(\<exists>u v c1 c2.
                      (u, v, c1) \<in> set el \<and> (v, u, c2) \<in> set el
                        \<and> c1 \<noteq> 0 \<and> c2 \<noteq> 0)"
                    then have "(\<exists>u v c1 c2. (u, v, c1) \<in> set (e # el) \<and>
                      (v, u, c2) \<in> set (e # el) \<and> c1 \<noteq> 0 \<and> c2 \<noteq> 0)"
                      by auto
                  }
                  ultimately show ?thesis by blast
                qed
          next
            case False
            then obtain x where obt1: "read el s t = Some x" by auto
            obtain u1 v1 c1 where obt2: "e = (u1, v1, c1)"
              apply (cases e) by auto
            obtain c' V' sc' pd' ps' s_n' t_n' where obt3: "x =
              \<lparr>
                pn_c = c', pn_V = V', pn_succ = sc',
                pn_pred = pd', pn_adjmap = ps',
                pn_s_node = s_n', pn_t_node = t_n'
              \<rparr>"
              apply (cases x) by auto
            then have "(el, c') \<in> ln_rel" using obt1 read_correct1[of el s t]
              by simp
            then have "c' = ln_\<alpha> el" unfolding ln_rel_def br_def by simp

            have "(c' (u1, v1) \<noteq> 0 \<or> c' (v1, u1) \<noteq> 0 \<or> c1 \<le> 0) \<or>
              (c1 > 0 \<and> (u1 = v1 \<or> v1 = s \<or> u1 = t))"
              using obt1 obt2 obt3 False Cons.prems
                by (auto split:option.splits if_splits)
            moreover {
              assume "c1 \<le> 0"
              then have "\<not> ln_invar (e # el)"
                unfolding ln_invar_def using obt2 by auto
            }
            moreover {
              assume "c1 > 0 \<and> u1 = v1"
              then have "(\<exists>u c. (u, u, c) \<in> set (e # el) \<and> c > 0)"
                using obt2 by auto
            }
            moreover {
              assume "c1 > 0 \<and> v1 = s"
              then have "(\<exists>u c. (u, s, c) \<in> set (e # el) \<and> c > 0)"
                using obt2 by auto
            }
            moreover {
              assume "c1 > 0 \<and> u1 = t"
              then have "(\<exists>u c. (t, u, c) \<in> set (e # el) \<and> c > 0)"
                using obt2 by auto
            }
            moreover {
              assume "c' (u1, v1) \<noteq> 0"
              then have "\<exists>c1'. (u1, v1, c1') \<in> set el"
                using \<open>c' = ln_\<alpha> el\<close> unfolding ln_\<alpha>_def
                by (auto split:if_splits)
              then have "\<not> distinct (map (\<lambda>(u, v, _). (u, v)) (e # el))"
                using obt2 by force
              then have "\<not>ln_invar (e # el)" unfolding ln_invar_def by auto
            }
            moreover {
              assume "c' (v1, u1) \<noteq> 0"
              then have "\<exists>c1'. (v1, u1, c1') \<in> set el \<and> c1' \<noteq> 0"
                using \<open>c' = ln_\<alpha> el\<close> unfolding ln_\<alpha>_def
                by (auto split:if_splits)
              then have "\<not>ln_invar (e # el) \<or> (
                \<exists>u v c1 c2.
                  (u, v, c1) \<in> set (e # el) \<and> (v, u, c2) \<in> set (e # el)
                  \<and> c1 \<noteq> 0 \<and> c2 \<noteq> 0)"
                proof (cases "c1 \<noteq> 0")
                  case True
                    thus ?thesis
                      using \<open>\<exists>c1'. (v1, u1, c1') \<in> set el  \<and> c1' \<noteq> 0\<close> obt2
                      by auto
                next
                  case False
                    then have "\<not>ln_invar (e # el)"
                      unfolding ln_invar_def using obt2 by auto
                    thus ?thesis by blast
                qed
            }
            ultimately show ?thesis by blast
          qed
    qed

  subsection \<open>Implementation of Pre-Networks\<close>

  record 'capacity::linordered_idom pre_network' =
    pn_c' :: "(nat*nat,'capacity) ArrayHashMap.ahm"
    pn_V' :: "nat ahs"
    pn_succ' :: "(nat,nat list) ArrayHashMap.ahm"
    pn_pred' :: "(nat,nat list) ArrayHashMap.ahm"
    pn_adjmap' :: "(nat,nat list) ArrayHashMap.ahm"
    pn_s_node' :: bool
    pn_t_node' :: bool

  definition "pnet_\<alpha> pn' \<equiv> \<lparr>
      pn_c = the_default 0 o (ahm.\<alpha> (pn_c' pn')),
      pn_V = ahs_\<alpha> (pn_V' pn'),
      pn_succ = the_default [] o (ahm.\<alpha> (pn_succ' pn')),
      pn_pred = the_default [] o (ahm.\<alpha> (pn_pred' pn')),
      pn_adjmap = the_default [] o (ahm.\<alpha> (pn_adjmap' pn')),
      pn_s_node = pn_s_node' pn',
      pn_t_node = pn_t_node' pn'
  \<rparr>"

  definition "pnet_rel \<equiv> br pnet_\<alpha> (\<lambda>_. True)"

  definition "ahm_ld a ahm k \<equiv> the_default a (ahm.lookup k ahm)"
  abbreviation "cap_lookup \<equiv> ahm_ld 0"
  abbreviation "succ_lookup \<equiv> ahm_ld []"

  fun read' :: "(nat \<times> nat \<times> 'capacity::linordered_idom) list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow>
    'capacity pre_network' option" where
    "read' [] _ _ = Some \<lparr>
      pn_c' = ahm.empty (),
      pn_V' = ahs.empty (),
      pn_succ' = ahm.empty (),
      pn_pred' = ahm.empty (),
      pn_adjmap' = ahm.empty (),
      pn_s_node' = False,
      pn_t_node' = False
    \<rparr>"
  | "read' ((u, v, c) # es) s t = ((case (read' es s t) of
      Some x \<Rightarrow>
        (if
          cap_lookup (pn_c' x) (u, v) = 0
          \<and> cap_lookup (pn_c' x) (v, u) = 0 \<and> c > 0
         then
          (if u = v \<or> v = s \<or> u = t then
            None
          else
            Some (x\<lparr>
              pn_c' := ahm.update (u, v) c (pn_c' x),
              pn_V' := ahs.ins u (ahs.ins v (pn_V' x)),
              pn_succ' :=
                ahm.update u (v # (succ_lookup (pn_succ' x) u)) (pn_succ' x),
              pn_pred' :=
                ahm.update v (u # (succ_lookup (pn_pred' x) v)) (pn_pred' x),
              pn_adjmap' := ahm.update
                u (v # (succ_lookup (pn_adjmap' x) u)) (ahm.update
                v (u # (succ_lookup (pn_adjmap' x) v))
                (pn_adjmap' x)),
              pn_s_node' := pn_s_node' x \<or> u = s,
              pn_t_node' := pn_t_node' x \<or> v = t
            \<rparr>))
        else
          None)
    | None \<Rightarrow> None))"

  lemma read'_correct: "read el s t = map_option pnet_\<alpha> (read' el s t)"
    apply (induction el s t rule: read.induct)
    by (auto
      simp: pnet_\<alpha>_def o_def ahm.correct ahs.correct ahm_ld_def
      split: option.splits) (* Takes long *)

  lemma read'_correct_alt: "(read' el s t, read el s t) \<in> \<langle>pnet_rel\<rangle>option_rel"
    unfolding pnet_rel_def br_def
    apply (simp add: option_rel_def read'_correct)
    using domIff by force

  export_code read checking SML

  subsection \<open>Usefulness Check\<close>
  text \<open>
    We have to check that every node in the network is useful,
    i.e., lays on a path from source to sink.
    \<close>

  definition "reachable_spec c s \<equiv> RETURN (((Graph.E c)\<^sup>*)``{s}) "
  definition "reaching_spec c t \<equiv> RETURN ((((Graph.E c)\<inverse>)\<^sup>*)``{t})"

  definition "checkNet cc s t \<equiv> do {
    if s = t then
      RETURN None
    else do {
      let rd = read cc s t;
      case rd of
        None \<Rightarrow> RETURN None
      | Some x \<Rightarrow> do {
          if pn_s_node x \<and> pn_t_node x then
            do {
              ASSERT(finite ((Graph.E (pn_c x))\<^sup>* `` {s}));
              ASSERT(finite (((Graph.E (pn_c x))\<inverse>)\<^sup>* `` {t}));
              ASSERT(\<forall>u. set ((pn_succ x) u) = Graph.E (pn_c x) `` {u}
                \<and> distinct ((pn_succ x) u));
              ASSERT(\<forall>u. set ((pn_pred x) u) = (Graph.E (pn_c x))\<inverse> `` {u}
                \<and> distinct ((pn_pred x) u));

              succ_s \<leftarrow> reachable_spec (pn_c x) s;
              pred_t \<leftarrow> reaching_spec (pn_c x) t;
              if (pn_V x) = succ_s \<and> (pn_V x) = pred_t then
                RETURN (Some (pn_c x, pn_adjmap x))
              else
                RETURN None
            }
          else
            RETURN None
        }
      }
    }"

  lemma checkNet_pre_correct1 : "checkNet el s t \<le>
    SPEC (\<lambda> r. r = Some (c, adjmap) \<longrightarrow> (el, c) \<in> ln_rel \<and> Network c s t \<and>
    (\<forall>u. set (adjmap u) = Graph.E c``{u} \<union> (Graph.E c)\<inverse>``{u}
      \<and> distinct (adjmap u)))"
    unfolding checkNet_def reachable_spec_def reaching_spec_def
    apply (refine_vcg)
    apply clarsimp_all
      proof -
        {
          fix x
          assume asm1: "s \<noteq> t"
          assume asm2: "read el s t = Some x"
          assume asm3: "pn_s_node x"
          assume asm4: "pn_t_node x"
          obtain c V sc pd adjmap  where obt: "x =
            \<lparr>
              pn_c = c, pn_V = V,
              pn_succ = sc, pn_pred = pd,  pn_adjmap = adjmap,
              pn_s_node = True, pn_t_node = True
            \<rparr>"
            apply (cases x) using asm3 asm4 by auto
          then have "read el s t = Some \<lparr>
            pn_c = c, pn_V = V, pn_succ = sc, pn_pred = pd,
            pn_adjmap = adjmap, pn_s_node = True, pn_t_node = True\<rparr>"
            using asm2 by simp
          note fct = read_correct1[OF this]

          then have [simp, intro!]: "finite (Graph.V c)" by blast
          have "Graph.E c \<subseteq> (Graph.V c) \<times> (Graph.V c)"
            unfolding Graph.V_def by auto
          from finite_subset[OF this] have "finite (Graph.E (pn_c x))"
            by (simp add: obt)
          then show "finite ((Graph.E (pn_c x))\<^sup>* `` {s})"
            and "finite (((Graph.E (pn_c x))\<inverse>)\<^sup>* `` {t})"
            by (auto simp add: finite_rtrancl_Image)
        }
        {
          fix x
          assume asm1: "s \<noteq> t"
          assume asm2: "read el s t = Some x"
          assume asm3: "finite ((Graph.E (pn_c x))\<^sup>* `` {s})"
          assume asm4: "finite (((Graph.E (pn_c x))\<inverse>)\<^sup>* `` {t})"
          assume asm5: "pn_s_node x"
          assume asm6: "pn_t_node x"
          obtain c V sc pd adjmap  where obt: "x = \<lparr>pn_c = c, pn_V = V,
            pn_succ = sc, pn_pred = pd,  pn_adjmap = adjmap,
            pn_s_node = True, pn_t_node = True\<rparr>"
            apply (cases x) using asm5 asm6 by auto
          then have "read el s t = Some \<lparr>pn_c = c, pn_V = V,
            pn_succ = sc, pn_pred = pd, pn_adjmap = adjmap,
            pn_s_node = True, pn_t_node = True\<rparr>"
            using asm2 by simp
          note fct = read_correct1[OF this]

          have "\<And>u. set ((pn_succ x) u)
            = Graph.E (pn_c x) `` {u} \<and> distinct ((pn_succ x) u)"
            using fct obt by simp
          moreover have "\<And>u. set ((pn_pred x) u) = (Graph.E (pn_c x))\<inverse> `` {u} \<and>
            distinct ((pn_pred x) u)" using fct obt by simp
          ultimately show "\<And>u. set ((pn_succ x) u) = Graph.E (pn_c x) `` {u}"
            and "\<And>u. distinct ((pn_succ x) u)"
            and "\<And>u. set ((pn_pred x) u) = (Graph.E (pn_c x))\<inverse> `` {u}"
            and "\<And>u.  distinct ((pn_pred x) u)"
            by auto
        }
        {
          fix x
          assume asm1: "s \<noteq> t"
          assume asm2: "read el s t = Some x"
          assume asm3: "pn_s_node x"
          assume asm4: "pn_t_node x"
          assume asm5:
            "((Graph.E (pn_c x))\<inverse>)\<^sup>* `` {t} = (Graph.E (pn_c x))\<^sup>* `` {s}"
          assume asm6: "pn_V x = (Graph.E (pn_c x))\<^sup>* `` {s}"
          assume asm7: "c = pn_c x"
          assume asm8: "adjmap = pn_adjmap x"
          obtain V sc pd  where obt: "x = \<lparr>pn_c = c, pn_V = V,
            pn_succ = sc, pn_pred = pd,  pn_adjmap = adjmap,
            pn_s_node = True, pn_t_node = True\<rparr>"
            apply (cases x) using asm3 asm4 asm7 asm8 by auto
          then have "read el s t = Some \<lparr>pn_c = c, pn_V = V,
            pn_succ = sc, pn_pred = pd, pn_adjmap = adjmap,
            pn_s_node = True, pn_t_node = True\<rparr>"
            using asm2 by simp
          note fct = read_correct1[OF this]

          have "\<And>u. set ((pn_succ x) u) = Graph.E (pn_c x) `` {u}
            \<and> distinct ((pn_succ x) u)"
            using fct obt by simp
          moreover have "\<And>u. set ((pn_pred x) u) = (Graph.E (pn_c x))\<inverse> `` {u} \<and>
            distinct ((pn_pred x) u)" using fct obt by simp
          moreover have "(el, pn_c x) \<in> ln_rel" using fct asm7 by simp
          moreover {
            {
              {
                have "Graph.V c \<subseteq> ((Graph.E c))\<^sup>* `` {s}"
                  using asm6 obt fct by simp
                then have "\<forall>v\<in>(Graph.V c). Graph.isReachable c s v"
                  unfolding Graph.connected_def using Graph.rtc_isPath[of s _ c]
                  by auto
              }
              moreover {
                have "Graph.V c \<subseteq> ((Graph.E c)\<inverse>)\<^sup>* `` {t}"
                  using asm5 asm6 obt fct by simp
                then have "\<forall>v\<in>(Graph.V c). Graph.isReachable c v t"
                  unfolding Graph.connected_def using Graph.rtci_isPath
                  by fastforce
              }
              ultimately have
                "\<forall>v\<in>(Graph.V c). Graph.isReachable c s v
                \<and> Graph.isReachable c v t"
                by simp
            }
            moreover {
              have "finite (Graph.V c)" and "s \<in> (Graph.V c)"
                using fct obt by auto
              note Graph.reachable_ss_V[OF \<open>s \<in> (Graph.V c)\<close>]
              note finite_subset[OF this \<open>finite (Graph.V c)\<close>]
            }
            ultimately have "Network (pn_c x) s t"
              unfolding Network_def using asm1 fct asm7
              by (simp add: Graph.E_def)
          }
          moreover have "\<forall>u.(set (pn_adjmap x u) =
            Graph.E (pn_c x) `` {u} \<union> (Graph.E (pn_c x))\<inverse> `` {u})"
            using fct obt by simp
          moreover have "\<forall>u. distinct (pn_adjmap x u)" using fct obt by simp
          ultimately show "(el, pn_c x) \<in> ln_rel" and "Network (pn_c x) s t" and
            "\<And>u. set (pn_adjmap x u)
              = Graph.E (pn_c x) `` {u} \<union> (Graph.E (pn_c x))\<inverse> `` {u}"
            and "\<And>u. distinct (pn_adjmap x u)" by auto
        }
      qed

  lemma checkNet_pre_correct2_aux:
    assumes asm1: "s \<noteq> t"
    assumes asm2: "read el s t = Some x"
    assumes asm3:
      "\<forall>u. set (pn_succ x u) = Graph.E (pn_c x) `` {u} \<and> distinct (pn_succ x u)"
    assumes asm4: "\<forall>u. set (pn_pred x u) = (Graph.E (pn_c x))\<inverse> `` {u}
      \<and> distinct (pn_pred x u)"
    assumes asm5: "pn_V x = (Graph.E (pn_c x))\<^sup>* `` {s}
      \<longrightarrow> (Graph.E (pn_c x))\<^sup>* `` {s} \<noteq> ((Graph.E (pn_c x))\<inverse>)\<^sup>* `` {t}"
    assumes asm6: "pn_s_node x"
    assumes asm7: "pn_t_node x"
    assumes asm8: "ln_invar el"
    assumes asm9: "Network (ln_\<alpha> el) s t"
    shows "False"
    proof -
      obtain c V sc pd ps  where obt: "x = \<lparr>pn_c = c, pn_V = V,
        pn_succ = sc, pn_pred = pd, pn_adjmap = ps,
        pn_s_node = True, pn_t_node = True\<rparr>"
        apply (cases x) using asm3 asm4 asm6 asm7 by auto
      then have "read el s t = Some \<lparr>pn_c = c, pn_V = V,
        pn_succ = sc, pn_pred = pd, pn_adjmap = ps,
        pn_s_node = True, pn_t_node = True\<rparr>"
        using asm2 by simp
      note fct = read_correct1[OF this]

      have "pn_V x \<noteq> (Graph.E (pn_c x))\<^sup>* `` {s}
        \<or> (pn_V x = (Graph.E (pn_c x))\<^sup>* `` {s}
            \<and> ((Graph.E (pn_c x))\<inverse>)\<^sup>* `` {t} \<noteq> (Graph.E (pn_c x))\<^sup>* `` {s})"
        using asm5 by blast
      thus "False"
        proof
          assume "pn_V x = (Graph.E (pn_c x))\<^sup>* `` {s} \<and>
            ((Graph.E (pn_c x))\<inverse>)\<^sup>* `` {t} \<noteq> (Graph.E (pn_c x))\<^sup>* `` {s}"
          then have "\<not>(Graph.V c \<subseteq> ((Graph.E c)\<inverse>)\<^sup>* `` {t})
            \<or> \<not>(((Graph.E c)\<inverse>)\<^sup>* `` {t} \<subseteq> Graph.V c)"
            using asm5  obt fct by simp
          then have "\<exists>v\<in>(Graph.V c). \<not>Graph.isReachable c v t"
            proof
              assume "\<not>(((Graph.E c)\<inverse>)\<^sup>* `` {t} \<subseteq> Graph.V c)"
              then obtain x where
                o1: "x \<in> ((Graph.E c)\<inverse>)\<^sup>* `` {t} \<and> x \<notin> Graph.V c"
                by blast
              then have "\<exists>p. Graph.isPath c x p t"
                using Graph.rtci_isPath by auto
              then obtain p where "Graph.isPath c x p t" by blast
              then have "x \<in> Graph.V c"
                proof (cases "p = []")
                  case True
                    then have "x = t"
                      using \<open>Graph.isPath c x p t\<close> Graph.isPath.simps(1)
                      by auto
                    thus ?thesis using fct by auto
                next
                  case False
                    then obtain p1 ps where "p = p1 # ps"
                      by (meson neq_Nil_conv)
                    then have "Graph.isPath c x (p1 # ps) t"
                      using \<open>Graph.isPath c x p t\<close> by auto
                    then have "fst p1 = x \<and> c p1 \<noteq> 0"
                      using Graph.isPath_head[of c x p1 ps t]
                      by (auto simp: Graph.E_def)
                    then have "\<exists>v. c (x, v) \<noteq> 0" by (metis prod.collapse)
                    then have "x \<in> Graph.V c"
                      unfolding Graph.V_def Graph.E_def by auto
                    thus ?thesis by simp
                qed
              thus ?thesis using o1 by auto
            next
              assume "\<not>(Graph.V c \<subseteq> ((Graph.E c)\<inverse>)\<^sup>* `` {t})"
              then obtain x where
                o1: "x \<notin> ((Graph.E c)\<inverse>)\<^sup>* `` {t} \<and> x \<in> Graph.V c"
                by blast
              then have "(x , t) \<notin> (Graph.E c)\<^sup>*"
                by (meson Image_singleton_iff rtrancl_converseI)
              have "\<forall>p. \<not>Graph.isPath c x p t"
                proof (rule ccontr)
                  assume "\<not>?thesis"
                  then obtain p where "Graph.isPath c x p t" by blast
                  thus "False" using Graph.isPath_rtc \<open>(x , t) \<notin> (Graph.E c)\<^sup>*\<close>
                  by auto
                qed
              then have "\<not>Graph.isReachable c x t"
                unfolding Graph.connected_def by auto
              thus ?thesis using o1 by auto
            qed
          moreover {
            have "(el, c) \<in> ln_rel" using fct obt by simp
            then have "c = ln_\<alpha> el" unfolding ln_rel_def br_def by auto
          }
          ultimately have "\<not>Network (ln_\<alpha> el) s t"
            unfolding Network_def by auto
          thus ?thesis using asm9 by blast
        next
          assume "pn_V x \<noteq> (Graph.E (pn_c x))\<^sup>* `` {s}"

          then have "\<not>(Graph.V c \<subseteq> (Graph.E c)\<^sup>* `` {s})
            \<or> \<not>((Graph.E c)\<^sup>* `` {s} \<subseteq> Graph.V c)"
            using asm5  obt fct by simp
          then have "\<exists>v\<in>(Graph.V c). \<not>Graph.isReachable c s v"
            proof
              assume "\<not>((Graph.E c)\<^sup>* `` {s} \<subseteq> Graph.V c)"
              then obtain x where o1:"x \<in> (Graph.E c)\<^sup>* `` {s} \<and> x \<notin> Graph.V c"
                by blast
              then have "\<exists>p. Graph.isPath c s p x"
                using Graph.rtc_isPath by auto
              then obtain p where "Graph.isPath c s p x" by blast
              then have "x \<in> Graph.V c"
                proof (cases "p = []")
                  case True
                    then have "x = s"
                      using \<open>Graph.isPath c s p x\<close>
                      by (auto simp: Graph.isPath.simps(1))
                    thus ?thesis using fct by auto
                next
                  case False
                    then obtain p1 ps where "p = ps @ [p1]"
                      by (metis append_butlast_last_id)
                    then have "Graph.isPath c s (ps @ [p1]) x"
                      using \<open>Graph.isPath c s p x\<close> by auto
                    then have "snd p1 = x \<and> c p1 \<noteq> 0"
                      using Graph.isPath_tail[of c s ps p1 x]
                      by (auto simp: Graph.E_def)
                    then have "\<exists>v. c (v, x) \<noteq> 0" by (metis prod.collapse)
                    then have "x \<in> Graph.V c"
                      unfolding Graph.V_def Graph.E_def by auto
                    thus ?thesis by simp
                qed
              thus ?thesis using o1 by auto
            next
              assume "\<not>(Graph.V c \<subseteq> (Graph.E c)\<^sup>* `` {s})"
              then obtain x where o1: "x \<notin> (Graph.E c)\<^sup>* `` {s} \<and> x \<in> Graph.V c"
                by blast
              then have "(s , x) \<notin> (Graph.E c)\<^sup>*"
                by (meson Image_singleton_iff rtrancl_converseI)
              have "\<forall>p. \<not>Graph.isPath c s p x"
                proof (rule ccontr)
                  assume "\<not>?thesis"
                  then obtain p where "Graph.isPath c s p x" by blast
                  thus "False" using Graph.isPath_rtc \<open>(s, x) \<notin> (Graph.E c)\<^sup>*\<close>
                    by auto
                qed
              then have "\<not>Graph.isReachable c s x"
                unfolding Graph.connected_def by auto
              thus ?thesis using o1 by auto
            qed
          moreover {
            have "(el, c) \<in> ln_rel" using fct obt by simp
            then have "c = ln_\<alpha> el" unfolding ln_rel_def br_def by auto
          }
          ultimately have "\<not>Network (ln_\<alpha> el) s t"
            unfolding Network_def by auto
          thus ?thesis using asm9 by blast
        qed
    qed

  lemma checkNet_pre_correct2:
    "checkNet el s t
    \<le> SPEC (\<lambda>r. r = None \<longrightarrow> \<not>ln_invar el \<or> \<not>Network (ln_\<alpha> el) s t)"
    unfolding checkNet_def reachable_spec_def reaching_spec_def
    apply (refine_vcg)
    apply (clarsimp_all)
    proof -
      {
        assume "s = t" and "ln_invar el" and "Network (ln_\<alpha> el) t t"
        thus "False" using Network_def by auto
      }
      next {
        assume "s \<noteq> t" and "read el s t = None" and "ln_invar el"
          and "Network (ln_\<alpha> el) s t"
        note read_correct2[OF \<open>read el s t = None\<close>]
        thus "False"
          proof
            assume "\<not>ln_invar el"
            thus ?thesis using \<open>ln_invar el\<close> by blast
          next
            assume asm: "
              (\<exists>u v c. (u, v, c) \<in> set el \<and> \<not>(c > 0))
            \<or> (\<exists>u c. (u, u, c) \<in> set el \<and> c\<noteq>0)
            \<or> (\<exists>u c. (u, s, c) \<in> set el \<and> c\<noteq>0)
            \<or> (\<exists>u c. (t, u, c) \<in> set el \<and> c\<noteq>0)
            \<or> (\<exists>u v c1 c2. (u, v, c1) \<in> set el
                \<and> (v, u, c2) \<in> set el \<and> c1\<noteq>0 \<and> c2\<noteq>0)"

            moreover {
              assume A: "(\<exists>u v c. (u, v, c) \<in> set el \<and> \<not>(c>0))"
              then have "\<not>ln_invar el"
                using not_less by (fastforce simp: ln_invar_def)
              with \<open>ln_invar el\<close> have False by simp
            }
            moreover {
              assume "(\<exists>u c. (u, u, c) \<in> set el \<and> c\<noteq>0)"
              then have "\<exists> u. ln_\<alpha> el (u, u) \<noteq> 0"
                unfolding ln_\<alpha>_def apply (auto split:if_splits)
                by (metis (mono_tags, lifting) tfl_some)
              then have "False"
                using \<open>Network (ln_\<alpha> el) s t\<close>
                unfolding Network_def by (auto simp: Graph.E_def)
            }
            moreover {
              assume "(\<exists>u c. (u, s, c) \<in> set el \<and> c\<noteq>0)"
              then have "\<exists> u. ln_\<alpha> el (u, s) \<noteq> 0"
                unfolding ln_\<alpha>_def
                by (clarsimp) (metis (mono_tags, lifting) tfl_some)
              then have "False"
                using \<open>Network (ln_\<alpha> el) s t\<close> unfolding Network_def
                by (auto simp: Graph.E_def)
            }
            moreover {
              assume "(\<exists>u c. (t, u, c) \<in> set el \<and> c\<noteq>0)"
              then have "\<exists> u. ln_\<alpha> el (t, u) \<noteq> 0"
              unfolding ln_\<alpha>_def
                by (clarsimp) (metis (mono_tags, lifting) tfl_some)
              then have "False"
                using \<open>Network (ln_\<alpha> el) s t\<close> unfolding Network_def
                by (auto simp: Graph.E_def)
            }
            moreover {
              assume "(\<exists>u v c1 c2.
                (u, v, c1) \<in> set el \<and> (v, u, c2) \<in> set el \<and> c1\<noteq>0 \<and> c2\<noteq>0)"
              then obtain u v c1 c2 where
                o1: "(u, v, c1) \<in> set el \<and> (v, u, c2) \<in> set el
                    \<and> c1\<noteq>0 \<and> c2\<noteq>0"
                by blast
              then have "ln_\<alpha> el (u, v) \<noteq> 0" unfolding ln_\<alpha>_def
                by (clarsimp) (metis (mono_tags, lifting) tfl_some)
              moreover have "ln_\<alpha> el (v, u) \<noteq> 0" unfolding ln_\<alpha>_def using o1
                by (clarsimp) (metis (mono_tags, lifting) tfl_some)
              ultimately have
                "\<not> (\<forall>u v. (ln_\<alpha> el) (u, v) \<noteq> 0 \<longrightarrow> (ln_\<alpha> el) (v, u) = 0)"
                by auto
              then have "False"
                using \<open>Network (ln_\<alpha> el) s t\<close> unfolding Network_def
                by (auto simp: Graph.E_def)
            }
            ultimately show ?thesis by force
          qed
      }
      next {
        fix x
        assume asm1: "s \<noteq> t"
        assume asm2: "read el s t = Some x"
        assume asm3: "pn_s_node x"
        assume asm4: "pn_t_node x"
        obtain c V sc pd adjmap  where obt: "x = \<lparr>pn_c = c, pn_V = V,
          pn_succ = sc, pn_pred = pd,  pn_adjmap = adjmap,
          pn_s_node = True, pn_t_node = True\<rparr>"
          apply (cases x) using asm3 asm4 by auto
        then have "read el s t = Some \<lparr>pn_c = c, pn_V = V,
          pn_succ = sc, pn_pred = pd, pn_adjmap = adjmap,
          pn_s_node = True, pn_t_node = True\<rparr>"
          using asm2 by simp
        note fct = read_correct1[OF this]

        then have [simp]: "finite (Graph.V c)" by blast
        have "Graph.E c \<subseteq> (Graph.V c) \<times> (Graph.V c)"
          unfolding Graph.V_def by auto
        from finite_subset[OF this] have "finite (Graph.E (pn_c x))"
          by (auto simp: obt)
        then show  "finite ((Graph.E (pn_c x))\<^sup>* `` {s})"
          and "finite (((Graph.E (pn_c x))\<inverse>)\<^sup>* `` {t})"
          by (auto simp add: finite_rtrancl_Image)
      }
      {
        fix x
        assume asm1: "s \<noteq> t"
        assume asm2: "read el s t = Some x"
        assume asm3: "finite ((Graph.E (pn_c x))\<^sup>* `` {s})"
        assume asm4: "finite (((Graph.E (pn_c x))\<inverse>)\<^sup>* `` {t})"
        assume asm5: "pn_s_node x"
        assume asm6: "pn_t_node x"
        obtain c V sc pd adjmap  where obt: "x = \<lparr>pn_c = c, pn_V = V,
          pn_succ = sc, pn_pred = pd, pn_adjmap = adjmap,
          pn_s_node = True, pn_t_node = True\<rparr>"
          apply (cases x) using asm5 asm6 by auto
        then have "read el s t = Some \<lparr>pn_c = c, pn_V = V, pn_succ = sc,
          pn_pred = pd, pn_adjmap = adjmap, pn_s_node = True, pn_t_node = True\<rparr>"
          using asm2 by simp
        note fct = read_correct1[OF this]

        have "\<And>u. set ((pn_succ x) u) = Graph.E (pn_c x) `` {u}
          \<and> distinct ((pn_succ x) u)"
          using fct obt by simp
        moreover have "\<And>u. set ((pn_pred x) u) = (Graph.E (pn_c x))\<inverse> `` {u} \<and>
          distinct ((pn_pred x) u)"
          using fct obt by simp
        ultimately show  "\<And>u. set ((pn_succ x) u) = Graph.E (pn_c x) `` {u}"
          and "\<And>u. distinct ((pn_succ x) u)"
          and "\<And>u. set ((pn_pred x) u) = (Graph.E (pn_c x))\<inverse> `` {u}"
          and "\<And>u.  distinct ((pn_pred x) u)"
          by auto
      }
      next {
        fix x
        assume asm1: "s \<noteq> t"
        assume asm2: "read el s t = Some x"
        assume asm3: "pn_s_node x \<longrightarrow> \<not>pn_t_node x"
        assume asm4: "ln_invar el"
        assume asm5: "Network (ln_\<alpha> el) s t"
        obtain c V sc pd ps s_node t_node where
          obt: "x = \<lparr>pn_c = c, pn_V = V, pn_succ = sc, pn_pred = pd,
          pn_adjmap = ps, pn_s_node = s_node, pn_t_node = t_node\<rparr>"
          by (cases x)
        then have "read el s t = Some \<lparr>pn_c = c, pn_V = V, pn_succ = sc,
          pn_pred = pd, pn_adjmap = ps, pn_s_node = s_node, pn_t_node = t_node\<rparr>"
          using asm2 by simp
        note fct = read_correct1[OF this]

        have "(el, c) \<in> ln_rel" using fct obt by simp
        then have "c = ln_\<alpha> el" unfolding ln_rel_def br_def by auto

        have "\<not>pn_s_node x \<or> \<not>pn_t_node x" using asm3 by auto
        then show "False"
          proof
            assume "\<not>pn_s_node x"
            then have "\<not>s_node" using obt fct by auto
            then have "s \<notin> Graph.V c" using fct by auto
            thus ?thesis using \<open>c = ln_\<alpha> el\<close> asm5 Network_def by auto
          next
            assume "\<not>pn_t_node x"
            then have "\<not>t_node" using obt fct by auto
            then have "t \<notin> Graph.V c" using fct by auto
            thus ?thesis using \<open>c = ln_\<alpha> el\<close> asm5 Network_def by auto
          qed
      }
    qed (blast dest: checkNet_pre_correct2_aux)

  lemma checkNet_correct' : "checkNet el s t \<le> SPEC (\<lambda> r. case r of
      Some (c, adjmap) \<Rightarrow>
        (el, c) \<in> ln_rel \<and> Network c s t
        \<and> (\<forall>u. set (adjmap u) = Graph.E c``{u} \<union> (Graph.E c)\<inverse>``{u}
           \<and> distinct (adjmap u))
    | None \<Rightarrow> \<not>ln_invar el \<or> \<not>Network (ln_\<alpha> el) s t)"
    using checkNet_pre_correct1[of el s t] checkNet_pre_correct2[of el s t]
    by (auto split: option.splits simp: pw_le_iff refine_pw_simps)

  lemma checkNet_correct : "checkNet el s t \<le> SPEC (\<lambda>r. case r of
      Some (c, adjmap) \<Rightarrow> (el, c) \<in> ln_rel \<and> Network c s t
        \<and> Graph.is_adj_map c adjmap
    | None \<Rightarrow> \<not>ln_invar el \<or> \<not>Network (ln_\<alpha> el) s t)"
    using checkNet_pre_correct1[of el s t] checkNet_pre_correct2[of el s t]
    by (auto
        split: option.splits
        simp: Graph.is_adj_map_def pw_le_iff refine_pw_simps)

  subsection \<open>Implementation of Usefulness Check\<close>
  text \<open>We use the DFS framework to implement the usefulness check.
    We have to convert between our graph representation and the CAVA automata
    library's graph representation used by the DFS framework.
    \<close>

  definition "graph_of pn s \<equiv> \<lparr>
    g_V = UNIV,
    g_E = Graph.E (pn_c pn),
    g_V0 = {s}
  \<rparr>"

  definition "rev_graph_of pn s \<equiv> \<lparr>
    g_V = UNIV,
    g_E = (Graph.E (pn_c pn))\<inverse>,
    g_V0 = {s}
  \<rparr>"

  definition "checkNet2 cc s t \<equiv> do {
    if s = t then
      RETURN None
    else do {
      let rd = read cc s t;
      case rd of
        None \<Rightarrow> RETURN None
      | Some x \<Rightarrow> do {
          if pn_s_node x \<and> pn_t_node x then
            do {
              ASSERT(finite ((Graph.E (pn_c x))\<^sup>* `` {s}));
              ASSERT(finite (((Graph.E (pn_c x))\<inverse>)\<^sup>* `` {t}));
              ASSERT(\<forall>u. set ((pn_succ x) u) = Graph.E (pn_c x) `` {u}
                \<and> distinct ((pn_succ x) u));
              ASSERT(\<forall>u. set ((pn_pred x) u) = (Graph.E (pn_c x))\<inverse> `` {u}
                \<and> distinct ((pn_pred x) u));

              let succ_s = (op_reachable (graph_of x s));
              let pred_t = (op_reachable (rev_graph_of x t));
              if (pn_V x) = succ_s \<and> (pn_V x) = pred_t then
                RETURN (Some (pn_c x, pn_adjmap x))
              else
                RETURN None
            }
          else
            RETURN None
        }
      }
    }"

  lemma checkNet2_correct: "checkNet2 c s t \<le> checkNet c s t"
    apply (rule refine_IdD)
    unfolding checkNet_def checkNet2_def graph_of_def rev_graph_of_def
      reachable_spec_def reaching_spec_def
    apply (refine_rcg)
    apply refine_dref_type
    apply auto
    done

  definition "graph_of_impl pn' s \<equiv> \<lparr>
    gi_V = \<lambda>_. True,
    gi_E = succ_lookup (pn_succ' pn'),
    gi_V0 = [s]
  \<rparr>"

  definition "rev_graph_of_impl pn' t \<equiv> \<lparr>
    gi_V = \<lambda>_. True,
    gi_E = succ_lookup (pn_pred' pn'),
    gi_V0 = [t]
  \<rparr>"

  definition "well_formed_pn x \<equiv>
    (\<forall>u. set ((pn_succ x) u) = Graph.E (pn_c x) `` {u}
      \<and> distinct ((pn_succ x) u))"

  definition "rev_well_formed_pn x \<equiv>
    (\<forall>u. set ((pn_pred x) u) = (Graph.E (pn_c x))\<inverse> `` {u}
      \<and> distinct ((pn_pred x) u))"

  lemma id_slg_rel_alt_a: "\<langle>Id\<rangle>slg_rel
    = { (s,E). \<forall>u. distinct (s u) \<and> set (s u) = E``{u} }"
    by (auto simp add: slg_rel_def br_def list_set_rel_def dest: fun_relD)

  lemma graph_of_impl_correct: "well_formed_pn pn \<Longrightarrow> (pn', pn) \<in> pnet_rel \<Longrightarrow>
    (graph_of_impl pn' s, graph_of pn s) \<in> \<langle>unit_rel,Id\<rangle>g_impl_rel_ext"
    unfolding pnet_rel_def graph_of_impl_def graph_of_def
      g_impl_rel_ext_def gen_g_impl_rel_ext_def
    apply (auto simp: fun_set_rel_def br_def list_set_rel_def
        id_slg_rel_alt_a ahm_ld_def)
    apply (auto simp: well_formed_pn_def Graph.E_def
        pnet_\<alpha>_def o_def ahm_correct)
    done

  lemma rev_graph_of_impl_correct:"\<lbrakk>rev_well_formed_pn pn; (pn',pn)\<in>pnet_rel\<rbrakk>
    \<Longrightarrow>
    (rev_graph_of_impl pn' s, rev_graph_of pn s) \<in> \<langle>unit_rel,Id\<rangle>g_impl_rel_ext"
    unfolding pnet_rel_def rev_graph_of_impl_def rev_graph_of_def
      g_impl_rel_ext_def gen_g_impl_rel_ext_def
    apply (auto simp: fun_set_rel_def br_def list_set_rel_def
        id_slg_rel_alt_a ahm_ld_def)
    apply (auto simp: rev_well_formed_pn_def Graph.E_def pnet_\<alpha>_def
        o_def ahm_correct)
    done

  schematic_goal reachable_impl:
    assumes [simp]: "finite ((g_E G)\<^sup>* `` g_V0 G)" "graph G"
    assumes [autoref_rules]: "(Gi,G)\<in>\<langle>unit_rel,nat_rel\<rangle>g_impl_rel_ext"
    shows "RETURN (?c::?'c) \<le> \<Down>?R (RETURN (op_reachable G))"
    by autoref_monadic
  concrete_definition reachable_impl uses reachable_impl
  thm reachable_impl.refine

  context begin
    interpretation autoref_syn .

    schematic_goal sets_eq_impl:
      fixes a b :: "nat set"
      assumes [autoref_rules]: "(ai,a) \<in> \<langle>nat_rel\<rangle>ahs.rel"
      assumes [autoref_rules]: "(bi,b) \<in> \<langle>nat_rel\<rangle>dflt_ahs_rel"
      shows "(?c, (a ::: \<langle>nat_rel\<rangle>ahs.rel) = (b ::: \<langle>nat_rel\<rangle>dflt_ahs_rel ))
        \<in> bool_rel"
      apply (autoref)
      done
    concrete_definition sets_eq_impl uses sets_eq_impl

  end

  definition "net_\<alpha> \<equiv> (\<lambda>(ci, adjmapi) .
    ((the_default 0 o (ahm.\<alpha> ci)), (the_default [] o (ahm.\<alpha> adjmapi))))"

  definition "checkNet3 cc s t \<equiv> do {
    if s = t then
      RETURN None
    else do {
      let rd = read' cc s t;
      case rd of
        None \<Rightarrow> RETURN None
      | Some x \<Rightarrow> do {
          if pn_s_node' x \<and> pn_t_node' x then
            do {
              ASSERT(finite ((Graph.E (pn_c (pnet_\<alpha> x)))\<^sup>* `` {s}));
              ASSERT(finite (((Graph.E (pn_c (pnet_\<alpha> x)))\<inverse>)\<^sup>* `` {t}));
              ASSERT(\<forall>u. set ((pn_succ (pnet_\<alpha> x)) u) =
                Graph.E (pn_c (pnet_\<alpha> x)) `` {u}
                \<and> distinct ((pn_succ (pnet_\<alpha> x)) u));
              ASSERT(\<forall>u. set ((pn_pred (pnet_\<alpha> x)) u) =
                (Graph.E (pn_c (pnet_\<alpha> x)))\<inverse> `` {u}
                \<and> distinct ((pn_pred (pnet_\<alpha> x)) u));

              let succ_s = (reachable_impl (graph_of_impl x s));
              let pred_t = (reachable_impl (rev_graph_of_impl x t));
              if (sets_eq_impl (pn_V' x) succ_s)
                \<and> (sets_eq_impl (pn_V' x) pred_t)
              then
                RETURN (Some (net_\<alpha> (pn_c' x, pn_adjmap' x)))
              else
                RETURN None
            }
          else
            RETURN None
        }
      }
    }"

  lemma aux1: "(x', x) \<in> pnet_rel \<Longrightarrow> (pn_V' x', pn_V x) \<in> br ahs.\<alpha> ahs.invar"
    unfolding pnet_rel_def br_def pnet_\<alpha>_def by auto

  lemma [simp]: "graph (rev_graph_of pn s)"
    apply unfold_locales
    unfolding rev_graph_of_def
    by auto

  context begin
  private lemma sets_eq_impl_correct_aux1:
    assumes A: "(pn', pn) \<in> pnet_rel"
    assumes WF: "well_formed_pn pn"

    assumes F: "finite ((Graph.E (pn_c (pnet_\<alpha> pn')))\<^sup>* `` {s})"
    shows "sets_eq_impl (pn_V' pn') (reachable_impl (graph_of_impl pn' s))
      \<longleftrightarrow> pn_V pn = (g_E (graph_of pn s))\<^sup>* `` g_V0 (graph_of pn s)"
  proof -
    from A have S1i: "(pn_V' pn', pn_V pn) \<in> br ahs.\<alpha> ahs.invar"
      unfolding pnet_rel_def br_def pnet_\<alpha>_def by auto

    note GI = graph_of_impl_correct[OF WF A]
    have G: "graph (graph_of pn s)" by simp

    have F': "finite ((g_E (graph_of pn s))\<^sup>* `` g_V0 (graph_of pn s))"
      using F A by (simp add: graph_of_def pnet_\<alpha>_def pnet_rel_def br_def)

    note S2i = reachable_impl.refine[simplified, OF F' G GI]

    from sets_eq_impl.refine[simplified, OF S1i S2i] show ?thesis .
  qed

  private lemma sets_eq_impl_correct_aux2:
    assumes A: "(pn', pn) \<in> pnet_rel"
    assumes WF: "rev_well_formed_pn pn"

    assumes F: "finite (((Graph.E (pn_c (pnet_\<alpha> pn')))\<inverse>)\<^sup>* `` {s})"
    shows "sets_eq_impl (pn_V' pn') (reachable_impl (rev_graph_of_impl pn' s))
      \<longleftrightarrow> pn_V pn = (g_E (rev_graph_of pn s))\<^sup>* `` g_V0 (rev_graph_of pn s)"
  proof -
    from A have S1i: "(pn_V' pn', pn_V pn) \<in> br ahs.\<alpha> ahs.invar"
      unfolding pnet_rel_def br_def pnet_\<alpha>_def by auto

    note GI = rev_graph_of_impl_correct[OF WF A]
    have G: "graph (rev_graph_of pn s)" by simp

    have F': "finite ((g_E (rev_graph_of pn s))\<^sup>* `` g_V0 (rev_graph_of pn s))"
      using F A by (simp add: rev_graph_of_def pnet_\<alpha>_def pnet_rel_def br_def)

    note S2i = reachable_impl.refine[simplified, OF F' G GI]

    from sets_eq_impl.refine[simplified, OF S1i S2i] show ?thesis .
  qed

  lemma checkNet3_correct: "checkNet3 el s t \<le> checkNet2 el s t"
    unfolding checkNet3_def checkNet2_def
    apply (rule refine_IdD)
    apply (refine_rcg)
    apply clarsimp_all
    apply (rule introR[where R="\<langle>pnet_rel\<rangle>option_rel"])
    apply (simp add: read'_correct_alt; fail)
    apply ((simp add: pnet_rel_def br_def pnet_\<alpha>_def)+) [7]
    apply (subst sets_eq_impl_correct_aux1; assumption?)
    apply (simp add: well_formed_pn_def)

    apply (subst sets_eq_impl_correct_aux2; assumption?)
    apply (simp add: rev_well_formed_pn_def)

    apply simp

    apply (simp add: net_\<alpha>_def o_def pnet_\<alpha>_def pnet_rel_def br_def)
    done

  end

  schematic_goal checkNet4: "RETURN ?c \<le> checkNet3 el s t"
    unfolding checkNet3_def
    by (refine_transfer)
  concrete_definition checkNet4 for el s t uses checkNet4

  lemma checkNet4_correct: "case checkNet4 el s t of
      Some (c, adjmap) \<Rightarrow> (el, c) \<in> ln_rel
        \<and> Network c s t \<and> Graph.is_adj_map c adjmap
    | None \<Rightarrow> \<not>ln_invar el \<or> \<not>Network (ln_\<alpha> el) s t"
  proof -
    note checkNet4.refine
    also note checkNet3_correct
    also note checkNet2_correct
    also note checkNet_correct
    finally show ?thesis by simp
  qed

subsection \<open>Executable Network Checker\<close>

  definition prepareNet :: "edge_list \<Rightarrow> node \<Rightarrow> node
    \<Rightarrow> (capacity_impl graph \<times> (node\<Rightarrow>node list) \<times> nat) option"
    \<comment> \<open>Read an edge list and a source/sink node, and return a network graph,
      an adjacency map, and the maximum node number plus one.
      If the edge list or network is invalid, return \<open>NONE\<close>.\<close>
  where
    "prepareNet el s t \<equiv> do {
      (c,adjmap) \<leftarrow> checkNet4 el s t;
      let N = ln_N el;
      Some (c,adjmap,N)
    }"

  export_code prepareNet checking SML

  theorem prepareNet_correct: "case (prepareNet el s t) of
      Some (c, adjmap,N) \<Rightarrow> (el, c) \<in> ln_rel \<and> Network c s t
        \<and> Graph.is_adj_map c adjmap \<and> Graph.V c \<subseteq> {0..<N}
    | None \<Rightarrow> \<not>ln_invar el \<or> \<not>Network (ln_\<alpha> el) s t"
    using checkNet4_correct[of el s t] ln_N_correct[of el]
    unfolding prepareNet_def
    by (auto split: Option.bind_split simp: ln_rel_def br_def)

end


theory ComputeNumeral
imports ComputeHOL ComputeFloat
begin

(* equality for bit strings *)
lemmas biteq = eq_num_simps

(* x < y for bit strings *)
lemmas bitless = less_num_simps

(* x \<le> y for bit strings *)
lemmas bitle = le_num_simps

(* addition for bit strings *)
lemmas bitadd = add_num_simps

(* multiplication for bit strings *)
lemmas bitmul = mult_num_simps

lemmas bitarith = arith_simps

(* Normalization of nat literals *)
lemmas natnorm = one_eq_Numeral1_nat

fun natfac :: "nat \<Rightarrow> nat"
  where "natfac n = (if n = 0 then 1 else n * (natfac (n - 1)))"

lemmas compute_natarith =
  arith_simps rel_simps
  diff_nat_numeral nat_numeral nat_0 nat_neg_numeral
  numeral_One [symmetric]
  numeral_1_eq_Suc_0 [symmetric]
  Suc_numeral natfac.simps

lemmas number_norm = numeral_One[symmetric]

lemmas compute_numberarith =
  arith_simps rel_simps number_norm

lemmas compute_num_conversions =
  of_nat_numeral of_nat_0
  nat_numeral nat_0 nat_neg_numeral
  of_int_numeral of_int_neg_numeral of_int_0

lemmas zpowerarith = power_numeral_even power_numeral_odd zpower_Pls int_pow_1

(* div, mod *)

lemmas compute_div_mod = div_0 mod_0 div_by_0 mod_by_0 div_by_1 mod_by_1
  one_div_numeral one_mod_numeral minus_one_div_numeral minus_one_mod_numeral
  one_div_minus_numeral one_mod_minus_numeral
  numeral_div_numeral numeral_mod_numeral minus_numeral_div_numeral minus_numeral_mod_numeral
  numeral_div_minus_numeral numeral_mod_minus_numeral
  div_minus_minus mod_minus_minus Divides.adjust_div_eq of_bool_eq one_neq_zero
  numeral_neq_zero neg_equal_0_iff_equal arith_simps arith_special divmod_trivial
  divmod_steps divmod_cancel divmod_step_eq fst_conv snd_conv numeral_One
  case_prod_beta rel_simps Divides.adjust_mod_def div_minus1_right mod_minus1_right
  minus_minus numeral_times_numeral mult_zero_right mult_1_right

(* collecting all the theorems *)

lemma even_0_int: "even (0::int) = True"
  by simp

lemma even_One_int: "even (numeral Num.One :: int) = False"
  by simp

lemma even_Bit0_int: "even (numeral (Num.Bit0 x) :: int) = True"
  by (simp only: even_numeral)

lemma even_Bit1_int: "even (numeral (Num.Bit1 x) :: int) = False"
  by (simp only: odd_numeral)

lemmas compute_even = even_0_int even_One_int even_Bit0_int even_Bit1_int

lemmas compute_numeral = compute_if compute_let compute_pair compute_bool
                         compute_natarith compute_numberarith max_def min_def compute_num_conversions zpowerarith compute_div_mod compute_even

end


theory ShortestPath
imports
  Graph_Theory.Graph_Theory
begin

section \<open>Shortest Path (with non-negative edge costs)\<close>
text\<open>The following theory is used in the verification of a certifying algorithm's checker for shortest path. For more information see \<^cite>\<open>"FrameworkVerificationofCertifyingComputations"\<close>.\<close>

locale basic_sp =
  fin_digraph +
  fixes dist :: "'a \<Rightarrow> ereal"
  fixes c :: "'b \<Rightarrow> real"
  fixes s :: "'a"
  assumes general_source_val: "dist s \<le> 0"
  assumes trian:
    "\<And>e. e \<in> arcs G \<Longrightarrow>
      dist (head G e) \<le> dist (tail G e) + c e"

locale basic_just_sp =
  basic_sp +
  fixes num :: "'a \<Rightarrow> enat"
  assumes just:
    "\<And>v. \<lbrakk>v \<in> verts G; v \<noteq> s; num v \<noteq> \<infinity>\<rbrakk> \<Longrightarrow>
      \<exists> e \<in> arcs G. v = head G e \<and>
        dist v = dist (tail G e) + c e  \<and>
        num v = num (tail G e) + (enat 1)"

locale shortest_path_pos_cost =
  basic_just_sp +
  assumes s_in_G: "s \<in> verts G"
  assumes tail_val: "dist s = 0"
  assumes no_path: "\<And>v. v \<in> verts G \<Longrightarrow> dist v = \<infinity> \<longleftrightarrow> num v = \<infinity>"
  assumes pos_cost: "\<And>e. e \<in> arcs G \<Longrightarrow> 0 \<le> c e"

locale basic_just_sp_pred =
  basic_sp +
  fixes num :: "'a \<Rightarrow> enat"
  fixes pred :: "'a \<Rightarrow> 'b option"
  assumes just:
    "\<And>v. \<lbrakk>v \<in> verts G; v \<noteq> s; num v \<noteq> \<infinity>\<rbrakk> \<Longrightarrow>
      \<exists> e \<in> arcs G.
        e = the (pred v) \<and>
        v = head G e \<and>
        dist v = dist (tail G e) + c e  \<and>
        num v = num (tail G e) + (enat 1)"

sublocale basic_just_sp_pred \<subseteq> basic_just_sp
using basic_just_sp_pred_axioms
unfolding basic_just_sp_pred_def
   basic_just_sp_pred_axioms_def
by unfold_locales (blast)

locale shortest_path_pos_cost_pred =
  basic_just_sp_pred +
  assumes s_in_G: "s \<in> verts G"
  assumes tail_val: "dist s = 0"
  assumes no_path: "\<And>v. v \<in> verts G \<Longrightarrow> dist v = \<infinity> \<longleftrightarrow> num v = \<infinity>"
  assumes pos_cost: "\<And>e. e \<in> arcs G \<Longrightarrow> 0 \<le> c e"

sublocale shortest_path_pos_cost_pred \<subseteq> shortest_path_pos_cost
using shortest_path_pos_cost_pred_axioms
by unfold_locales
   (auto simp: shortest_path_pos_cost_pred_def
   shortest_path_pos_cost_pred_axioms_def)

lemma tail_value_helper:
  assumes "hd p = last p"
  assumes "distinct p"
  assumes "p \<noteq> []"
  shows "p = [hd p]"
  by (metis assms distinct.simps(2) list.sel(1) neq_Nil_conv last_ConsR last_in_set)

lemma (in basic_sp) dist_le_cost:
  fixes v :: 'a
  fixes p :: "'b list"
  assumes "awalk s p v"
  shows "dist v \<le> awalk_cost c p"
  using assms
  proof (induct "length p" arbitrary: p v)
  case 0
    hence "s = v" by auto
    thus ?case using 0(1) general_source_val
      by (metis awalk_cost_Nil length_0_conv zero_ereal_def)
  next
  case (Suc n)
    then obtain p' e where p'e: "p = p' @ [e]"
      by (cases p rule: rev_cases) auto
    then obtain u where ewu: "awalk s p' u \<and> awalk u [e] v"
      using awalk_append_iff Suc(3) by simp
    then have du: "dist u \<le> ereal (awalk_cost c p')"
      using Suc p'e by simp
    from ewu have ust: "u = tail G e" and vta: "v = head G e"
      by auto
    then have "dist v \<le> dist u + c e"
      using ewu du ust trian[where e=e] by force
    with du have "dist v \<le> ereal (awalk_cost c p') + c e"
      by (metis add_right_mono order_trans)
    thus "dist v \<le> awalk_cost c p"
      using awalk_cost_append p'e by simp
  qed

lemma (in fin_digraph) witness_path:
  assumes "\<mu> c s v = ereal r"
  shows "\<exists> p. apath s p v \<and> \<mu> c s v = awalk_cost c p"
proof -
  have sv: "s \<rightarrow>\<^sup>* v"
    using shortest_path_inf[of s v c] assms by fastforce
  {
    fix p assume "awalk s p v"
    then have no_neg_cyc:
    "\<not> (\<exists>w q. awalk w q w \<and> w \<in> set (awalk_verts s p) \<and> awalk_cost c q < 0)"
      using neg_cycle_imp_inf_\<mu> assms by force
  }
  thus ?thesis using no_neg_cyc_reach_imp_path[OF sv] by presburger
qed

lemma (in basic_sp)  dist_le_\<mu>:
  fixes v :: 'a
  assumes "v \<in> verts G"
  shows "dist v \<le> \<mu> c s v"
proof (rule ccontr)
  assume nt: "\<not> ?thesis"
  show False
  proof (cases "\<mu> c s v")
    show "\<And>r. \<mu> c s v = ereal r \<Longrightarrow> False"
    proof -
      fix r assume r_asm: "\<mu> c s v = ereal r"
      hence sv: "s \<rightarrow>\<^sup>* v"
        using shortest_path_inf[where u=s and v=v and f=c] by auto
      obtain p where
        "awalk s p v"
        "\<mu> c s v = awalk_cost c p"
        using witness_path[OF r_asm] unfolding apath_def by force
      thus False using nt dist_le_cost by simp
    qed
  next
    show "\<mu> c s v = \<infinity> \<Longrightarrow> False" using nt by simp
  next
    show "\<mu> c s v = - \<infinity> \<Longrightarrow> False" using dist_le_cost
    proof -
      assume asm: "\<mu> c s v = - \<infinity>"
      let ?C = "(\<lambda>x. ereal (awalk_cost c x)) ` {p. awalk s p v}"
      have "\<exists>x\<in> ?C. x < dist v"
        using nt unfolding \<mu>_def not_le INF_less_iff by simp
      then obtain p where
        "awalk s p v"
        "awalk_cost c p < dist v"
        by force
      thus False using dist_le_cost by force
    qed
  qed
qed

lemma (in basic_just_sp) dist_ge_\<mu>:
  fixes v :: 'a
  assumes "v \<in> verts G"
  assumes "num v \<noteq> \<infinity>"
  assumes "dist v \<noteq> -\<infinity>"
  assumes "\<mu> c s s = ereal 0"
  assumes "dist s = 0"
  assumes "\<And>u. u\<in>verts G \<Longrightarrow> u\<noteq>s \<Longrightarrow>
            num u \<noteq> \<infinity> \<Longrightarrow> num u \<noteq> enat 0"
  shows "dist v \<ge> \<mu> c s v"
proof -
  obtain n where "enat n = num v" using assms(2) by force
  thus ?thesis using assms
  proof(induct n arbitrary: v)
  case 0 thus ?case by (cases "v=s", auto)
  next
  case (Suc n)
    thus ?case
    proof (cases "v=s")
    case False
      obtain e where e_assms:
        "e \<in> arcs G"
        "v = head G e"
        "dist v = dist (tail G e) + ereal (c e)"
        "num v = num (tail G e) + enat 1"
        using just[OF Suc(3) False Suc(4)] by blast
      then have nsinf:"num (tail G e) \<noteq> \<infinity>"
        by (metis Suc(2) enat.simps(3) enat_1 plus_enat_simps(2))
      then have ns:"enat n = num (tail G e)"
        using e_assms(4) Suc(2) by force
      have  ds: "dist (tail G e) = \<mu> c s (tail G e)"
        using Suc(1)[OF ns tail_in_verts[OF e_assms(1)] nsinf]
        Suc(5-8) e_assms(3) dist_le_\<mu>[OF tail_in_verts[OF e_assms(1)]]
        by simp
      have dmuc:"dist v \<ge> \<mu> c s (tail G e) + ereal (c e)"
        using e_assms(3) ds  by auto
      thus ?thesis
      proof (cases "dist v = \<infinity>")
      case False
        have "arc_to_ends G e = (tail G e, v)"
          unfolding arc_to_ends_def
          by (simp add: e_assms(2))
        obtain r where  \<mu>r: "\<mu> c s (tail G e) = ereal r"
           using e_assms(3) Suc(5) ds False
           by (cases "\<mu> c s (tail G e)", auto)
        obtain p where
          "awalk s p (tail G e)" and
          \<mu>s: "\<mu> c s (tail G e) = ereal (awalk_cost c p)"
          using witness_path[OF \<mu>r] unfolding apath_def
          by blast
        then have pe: "awalk s (p @ [e]) v"
          using e_assms(1,2) by (auto simp: awalk_simps)
        hence muc:"\<mu> c s v \<le> \<mu> c s (tail G e) + ereal (c e)"
        using \<mu>s min_cost_le_walk_cost[OF pe] by simp
        thus  "dist v \<ge> \<mu> c s v"  using dmuc by simp
      qed simp
    qed (simp add: Suc(6,7))
  qed
qed

lemma (in shortest_path_pos_cost) num_not0:
  fixes v :: 'a
  assumes "v \<in> verts G"
  assumes "v \<noteq> s"
  assumes "num v \<noteq> \<infinity>"
  shows "num v \<noteq> enat 0"
proof -
  obtain ku where "num v = ku + enat 1"
    using assms just by blast
  thus ?thesis  by (induct ku) auto
qed

lemma (in shortest_path_pos_cost) dist_ne_ninf:
  fixes v :: 'a
  assumes "v \<in> verts G"
  shows "dist v \<noteq> -\<infinity>"
proof (cases "num v = \<infinity>")
case False
  obtain n where "enat n = num v"
    using False by force
  thus ?thesis using assms False
  proof(induct n arbitrary: v)
  case 0 thus ?case
    using num_not0 tail_val by (cases "v=s", auto)
  next
  case (Suc n)
    thus ?case
    proof (cases "v=s")
    case True
      thus ?thesis using tail_val by simp
    next
    case False
      obtain e where e_assms:
        "e \<in> arcs G"
        "dist v = dist (tail G e) + ereal (c e)"
        "num v = num (tail G e) + enat 1"
        using just[OF Suc(3) False Suc(4)] by blast
      then have nsinf:"num (tail G e) \<noteq> \<infinity>"
        by (metis Suc(2) enat.simps(3) enat_1 plus_enat_simps(2))
      then have ns:"enat n = num (tail G e)"
        using e_assms(3) Suc(2) by force
      have "dist (tail G e ) \<noteq> - \<infinity>"
        by (rule Suc(1) [OF ns tail_in_verts[OF e_assms(1)] nsinf])
      thus ?thesis using e_assms(2) by simp
    qed
  qed
next
case True
  thus ?thesis using no_path[OF assms] by simp
qed

theorem (in shortest_path_pos_cost) correct_shortest_path:
  fixes v :: 'a
  assumes "v \<in> verts G"
  shows "dist v = \<mu> c s v"
  using no_path[OF assms(1)] dist_le_\<mu>[OF assms(1)]
    dist_ge_\<mu>[OF assms(1) _ dist_ne_ninf[OF assms(1)]
    tail_value_check[OF s_in_G] tail_val num_not0]
    by fastforce

corollary (in shortest_path_pos_cost_pred) correct_shortest_path_pred:
  fixes v :: 'a
  assumes "v \<in> verts G"
  shows "dist v = \<mu> c s v"
  using correct_shortest_path assms by simp

end