(*  File:       Pass_Module.thy
    Copyright   2021  Karlsruhe Institute of Technology (KIT)
*)
\<^marker>\<open>creator "Karsten Diekhoff, Karlsruhe Institute of Technology (KIT)"\<close>
\<^marker>\<open>contributor "Jonas Kraemer, Karlsruhe Institute of Technology (KIT)"\<close>
\<^marker>\<open>contributor "Michael Kirsten, Karlsruhe Institute of Technology (KIT)"\<close>

section \<open>Pass Module\<close>

theory Pass_Module
  imports "Component_Types/Electoral_Module"
begin

text
\<open>This is a family of electoral modules. For a natural number n and a
lexicon (linear order) r of all alternatives, the according pass module
defers the lexicographically first n alternatives (from A) and rejects
the rest. It is primarily used as counterpart to the drop module in a
parallel composition in order to segment the alternatives into two groups.\<close>

subsection \<open>Definition\<close>

fun pass_module :: "nat \<Rightarrow> 'a Preference_Relation \<Rightarrow> 'a Electoral_Module" where
  "pass_module n r A p =
    ({},
    {a \<in> A. card(above (limit A r) a) > n},
    {a \<in> A. card(above (limit A r) a) \<le> n})"

subsection \<open>Soundness\<close>

theorem pass_mod_sound[simp]:
  assumes order: "linear_order r"
  shows "electoral_module (pass_module n r)"
proof -
  let ?mod = "pass_module n r"
  have
    "\<forall> A p. finite_profile A p \<longrightarrow>
          (\<forall>a \<in> A. a \<in> {x \<in> A. card(above (limit A r) x) > n} \<or>
                   a \<in> {x \<in> A. card(above (limit A r) x) \<le> n})"
    using CollectI not_less
    by metis
  hence
    "\<forall> A p. finite_profile A p \<longrightarrow>
          {a \<in> A. card(above (limit A r) a) > n} \<union>
          {a \<in> A. card(above (limit A r) a) \<le> n} = A"
    by blast
  hence 0:
    "\<forall> A p. finite_profile A p \<longrightarrow> set_equals_partition A (pass_module n r A p)"
    by simp
  have
    "\<forall> A p. finite_profile A p \<longrightarrow>
      (\<forall>a \<in> A. \<not>(a \<in> {x \<in> A. card(above (limit A r) x) > n} \<and>
                 a \<in> {x \<in> A. card(above (limit A r) x) \<le> n}))"
    by auto
  hence
    "\<forall> A p. finite_profile A p \<longrightarrow>
      {a \<in> A. card(above (limit A r) a) > n} \<inter>
      {a \<in> A. card(above (limit A r) a) \<le> n} = {}"
    by blast
  hence 1:
    "\<forall> A p. finite_profile A p \<longrightarrow> disjoint3 (?mod A p)"
    by simp
  from 0 1
  have
    "\<forall> A p. finite_profile A p \<longrightarrow> well_formed A (?mod A p)"
    by simp
  hence
    "\<forall> A p. finite_profile A p \<longrightarrow> well_formed A (?mod A p)"
    by simp
  thus ?thesis
    using electoral_modI
    by metis
qed

subsection \<open>Non-Blocking\<close>

(*The pass module is non-blocking.*)
theorem pass_mod_non_blocking[simp]:
  assumes order: "linear_order r" and
          g0_n:  "n > 0"
        shows "non_blocking (pass_module n r)"
  unfolding non_blocking_def
proof (safe, simp_all)
  show "electoral_module (pass_module n r)"
    using pass_mod_sound order
    by simp
next
  fix
    A :: "'a set" and
    p :: "'a Profile" and
    x :: "'a"
  assume
    fin_A: "finite A" and
    prof_A: "profile A p" and
    card_A:
    "{a \<in> A. n <
      card (above
        {(a, b). (a, b) \<in> r \<and>
          a \<in> A \<and> b \<in> A} a)} = A" and
    x_in_A: "x \<in> A"
  have lin_ord_A:
    "linear_order_on A (limit A r)"
    using limit_presv_lin_ord order top_greatest
    by metis
  have
    "\<exists>a\<in>A. above (limit A r) a = {a} \<and>
      (\<forall>x\<in>A. above (limit A r) x = {x} \<longrightarrow> x = a)"
    using above_one fin_A lin_ord_A x_in_A
    by blast
  hence not_all:
    "{a \<in> A. card(above (limit A r) a) > n} \<noteq> A"
    using One_nat_def Suc_leI assms(2) is_singletonI
          is_singleton_altdef leD mem_Collect_eq
    by (metis (no_types, lifting))
  hence "reject (pass_module n r) A p \<noteq> A"
    by simp
  thus "False"
    using order card_A
    by simp
qed

subsection \<open>Non-Electing\<close>

(*The pass module is non-electing.*)
theorem pass_mod_non_electing[simp]:
  assumes order: "linear_order r"
  shows "non_electing (pass_module n r)"
  by (simp add: non_electing_def order)

subsection \<open>Properties\<close>

(*The pass module is strictly defer-monotone.*)
theorem pass_mod_dl_inv[simp]:
  assumes order: "linear_order r"
  shows "defer_lift_invariance (pass_module n r)"
  by (simp add: order defer_lift_invariance_def)

theorem pass_zero_mod_def_zero[simp]:
  assumes order: "linear_order r"
  shows "defers 0 (pass_module 0 r)"
  unfolding defers_def
proof (safe)
  show "electoral_module (pass_module 0 r)"
    using pass_mod_sound order
    by simp
next
  fix
    A :: "'a set" and
    p :: "'a Profile"
  assume
    card_pos: "0 \<le> card A" and
    finite_A: "finite A" and
    prof_A: "profile A p"
  show
    "card (defer (pass_module 0 r) A p) = 0"
  proof -
    have lin_ord_on_A:
      "linear_order_on A (limit A r)"
      using order limit_presv_lin_ord
      by blast
    have f1: "connex A (limit A r)"
      using lin_ord_imp_connex lin_ord_on_A
      by simp
    obtain aa :: "('a \<Rightarrow> bool) \<Rightarrow> 'a" where
      f2:
      "\<forall>p. (Collect p = {} \<longrightarrow> (\<forall>a. \<not> p a)) \<and>
            (Collect p \<noteq> {} \<longrightarrow> p (aa p))"
      by moura
    have "\<forall>n. \<not> (n::nat) \<le> 0 \<or> n = 0"
      by blast
    hence
      "\<forall>a Aa. \<not> connex Aa (limit A r) \<or> a \<notin> Aa \<or> a \<notin> A \<or>
                  \<not> card (above (limit A r) a) \<le> 0"
      using above_connex above_presv_limit card_eq_0_iff
            equals0D finite_A order rev_finite_subset
      by (metis (no_types))
    hence "{a \<in> A. card(above (limit A r) a) \<le> 0} = {}"
      using f1
      by auto
    hence "card {a \<in> A. card(above (limit A r) a) \<le> 0} = 0"
      using card.empty
      by metis
    thus "card (defer (pass_module 0 r) A p) = 0"
      by simp
  qed
qed

(*
   For any natural number n and any linear order, the according pass module
   defers n alternatives (if there are n alternatives).
   NOTE: The induction proof is still missing. Following are the proofs for
   n=1 and n=2.
*)
theorem pass_one_mod_def_one[simp]:
  assumes order: "linear_order r"
  shows "defers 1 (pass_module 1 r)"
  unfolding defers_def
proof (safe)
  show "electoral_module (pass_module 1 r)"
    using pass_mod_sound order
    by simp
next
  fix
    A :: "'a set" and
    p :: "'a Profile"
  assume
    card_pos: "1 \<le> card A" and
    finite_A: "finite A" and
    prof_A: "profile A p"
  show
    "card (defer (pass_module 1 r) A p) = 1"
  proof -
    have "A \<noteq> {}"
      using card_pos
      by auto
    moreover have lin_ord_on_A:
      "linear_order_on A (limit A r)"
      using order limit_presv_lin_ord
      by blast
    ultimately have winner_exists:
      "\<exists>a\<in>A. above (limit A r) a = {a} \<and>
        (\<forall>x\<in>A. above (limit A r) x = {x} \<longrightarrow> x = a)"
      using finite_A
      by (simp add: above_one)
    then obtain w where w_unique_top:
      "above (limit A r) w = {w} \<and>
        (\<forall>x\<in>A. above (limit A r) x = {x} \<longrightarrow> x = w)"
      using above_one
      by auto
    hence "{a \<in> A. card(above (limit A r) a) \<le> 1} = {w}"
    proof
      assume
        w_top: "above (limit A r) w = {w}" and
        w_unique: "\<forall>x\<in>A. above (limit A r) x = {x} \<longrightarrow> x = w"
      have "card (above (limit A r) w) \<le> 1"
        using w_top
        by auto
      hence "{w} \<subseteq> {a \<in> A. card(above (limit A r) a) \<le> 1}"
        using winner_exists w_unique_top
        by blast
      moreover have
        "{a \<in> A. card(above (limit A r) a) \<le> 1} \<subseteq> {w}"
      proof
        fix
          x :: "'a"
        assume x_in_winner_set:
          "x \<in> {a \<in> A. card (above (limit A r) a) \<le> 1}"
        hence x_in_A: "x \<in> A"
          by auto
        hence connex_limit:
          "connex A (limit A r)"
          using lin_ord_imp_connex lin_ord_on_A
          by simp
        hence "let q = limit A r in x \<preceq>\<^sub>q x"
          using connex_limit above_connex
                pref_imp_in_above x_in_A
          by metis
        hence "(x,x) \<in> limit A r"
          by simp
        hence x_above_x: "x \<in> above (limit A r) x"
          by (simp add: above_def)
        have "above (limit A r) x \<subseteq> A"
          using above_presv_limit order
          by fastforce
        hence above_finite: "finite (above (limit A r) x)"
          by (simp add: finite_A finite_subset)
        have "card (above (limit A r) x) \<le> 1"
          using x_in_winner_set
          by simp
        moreover have
          "card (above (limit A r) x) \<ge> 1"
          using One_nat_def Suc_leI above_finite card_eq_0_iff
                equals0D neq0_conv x_above_x
          by metis
        ultimately have
          "card (above (limit A r) x) = 1"
          by simp
        hence "{x} = above (limit A r) x"
          using is_singletonE is_singleton_altdef singletonD x_above_x
          by metis
        hence "x = w"
          using w_unique
          by (simp add: x_in_A)
        thus "x \<in> {w}"
          by simp
      qed
      ultimately have
        "{w} = {a \<in> A. card (above (limit A r) a) \<le> 1}"
        by auto
      thus ?thesis
        by simp
    qed
    hence "defer (pass_module 1 r) A p = {w}"
      by simp
    thus "card (defer (pass_module 1 r) A p) = 1"
      by simp
  qed
qed

theorem pass_two_mod_def_two:
  assumes order: "linear_order r"
  shows "defers 2 (pass_module 2 r)"
  unfolding defers_def
proof (safe)
  show "electoral_module (pass_module 2 r)"
    using order
    by simp
next
  fix
    A :: "'a set" and
    p :: "'a Profile"
  assume
    min_2_card: "2 \<le> card A" and
    finA: "finite A" and
    profA: "profile A p"
  from min_2_card
  have not_empty_A: "A \<noteq> {}"
    by auto
  moreover have limitA_order:
    "linear_order_on A (limit A r)"
    using limit_presv_lin_ord order
    by auto
  ultimately obtain a where
    a: "above (limit A r) a = {a}"
    using above_one min_2_card finA profA
    by blast
  hence "\<forall>b \<in> A. let q = limit A r in (b \<preceq>\<^sub>q a)"
    using limitA_order pref_imp_in_above empty_iff
          insert_iff insert_subset above_presv_limit
          order connex_def lin_ord_imp_connex
    by metis
  hence a_best: "\<forall>b \<in> A. (b, a) \<in> limit A r"
    by simp
  hence a_above: "\<forall>b \<in> A. a \<in> above (limit A r) b"
    by (simp add: above_def)
  from a have "a \<in> {a \<in> A. card(above (limit A r) a) \<le> 2}"
    using CollectI Suc_leI not_empty_A a_above card_UNIV_bool
          card_eq_0_iff card_insert_disjoint empty_iff finA
          finite.emptyI insert_iff limitA_order above_one
          UNIV_bool nat.simps(3) zero_less_Suc
    by (metis (no_types, lifting))
  hence a_in_defer: "a \<in> defer (pass_module 2 r) A p"
    by simp
  have "finite (A-{a})"
    by (simp add: finA)
  moreover have A_not_only_a: "A-{a} \<noteq> {}"
    using min_2_card Diff_empty Diff_idemp Diff_insert0
          One_nat_def not_empty_A card.insert_remove
          card_eq_0_iff finite.emptyI insert_Diff
          numeral_le_one_iff semiring_norm(69) card.empty
    by metis
  moreover have limitAa_order:
    "linear_order_on (A-{a}) (limit (A-{a}) r)"
    using limit_presv_lin_ord order top_greatest
    by blast
  ultimately obtain b where b: "above (limit (A-{a}) r) b = {b}"
    using above_one
    by metis
  hence "\<forall>c \<in> A-{a}. let q = limit (A-{a}) r in (c \<preceq>\<^sub>q b)"
    using limitAa_order pref_imp_in_above empty_iff insert_iff
          insert_subset above_presv_limit order connex_def
          lin_ord_imp_connex
    by metis
  hence b_in_limit: "\<forall>c \<in> A-{a}. (c, b) \<in> limit (A-{a}) r"
    by simp
  hence b_best: "\<forall>c \<in> A-{a}. (c, b) \<in> limit A r"
    by auto
  hence c_not_above_b: "\<forall>c \<in> A-{a, b}. c \<notin> above (limit A r) b"
    using b Diff_iff Diff_insert2 subset_UNIV above_presv_limit
          insert_subset order limit_presv_above limit_presv_above2
    by metis
  moreover have above_subset: "above (limit A r) b \<subseteq> A"
    using above_presv_limit order
    by metis
  moreover have b_above_b: "b \<in> above (limit A r) b"
    using above_def b b_best above_presv_limit
          mem_Collect_eq order insert_subset
    by metis
  ultimately have above_b_eq_ab: "above (limit A r) b = {a, b}"
    using a_above
    by auto
  hence card_above_b_eq_2: "card (above (limit A r) b) = 2"
    using A_not_only_a b_in_limit
    by auto
  hence b_in_defer: "b \<in> defer (pass_module 2 r) A p"
    using b_above_b above_subset
    by auto
  from b_best have b_above:
    "\<forall>c \<in> A-{a}. b \<in> above (limit A r) c"
    using above_def mem_Collect_eq
    by metis
  have "connex A (limit A r)"
    using limitA_order lin_ord_imp_connex
    by auto
  hence "\<forall>c \<in> A. c \<in> above (limit A r) c"
    by (simp add: above_connex)
  hence "\<forall>c \<in> A-{a, b}. {a, b, c} \<subseteq> above (limit A r) c"
    using a_above b_above
    by auto
  moreover have "\<forall>c \<in> A-{a, b}. card{a, b, c} = 3"
    using DiffE One_nat_def Suc_1 above_b_eq_ab card_above_b_eq_2
          above_subset card_insert_disjoint finA finite_subset
          insert_commute numeral_3_eq_3
    by metis
  ultimately have
    "\<forall>c \<in> A-{a, b}. card (above (limit A r) c) \<ge> 3"
    using card_mono finA finite_subset above_presv_limit order
    by metis
  hence "\<forall>c \<in> A-{a, b}. card (above (limit A r) c) > 2"
    using less_le_trans numeral_less_iff order_refl semiring_norm(79)
    by metis
  hence "\<forall>c \<in> A-{a, b}. c \<notin> defer (pass_module 2 r) A p"
    by (simp add: not_le)
  moreover have "defer (pass_module 2 r) A p \<subseteq> A"
    by auto
  ultimately have "defer (pass_module 2 r) A p \<subseteq> {a, b}"
    by blast
  with a_in_defer b_in_defer have
    "defer (pass_module 2 r) A p = {a, b}"
    by fastforce
  thus "card (defer (pass_module 2 r) A p) = 2"
    using above_b_eq_ab card_above_b_eq_2
    by presburger
qed

end


(* Title:  Shortest_Path.thy
   Author: Lars Noschinski, TU München
*)

theory Shortest_Path imports
  Arc_Walk
  Weighted_Graph
  "HOL-Library.Extended_Real"
begin

section {* Shortest Paths *}

context wf_digraph begin

(*Rename, as we are outside of any local context?*)
definition \<mu> where
  "\<mu> f u v \<equiv> INF p: {p. awalk u p v}. ereal (awalk_cost f p)"

lemma shortest_path_inf:
  assumes "\<not>(u \<rightarrow>\<^sup>* v)"
  shows "\<mu> f u v = \<infinity>"
proof -
  have *: "{p. awalk u p v} = {}"
    using assms by (auto simp: reachable_awalk)
  show "\<mu> f u v = \<infinity>" unfolding \<mu>_def *
    by (simp add: top_ereal_def)
qed

lemma min_cost_le_walk_cost:
  assumes "awalk u p v"
  shows "\<mu> c u v \<le> awalk_cost c p"
  using assms unfolding \<mu>_def by (auto intro: INF_lower2)

lemma pos_cost_pos_awalk_cost:
  assumes "awalk u p v"
  assumes pos_cost: "\<And>e. e \<in> arcs G \<Longrightarrow> c e \<ge> 0"
  shows "awalk_cost c p \<ge> 0"
using assms by (induct p arbitrary: u) (auto simp: awalk_Cons_iff)

fun mk_cycles_path :: "nat
  \<Rightarrow> 'b awalk \<Rightarrow> 'b awalk" where
    "mk_cycles_path 0 c = []"
  | "mk_cycles_path (Suc n) c = c @ (mk_cycles_path n c)"

lemma mk_cycles_path_awalk:
  assumes "awalk u c u"
  shows "awalk u (mk_cycles_path n c) u"
using assms by (induct n) (auto simp: awalk_Nil_iff)

lemma mk_cycles_awalk_cost:
  assumes "awalk u p u"
  shows "awalk_cost c (mk_cycles_path n p) = n * awalk_cost c p"
using assms proof (induct rule: mk_cycles_path.induct)
  case 1 show ?case by simp
next
  case (2 n p)
  have "awalk_cost c (mk_cycles_path (Suc n) p)
      = awalk_cost c (p @ (mk_cycles_path n p))"
    by simp
  also have "\<dots> = awalk_cost c p + real n * awalk_cost c p"
  proof (cases n)
    case 0 then show ?thesis by simp
  next
    case (Suc n') then show ?thesis
      using 2 by simp
  qed
  also have "\<dots> = real (Suc n) * awalk_cost c p"
    by (simp add: algebra_simps)
  finally show ?case .
qed

lemma inf_over_nats:
  fixes a c :: real
  assumes "c < 0"
  shows "(INF (i :: nat). ereal (a + i * c)) = - \<infinity>"
proof (rule INF_eqI)
  fix i :: nat show "- \<infinity> \<le> a + real i * c" by simp
next
  fix y :: ereal
  assume "\<And>(i :: nat). i \<in> UNIV \<Longrightarrow> y \<le> a + real i * c"
  then have l_assm: "\<And>i::nat. y \<le> a + real i * c" by simp

  show "y \<le> - \<infinity>"
  proof (subst ereal_infty_less_eq, rule ereal_bot)
    fix B :: real
    obtain real_x where "a + real_x * c \<le> B" using `c < 0`
      by atomize_elim
         (rule exI[where x="(- abs B -a)/c"], auto simp: field_simps)
    obtain x :: nat where "a + x * c \<le> B"
    proof (atomize_elim, intro exI[where x="nat(ceiling real_x)"] conjI)
      have "real (nat(ceiling real_x)) * c \<le> real_x * c"
        using `c < 0` by (simp add: real_nat_ceiling_ge)
      then show "a + nat(ceiling real_x) * c \<le> B"
        using `a + real_x * c \<le> B` by simp
    qed
    then show "y \<le> ereal B"
    proof -
      have "ereal (a + x * c) \<le> ereal B"
        using `a + x * c \<le> B` by simp
      with l_assm show ?thesis by (rule order_trans)
    qed
  qed
qed

lemma neg_cycle_imp_inf_\<mu>:
  assumes walk_p: "awalk u p v"
  assumes walk_c: "awalk w c w"
  assumes w_in_p: "w \<in> set (awalk_verts u p)"
  assumes "awalk_cost f c < 0"
  shows "\<mu> f u v = -\<infinity>"
proof -
  from w_in_p obtain xs ys where pv_decomp: "awalk_verts u p = xs @ w # ys"
    by (auto simp: in_set_conv_decomp)

  def q \<equiv> "take (length xs) p" and r \<equiv> "drop (length xs) p"
  def ext_p \<equiv> "\<lambda>n. q @ mk_cycles_path n c @ r"

  have ext_p_cost: "\<And>n. awalk_cost f (ext_p n)
      = (awalk_cost f q + awalk_cost f r) + n * awalk_cost f c"
    using `awalk w c w`
    by (auto simp: ext_p_def intro: mk_cycles_awalk_cost)

  from q_def r_def have "awlast u q = w"
    using pv_decomp walk_p by (auto simp: awalk_verts_take_conv elim!: awalkE)
  moreover
  from q_def r_def have "awalk u (q @ r) v"
    using walk_p by simp
  ultimately
  have "awalk u q w" "awalk w r v" "\<And>n. awalk w (mk_cycles_path n c) w"
    using walk_c
    by (auto simp: intro: mk_cycles_path_awalk)
  then have "\<And>n. awalk u (ext_p n) v"
    unfolding ext_p_def by (blast intro: awalk_appendI)
  then have "{ext_p i|i. i \<in> UNIV} \<subseteq> {p. awalk u p v}"
    by auto
  then have "(INF p:{p. awalk u p v}. ereal (awalk_cost f p))
      \<le> (INF p: {ext_p i|i. i \<in> UNIV}. ereal (awalk_cost f p))"
    by (auto intro: INF_superset_mono)
  also have "\<dots> = (INF i: UNIV. ereal (awalk_cost f (ext_p i)))"
    by (rule arg_cong[where f=Inf], auto)
  also have "\<dots> = - \<infinity>" unfolding ext_p_cost
    by (rule inf_over_nats[OF `awalk_cost f c < 0`])
  finally show ?thesis unfolding \<mu>_def by simp
qed

lemma walk_cheaper_path_imp_neg_cyc:
  assumes p_props: "awalk u p v"
  assumes less_path_\<mu>: "awalk_cost f p < (INF p: {p. apath u p v}. ereal (awalk_cost f p))"
  shows "\<exists>w c. awalk w c w \<and> w \<in> set (awalk_verts u p) \<and> awalk_cost f c < 0"
proof -
  def path_\<mu>  \<equiv> "(INF p: {p. apath u p v}. ereal (awalk_cost f p))"
  then have "awalk u p v" and "awalk_cost f p < path_\<mu>"
    using p_props less_path_\<mu> by simp_all
  then show ?thesis
  proof (induct rule: awalk_to_apath_induct)
    case (path p) then have "apath u p v" by (auto simp: apath_def)
    then show ?case using path.prems by (auto simp: path_\<mu>_def dest: not_mem_less_INF)
  next
    case (decomp p q r s)
    then obtain w where p_props: "p = q @ r @ s" "awalk u q w" "awalk w r w" "awalk w s v"
      by (auto elim: awalk_cyc_decompE)
    then have "awalk u (q @ s) v"
      using `awalk u p v` by (auto simp: awalk_appendI)
    then have verts_ss: "set (awalk_verts u (q @ s)) \<subseteq> set (awalk_verts u p)"
      using `awalk u p v` `p = q @ r @ s` by (auto simp: set_awalk_verts)

    show ?case
    proof (cases "ereal (awalk_cost f (q @ s)) < path_\<mu>")
      case True then have "\<exists>w c. awalk w c w \<and> w \<in> set (awalk_verts u (q @ s)) \<and> awalk_cost f c < 0"
        by (rule decomp)
      then show ?thesis using verts_ss by auto
    next
      case False
      note `awalk_cost f p < path_\<mu>`
      also have "path_\<mu> \<le> awalk_cost f (q @ s)"
        using False by simp
      finally have "awalk_cost f r < 0" using `p = q @ r @ s` by simp
      moreover
      have "w \<in> set (awalk_verts u q)" using `awalk u q w` by auto
      then have "w \<in> set (awalk_verts u p)"
        using `awalk u p v` `awalk u q w` `p = q @ r @ s`
        by (auto simp: set_awalk_verts)
      ultimately
      show ?thesis using `awalk w r w` by auto
    qed
  qed
qed

lemma (in fin_digraph) neg_inf_imp_neg_cyc:
  assumes inf_mu: "\<mu> f u v = - \<infinity>"
  shows "\<exists>p. awalk u p v \<and> (\<exists>w c. awalk w c w \<and> w \<in> set (awalk_verts u p) \<and> awalk_cost f c < 0)"
proof -
  def path_\<mu> \<equiv> "INF s:{p. apath u p v}. ereal (awalk_cost f s)"

  have awalks_ne: "{p. awalk u p v} \<noteq> {}"
    using inf_mu unfolding \<mu>_def by safe (simp add: top_ereal_def)
  then have paths_ne: "{p. apath u p v} ~= {}"
    by (auto intro: apath_awalk_to_apath)

  obtain p where "apath u p v" "awalk_cost f p = path_\<mu>"
  proof -
    obtain p where "p \<in> {p. apath u p v}" "awalk_cost f p = path_\<mu>"
    using finite_INF_in[OF apaths_finite paths_ne, of "awalk_cost f"]
      by (auto simp: path_\<mu>_def)
    then show ?thesis using that by auto
  qed
  then have "path_\<mu> \<noteq> -\<infinity>" by auto
  then have "\<mu> f u v < path_\<mu>" using inf_mu by simp
  then obtain pw where p_def: "awalk u pw v" "awalk_cost f pw < path_\<mu>"
    by atomize_elim (auto simp: \<mu>_def INF_less_iff)
  then have "\<exists>w c. awalk w c w \<and> w \<in> set (awalk_verts u pw) \<and> awalk_cost f c < 0"
    by (intro walk_cheaper_path_imp_neg_cyc) (auto simp: path_\<mu>_def)
  with `awalk u pw v` show ?thesis by auto
qed

lemma (in fin_digraph) no_neg_cyc_imp_no_neg_inf:
  assumes no_neg_cyc: "\<And>p. awalk u p v
    \<Longrightarrow> \<not>(\<exists>w c. awalk w c w \<and> w \<in> set (awalk_verts u p) \<and> awalk_cost f c < 0)"
  shows "- \<infinity> < \<mu> f u v"
proof (intro ereal_MInfty_lessI notI)
  assume "\<mu> f u v = - \<infinity>"
  then obtain p where p_props: "awalk u p v"
    and ex_cyc: "\<exists>w c. awalk w c w \<and> w \<in> set (awalk_verts u p) \<and> awalk_cost f c < 0"
    by atomize_elim (rule neg_inf_imp_neg_cyc)
  then show False using no_neg_cyc by blast
qed

lemma \<mu>_reach_conv:
  "\<mu> f u v < \<infinity> \<longleftrightarrow> u \<rightarrow>\<^sup>* v"
proof
  assume "\<mu> f u v < \<infinity>"
  then have "{p. awalk u p v} \<noteq> {}"
    unfolding \<mu>_def by safe (simp add: top_ereal_def)
  then show "u \<rightarrow>\<^sup>* v" by (simp add: reachable_awalk)
next
  assume "u \<rightarrow>\<^sup>* v"
  then obtain p where p_props: "apath u p v"
    by (metis reachable_awalk apath_awalk_to_apath)
  then have "{p} \<subseteq> {p. apath u p v}" by simp
  then have "\<mu> f u v \<le> (INF p: {p}. ereal (awalk_cost f p))"
    unfolding \<mu>_def by (intro INF_superset_mono) (auto simp: apath_def)
  also have "\<dots> < \<infinity>" by (simp add: min_def)
  finally show "\<mu> f u v < \<infinity>" .
qed

lemma awalk_to_path_no_neg_cyc_cost:
  assumes p_props:"awalk u p v"
  assumes no_neg_cyc: "\<not> (\<exists>w c. awalk w c w \<and> w \<in> set (awalk_verts u p) \<and> awalk_cost f c < 0)"
  shows "awalk_cost f (awalk_to_apath p) \<le> awalk_cost f p"
using assms
proof (induct rule: awalk_to_apath_induct)
  case path then show ?case by (auto simp: awalk_to_apath.simps)
next
  case (decomp p q r s)
  from decomp(2,3) have "is_awalk_cyc_decomp p (q,r,s)"
    using awalk_cyc_decomp_has_prop[OF decomp(1)] by auto
  then have decomp_props: "p = q @ r @ s" "\<exists>w. awalk w r w" by auto

  have "awalk_cost f (awalk_to_apath p) = awalk_cost f (awalk_to_apath (q @ s))"
    using decomp by (auto simp: step_awalk_to_apath[of _ p _ q r s])
  also have "\<dots> \<le> awalk_cost f (q @ s)"
  proof -
    have "awalk u (q @ s) v"
      using `awalk u p v` decomp_props by (auto dest!: awalk_ends_eqD)
    then have "set (awalk_verts u (q @ s)) \<subseteq> set (awalk_verts u p)"
      using `awalk u p v` `p = q @ r @ s`
      by (auto simp add: set_awalk_verts)
    then show ?thesis using decomp.prems by (intro decomp.hyps) auto
  qed
  also have "\<dots> \<le> awalk_cost f p"
  proof -
    obtain w where "awalk u q w" "awalk w r w" "awalk w s v"
      using decomp by (auto elim: awalk_cyc_decompE)
    then have "w \<in> set (awalk_verts u q)" by auto
    then have "w \<in> set (awalk_verts u p)"
      using `p = q @ r @ s` `awalk u p v` `awalk u q w`
      by (auto simp add: set_awalk_verts)
    then have "0 \<le> awalk_cost f r" using `awalk w r w`
      using decomp.prems by (auto simp: not_less)
    then show ?thesis using `p = q @ r @ s` by simp
  qed
  finally show ?case .
qed

lemma (in fin_digraph) no_neg_cyc_reach_imp_path:
  assumes reach: "u \<rightarrow>\<^sup>* v"
  assumes no_neg_cyc: "\<And>p. awalk u p v
    \<Longrightarrow> \<not>(\<exists>w c. awalk w c w \<and> w \<in> set (awalk_verts u p) \<and> awalk_cost f c < 0)"
  shows "\<exists>p. apath u p v \<and> \<mu> f u v = awalk_cost f p"
proof -
  def set_walks \<equiv> "{p. awalk u p v}"
  def set_paths \<equiv> "{p. apath u p v}"

  have "set_paths \<noteq> {}"
  proof -
    obtain p where "apath u p v"
      using reach by (metis apath_awalk_to_apath reachable_awalk)
    then show ?thesis unfolding set_paths_def by blast
  qed

  have "\<mu> f u v = (INF p: set_walks. ereal (awalk_cost f p))"
    unfolding \<mu>_def set_walks_def by simp
  also have "\<dots> = (INF p: set_paths. ereal (awalk_cost f p))"
  proof (rule antisym)
    have "awalk_to_apath ` set_walks \<subseteq> set_paths"
      unfolding set_walks_def set_paths_def
      by (intro subsetI) (auto elim: apath_awalk_to_apath)
    then have "(INF p: set_paths. ereal (awalk_cost f p))
      \<le> (INF p: awalk_to_apath ` set_walks. ereal (awalk_cost f p))"
      by (rule INF_superset_mono) simp
    also have "\<dots> = (INF p: set_walks. ereal (awalk_cost f (awalk_to_apath p)))"
      by (auto simp add: comp_def)
    also have "\<dots> \<le> (INF p: set_walks. ereal (awalk_cost f p))"
    proof -
      { fix p assume "p \<in> set_walks"
        then have "awalk u p v" by (auto simp: set_walks_def)
        then have "awalk_cost f (awalk_to_apath p) \<le> awalk_cost f p"
          using no_neg_cyc
          using no_neg_cyc and awalk_to_path_no_neg_cyc_cost
          by auto }
      then show ?thesis by (intro INF_mono) auto
    qed
    finally show
      "(INF p: set_paths. ereal (awalk_cost f p))
      \<le> (INF p: set_walks. ereal (awalk_cost f p))" by simp

    have "set_paths \<subseteq> set_walks"
      unfolding set_paths_def set_walks_def by (auto simp: apath_def)
    then show "(INF p: set_walks. ereal (awalk_cost f p))
      \<le> (INF p: set_paths. ereal (awalk_cost f p))"
      by (rule INF_superset_mono) simp
  qed
  also have "\<dots> \<in> (\<lambda>p. ereal (awalk_cost f p)) ` set_paths"
    using apaths_finite `set_paths \<noteq> {}`
    by (intro finite_INF_in) (auto simp: set_paths_def)
  finally show ?thesis
    by (simp add: set_paths_def image_def)
qed

lemma (in fin_digraph) min_cost_awalk:
  assumes reach: "u \<rightarrow>\<^sup>* v"
  assumes pos_cost: "\<And>e. e \<in> arcs G \<Longrightarrow> c e \<ge> 0"
  shows "\<exists>p. apath u p v \<and> \<mu> c u v = awalk_cost c p"
proof -
  have pc: "\<And>u p v. awalk u p v \<Longrightarrow> 0 \<le> awalk_cost c p"
    using pos_cost_pos_awalk_cost pos_cost by auto

  from reach show ?thesis
    by (rule no_neg_cyc_reach_imp_path) (auto simp: not_less intro: pc)
qed

lemma (in fin_digraph) pos_cost_mu_triangle:
  assumes pos_cost: "\<And>e. e \<in> arcs G \<Longrightarrow> c e \<ge> 0" (* introduce predicate? *)
  assumes e_props: "arc_to_ends G e = (u,v)" "e \<in> arcs G"
  shows "\<mu> c s v \<le> \<mu> c s u + c e"
proof cases
  assume "\<mu> c s u = \<infinity>" then show ?thesis by simp
next
  assume "\<mu> c s u \<noteq> \<infinity>"
  then have "{p. awalk s p u} \<noteq> {}"
    unfolding \<mu>_def by safe (simp add: top_ereal_def)
  then have "s \<rightarrow>\<^sup>* u" by (simp add: reachable_awalk)
  with pos_cost
  obtain p where p_props: "apath s p u"
      and p_cost: "\<mu> c s u = awalk_cost c p"
    by (metis min_cost_awalk)

  have "awalk u [e] v"
    using e_props by (auto simp: arc_to_ends_def awalk_simps)
  with `apath s p u`
  have "awalk s (p @ [e]) v"
    by (auto simp: apath_def awalk_appendI)
  then have "\<mu> c s v \<le> awalk_cost c (p @ [e])"
    by (rule min_cost_le_walk_cost)
  also have "\<dots> \<le> awalk_cost c p + c e" by simp
  also have "\<dots> \<le> \<mu> c s u + c e" using p_cost by simp
  finally show ?thesis .
qed

lemma (in fin_digraph) mu_exact_triangle:
  assumes "v \<noteq> s"
  assumes "s \<rightarrow>\<^sup>* v"
  assumes nonneg_arcs: "\<And>e. e \<in> arcs G \<Longrightarrow> 0 \<le> c e"
  obtains u e where "\<mu> c s v = \<mu> c s u + c e" and "arc e (u,v)"
proof -
  obtain p where p_path: "apath s p v"
    and p_cost: "\<mu> c s v = awalk_cost c p"
    using assms by (metis min_cost_awalk)
  then obtain e p' where p'_props: "p = p' @ [e]" using `v \<noteq> s`
    by (cases p rule: rev_cases) (auto simp: apath_def)
  then obtain u where "awalk s p' u" "awalk u [e] v"
    using `apath s p v` by (auto simp: apath_def)
  then have mu_le: "\<mu> c s v \<le> \<mu> c s u + c e" and arc: "arc e (u,v)"
    using nonneg_arcs by (auto intro!: pos_cost_mu_triangle simp: arc_to_ends_def arc_def)

  have "\<mu> c s u + c e \<le> ereal (awalk_cost c p') + ereal (c e)"
    using `awalk s p' u`
    by (fast intro: add_right_mono min_cost_le_walk_cost)
  also have "\<dots> = awalk_cost c p" using p'_props by simp
  also have "\<dots> = \<mu> c s v" using p_cost by simp
  finally
  have "\<mu> c s v = \<mu> c s u + c e" using mu_le by auto
  then show ?thesis using arc ..
qed

lemma (in fin_digraph) mu_exact_triangle_Ex:
  assumes "v \<noteq> s"
  assumes "s \<rightarrow>\<^sup>* v"
  assumes "\<And>e. e \<in> arcs G \<Longrightarrow> 0 \<le> c e"
  shows "\<exists>u e. \<mu> c s v = \<mu> c s u + c e \<and> arc e (u,v)"
using assms by (metis mu_exact_triangle)

lemma (in fin_digraph) mu_Inf_triangle:
  assumes "v \<noteq> s"
  assumes "\<And>e. e \<in> arcs G \<Longrightarrow> 0 \<le> c e"
  shows "\<mu> c s v = Inf {\<mu> c s u + c e | u e. arc e (u, v)}" (is "_ = Inf ?S")
proof cases
  assume "s \<rightarrow>\<^sup>* v"
  then obtain u e where "\<mu> c s v = \<mu> c s u + c e" "arc e (u,v)"
    using assms by (metis mu_exact_triangle)
  then have "Inf ?S \<le> \<mu> c s v" by (auto intro: Complete_Lattices.Inf_lower)
  also have "\<dots> \<le> Inf ?S" using assms(2)
    by (auto intro!: Complete_Lattices.Inf_greatest pos_cost_mu_triangle
      simp: arc_def arc_to_ends_def)
  finally show ?thesis by simp
next
  assume "\<not>s \<rightarrow>\<^sup>* v"
  then have "\<mu> c s v = \<infinity>" by (metis shortest_path_inf)
  def S \<equiv> "?S"
  show "\<mu> c s v = Inf S"
  proof cases
    assume "S = {}" then show ?thesis unfolding `\<mu> c s v = \<infinity>`
      by (simp add: top_ereal_def)
  next
    assume "S \<noteq> {}"
    { fix x assume "x \<in> S"
      then obtain u e where "arc e (u,v)" and x_val: "x = \<mu> c s u + c e"
        unfolding S_def by auto
      then have "\<not>s \<rightarrow>\<^sup>* u" using `\<not> s \<rightarrow>\<^sup>* v` by (metis reachable_arc_trans)
      then have "\<mu> c s u + c e= \<infinity>" by (simp add: shortest_path_inf)
      then have "x = \<infinity>" using x_val by simp }
    then have "S = {\<infinity>}" using `S \<noteq> {}` by auto
    then show ?thesis using `\<mu> c s v = \<infinity>` by (simp add: min_def)
  qed
qed

end

end


(*<*)
theory T1SintaxisSemanticaIngles
imports Main
begin
(*>*)

text \<open>
  \label{cap4}
\<close>

section \<open> Sintaxis y semántica proposicional \<close>

text \<open>
  \label{sintaxsemanticaP}
  En la lógica proposicional que estudiaremos, las fórmulas se construiran a partir de las
  conectivas  @{text "\<bottom>, \<top>, \<not>, \<and>, \<or>, \<longrightarrow>"}.
  Más precisamente, la sintaxis y semántica de los lenguajes
  proposicionales que consi\-deraremos y su formalización es la siguiente.
  \begin{definicion}
    El \textbf{alfabeto} de un lenguaje proposicional se compone de los
    siguientes símbolos.
    \begin{enumerate}
      \item \textbf{Símbolos lógicos:}
        \begin{itemize}
          \item conectivas: @{text "\<bottom>, \<top>, \<not>, \<and>, \<or>, \<longrightarrow>"}
          \item símbolos de puntuación: '(' , ')'\, , ','
        \end{itemize}
     \item \textbf{Símbolos no lógicos:}
         \begin{itemize}
           \item símbolos proposicionales $P_0, P_1, \dots$
         \end{itemize}
   \end{enumerate}
  \end{definicion}
  Las {\em fórmulas} de un lenguaje proposicional se definen de la
  si\-guiente manera.
   \begin{definicion}
     El conjunto de {\bf{fórmulas}} es el conjunto más pequeño que
      satisface las si\-guientes condiciones:
         \begin{enumerate}
           \item Los símbolos $\bot$ y $\top$ son fórmulas.
           \item Cualquier símbolo proposicional es una fórmula.
           \item Si $F$ es una fórmula, entonces $\neg F$ es
                 una fórmula.
           \item Si $F$ y $G$ son fórmulas, entonces
                  $(F \wedge G), (F \vee G), (F \rightarrow G)$ son fórmulas.
        \end{enumerate}
  \end{definicion}
  Los símbolos proposicionales son llamados {\bf{fórmulas atómicas}}.
  El siguiente tipo de datos define en Isabelle las fórmulas de un
  lenguaje proposicional.
\<close>

datatype 'b formula =
    FF
  | TT
  | atom 'b                 (* ("P_" [1000]) *)
  | Nega "'b formula"                   ("\<not>.(_)" [110] 110)
  | Conju "'b formula" "'b formula"     (infixl "\<and>."  109)
  | Disya "'b formula" "'b formula"     (infixl "\<or>."  108)
  | Implica "'b formula" "'b formula"   (infixl "\<rightarrow>." 100)

text \<open>
  \begin{nota}
    En la representación de las fórmulas se observa que:
    \begin{enumerate}
      \item El tipo de dato genérico $'b$ representa los símbolos
        proposicionales del lenguaje.
      \item para distinguir el lenguaje objeto del metalenguaje, se ha
        puesto un punto al final de las conectivas del lenguaje objeto.
      \item La negación tiene precedencia sobre el condicional.
      \item El condicional asocia por la izquierda.
    \end{enumerate}
 \end{nota}
Con estos convenios, se tiene por ejemplo, el siguiente lema.
\<close>

lemma "(\<not>.\<not>. Atom P \<rightarrow>. Atom Q  \<rightarrow>. Atom R) =
       (((\<not>. (\<not>. Atom P)) \<rightarrow>. Atom Q) \<rightarrow>. Atom R)"
by simp

text \<open>
  En lo que sigue  presentamos la formalización de los conceptos
  semánticos de la lógica proposicional.  Comenzamos formalizando el
  concepto del t_v_evaluation de una fórmula en una interpretación (\ref{t_v_evaluation}),
  para lo que se necesitan los conceptos de t_v_evaluationes de verdad
  (\ref{vverdad}) y de interpretaciones (\ref{interpretacion}).
  \label{semanticap}
  \begin{definicion}\label{vverdad}
    Los \textbf{t_v_evaluationes de verdad} de la lógica proposicional clásica
    son $\V$ (que se interpreta como \textbf{verdadero}) y $\F$ (que se
    interpreta como \textbf{falso}).
  \end{definicion}
  En la formalización se identifica el conjunto de los t_v_evaluationes de verdad
  con el tipo \emph{v-verdad}, el t_v_evaluation $\V$ con la constante
  \emph{Ttrue} y el t_v_evaluation $\F$ con la constante \emph{Ffalse}
  respectivamente.
\<close>

datatype v_truth = Ttrue | Ffalse

text \<open>
  \begin{definicion}\label{interpretacion}
    Una \textbf{interpretación} es una aplicación del conjunto de los
    símbolos proposicionales en el conjunto de los t_v_evaluationes de verdad.
  \end{definicion}
  La representación en Isabelle del concepto de interpretación es una
  función de la forma @{text "I  :: 'b \<Rightarrow>  v_truth"}.
  Ahora se puede definir el t_v_evaluation de una fórmula respecto de una
  interpretación por recursión.
 \begin{definicion}
    El \textbf{t_v_evaluation} de una fórmula proposicional $F$ en una interpretación $I$
    (representado por $I'(F)$) se define por recursión como sigue:
    \begin{itemize}
    \item $I'(P) = I(P)$ si $P$ es un símbolo proposicional
    \item $I'(\neg F) = \begin{cases}
                         \V, & \text{si $I'(F) = \F$}\\
                         \F, & \text{si $I'(F) = \V$}
                        \end{cases}$
    \item $I'(F \wedge G)= \begin{cases}
                            \V, & \text{si $I'(F)=\V$ y $I'(G)=\V$}\\
                            \F, & \text{en caso contrario.}
                           \end{cases}$
    \item $I'(F \vee G)= \begin{cases}
                          \F, & \text{si $I'(F)=\F$ y $I'(G)=\F$}\\
                          \V, & \text{en caso contrario.}
                         \end{cases}$
     \item $I'(F \rightarrow G) = \begin{cases}
                                   \F, & \text{si $I'(F)=\V$ y $I'(G)=\F$}\\
                                   \V, & \text{en caso contrario.}
                                  \end{cases}$
    \end{itemize}
  \end{definicion}
  Para formalizarlo, definimos las funciones de verdad de las conectivas.
\<close>

definition v_negation :: "v_truth \<Rightarrow> v_truth" where
 "v_negation x \<equiv> (if x = Ttrue then Ffalse else Ttrue)"

definition v_conjunction ::  "v_truth \<Rightarrow> v_truth \<Rightarrow> v_truth" where
 "v_conjunction x y \<equiv> (if x = Ffalse then Ffalse else y)"

definition v_disjunction ::  "v_truth \<Rightarrow> v_truth \<Rightarrow> v_truth" where
 "v_disjunction x y \<equiv> (if x = Ttrue then Ttrue else y)"

definition v_implication :: "v_truth \<Rightarrow> v_truth \<Rightarrow> v_truth" where
 "v_implication x y \<equiv> (if x = Ffalse then Ttrue else y)"

text\<open> La formalización del t_v_evaluation de una fórmula es: \<close>

primrec t_v_evaluation :: "('b \<Rightarrow>  v_truth) \<Rightarrow> 'b formula  \<Rightarrow> v_truth"
where
   "t_v_evaluation I FF = Ffalse"
|  "t_v_evaluation I TT = Ttrue"
|  "t_v_evaluation I (atom p) = I p"
|  "t_v_evaluation I (\<not>. F) = (v_negation (t_v_evaluation I F))"
|  "t_v_evaluation I (F \<and>. G) = (v_conjunction (t_v_evaluation I F) (t_v_evaluation I G))"
|  "t_v_evaluation I (F \<or>. G) = (v_disjunction (t_v_evaluation I F) (t_v_evaluation I G))"
|  "t_v_evaluation I (F \<rightarrow>. G) = (v_implication (t_v_evaluation I F) (t_v_evaluation I G))"

text \<open>
  En algunas demostraciones en las que se utiliza la noción de t_v_evaluation de
  verdad de una fórmula, en lugar de la definición se suele usar algunas
  de la propiedades que presentamos a continuación.
  \begin{lema}
    Sea $F$ un fórmula e $I$ una interpretación. Entonces, $I'(F)=\V$ ó
    $I'(F)=\F$.
  \end{lema}
  \noindent Su formalización es:
\<close>

lemma CasosValor:
shows "t_v_evaluation I F = Ttrue \<or>  t_v_evaluation I F = Ffalse"
(*<*)
proof(cases "t_v_evaluation I F")
  assume "t_v_evaluation I F = Ttrue" thus ?thesis by simp
  next
  assume hip: "t_v_evaluation I F = Ffalse" thus ?thesis by simp
qed
(*>*)

text \<open>
  \begin{lema}
    Sea $F$ una fórmula e $I$ una interpretación. Si $I'(\neg F)=\F$,
    entonces $I'(F)=\V$.
  \end{lema}
  \noindent Su formalización es:
\<close>

lemma NegationValues1:
assumes "t_v_evaluation I (\<not>.F) = Ffalse"
shows "t_v_evaluation I F = Ttrue"
(*<*)
proof -
  { assume "t_v_evaluation I F \<noteq> Ttrue"
    hence "t_v_evaluation I F = Ffalse"  using CasosValor by auto
    hence "t_v_evaluation I (\<not>.F) = Ttrue" by(simp add:v_negation_def)
    hence "False"
      using assms by auto}
  thus "t_v_evaluation I F = Ttrue" by auto
qed
(*>*)

text \<open>
  \begin{lema}
    Sea $F$ un fórmula e $I$ una interpretación. Si $I'(\neg F)=\V$,
    entonces $I'(F)=\F$.
  \end{lema}
  \noindent Su formalización es:
\<close>

lemma NegationValues2:
assumes "t_v_evaluation I (\<not>.F) = Ttrue"
shows "t_v_evaluation I F = Ffalse"
(*<*)
proof -
  { assume "t_v_evaluation I F \<noteq> Ffalse"
    hence "t_v_evaluation I F = Ttrue"  using CasosValor by auto
    hence "t_v_evaluation I (\<not>.F) = Ffalse" by(simp add:v_negation_def)
    hence "False" using assms by auto}
  thus "t_v_evaluation I F = Ffalse" by auto
qed
(*>*)

lemma  non_Ttrue:
  assumes "t_v_evaluation I F \<noteq>  Ttrue" shows "t_v_evaluation I F = Ffalse"
(*<*)
proof(rule ccontr)
  assume "t_v_evaluation I F \<noteq> Ffalse"
  thus False using assms CasosValor by auto
qed
(*>*)

text \<open>
  \begin{lema}
    Sean $F$ y $G$ fórmulas e $I$ una interpretación. Si
    $I'(F\wedge G)=\V$, entonces $I'(F)=\V$ e $I'(G)=\V$
  \end{lema}
  \noindent Su formalización es:
\<close>

lemma ConjunctionValues:
  assumes "t_v_evaluation I (F \<and>. G) = Ttrue"
  shows "t_v_evaluation I F = Ttrue \<and> t_v_evaluation I G = Ttrue"
(*<*)
proof -
 { assume "\<not>(t_v_evaluation I  F = Ttrue \<and> t_v_evaluation I  G = Ttrue)"
   hence "t_v_evaluation I  F \<noteq> Ttrue \<or> t_v_evaluation I G \<noteq> Ttrue" by simp
   hence "t_v_evaluation I  F = Ffalse \<or> t_v_evaluation I G = Ffalse" using CasosValor by auto
   hence "t_v_evaluation I (F \<and>. G) = Ffalse" by(auto simp add: v_conjunction_def)
   hence "False" using assms by simp}
 thus "t_v_evaluation I F = Ttrue \<and> t_v_evaluation I G = Ttrue" by auto
qed
(*>*)

text \<open>
  \begin{lema}
  Sean $F$ y $G$ fórmulas e $I$ una interpretación. Si $I'(F\vee G)=\V$,
  entonces $I'(F)=\V$ ó $I'(G)=\V$
  \end{lema}
  \noindent Su formalización es:
\<close>

lemma DisjunctionValues:
  assumes "t_v_evaluation I (F \<or>. G ) = Ttrue"
  shows "t_v_evaluation I  F = Ttrue \<or> t_v_evaluation I G = Ttrue"
(*<*)
proof -
 { assume "\<not>(t_v_evaluation I  F = Ttrue \<or> t_v_evaluation I G  = Ttrue)"
   hence "t_v_evaluation I F  \<noteq> Ttrue \<and> t_v_evaluation I G \<noteq> Ttrue" by simp
   hence "t_v_evaluation I  F = Ffalse \<and> t_v_evaluation I G = Ffalse" using CasosValor by auto
   hence "t_v_evaluation I (F \<or>. G) = Ffalse" by(simp add: v_disjunction_def)
   hence "False" using assms by simp}
 thus "t_v_evaluation I F = Ttrue \<or> t_v_evaluation I G = Ttrue" by auto
qed
(*>*)

text \<open>
  \begin{lema}
  Sea $F$ y $G$ fórmulas e $I$ una interpretación tales que
  $I'(F \rightarrow G) = \V$. Si $I'(F)=\V$, entonces $I'(G)= \V$.
  \end{lema}
  \noindent Su formalización es:
 \<close>

lemma ImplicationValues:
  assumes "t_v_evaluation I (F \<rightarrow>. G) = Ttrue"
  shows "t_v_evaluation I F = Ttrue \<longrightarrow> t_v_evaluation I G = Ttrue"
(*<*)
proof -
 { assume "\<not>(t_v_evaluation I F = Ttrue \<longrightarrow> t_v_evaluation I G = Ttrue)"
   hence "t_v_evaluation I F =  Ttrue \<and> t_v_evaluation I G \<noteq> Ttrue" by simp
   hence "t_v_evaluation I F = Ttrue \<and> t_v_evaluation I G = Ffalse" using CasosValor by auto
   hence "t_v_evaluation I (F \<rightarrow>. G) = Ffalse" by(simp add: v_implication_def)
   hence "False" using assms by simp}
 thus "t_v_evaluation I F = Ttrue \<longrightarrow> t_v_evaluation I G = Ttrue" by auto
qed

lemma eval_false_implication:
  assumes "t_v_evaluation I (F \<rightarrow>.G) = Ffalse"
  shows "t_v_evaluation I F = Ttrue \<and> t_v_evaluation I G = Ffalse"
proof(rule ccontr)
  assume "\<not> (t_v_evaluation I F = Ttrue \<and> t_v_evaluation I G = Ffalse)"
  hence "t_v_evaluation I F = Ffalse \<or> t_v_evaluation I G = Ttrue"
    using CasosValor by auto
  hence "t_v_evaluation I (F \<rightarrow>.G) = Ttrue"
    by(unfold t_v_evaluation_def, unfold v_implication_def, auto)
  thus False using assms by auto
qed

(*>*)

text \<open>
  Formalizamos  las nociones de satisfacibilidad, consecuencia
  lógica y tautología en términos del concepto de @{text model}.  Las
  demostraciones de las propieda\-des que se enuncian acerca de
  estos conceptos se obtienen directamente a partir de las definiciones.
  \begin{definicion}\label{modelP}
    Una interpretación $I$ es \textbf{model} de un conjunto de fórmulas $S$
    si, para toda fórmula $F$ de $S$, $I'(F) = \V$.
  \end{definicion}
  \noindent Su formalización es:
\<close>

definition model :: "('b \<Rightarrow> v_truth) \<Rightarrow> 'b formula set \<Rightarrow> bool" ("_ model _" [80,80] 80) where
 "I model S \<equiv> (\<forall>F \<in> S. t_v_evaluation I F = Ttrue)"

text \<open>
  \begin{definicion}\label{satisfiableP}
    Un conjunto de fórmulas es \textbf{satisfiable} si tiene algún model. En
    caso contrario se dice que es \textbf{insatisfiable}.
  \end{definicion}
  \noindent Su formalización es \<close>

definition satisfiable :: "'b formula set \<Rightarrow> bool" where
 "satisfiable S \<equiv> (\<exists>v. v model S)"

(*<*)
text\<open>
  \begin{lema}
  Todo subconjunto de un conjunto satisfiable es satisfiable.
  \end{lema}
  \noindent Su formalización es:
\<close>
lemma satisfiable_subset:
  assumes "satisfiable S" and "H\<subseteq>S"
  shows "satisfiable H"
proof(unfold satisfiable_def)
  show "\<exists>v. v model H"
  proof-
    have "\<exists>v. v model S" using assms(1) by(unfold satisfiable_def)
    then obtain v where v: "v model S" by auto
    have "v model H"
    proof(unfold model_def)
      show  "\<forall>F\<in>H. t_v_evaluation v F = Ttrue"
      proof
        fix F
        assume "F\<in>H"
        thus "t_v_evaluation v F = Ttrue" using assms(2) v by(unfold model_def, auto)
      qed
    qed
    thus ?thesis by auto
  qed
qed

(*>*)

text \<open>
  \begin{definicion}\label{consecuenciaP}
    Una fórmula $F$ es una \textbf{consecuencia lógica} de un conjunto de
    fórmulas $S$ si para todo model $I$ de $S$ se tiene que $I'(F) =\V$. Se
    representa por @{text "S \<Turnstile> F"}.
  \end{definicion}
  \noindent Su formalización es:
\<close>

definition consecuencia :: "'b formula set \<Rightarrow> 'b formula \<Rightarrow> bool" ("_ \<Turnstile> _" [80,80] 80) where
 "S \<Turnstile> F \<equiv> (\<forall>I. I model S \<longrightarrow> t_v_evaluation I F = Ttrue)"

text \<open>
  El siguiente resultado establece la relación entre los conceptos de
  consecuencia lógica y satisfactibilidad.
\<close>

(*<*)
text\<open>
  \begin{lema}
  Si @{text "S \<Turnstile> F"}, entonces @{text "S \<union> {\<not>. F}"} no es satisfiable.
  \end{lema}
  \noindent Su formalización es:
\<close>

lemma ConsSat:
  assumes "S \<Turnstile> F"
  shows "\<not> satisfiable (S \<union> {\<not>. F})"
proof(rule notI)
  assume "satisfiable (S \<union> {\<not>. F})"
  hence 1: "\<exists>I. I model (S \<union> {\<not>. F})" by (auto simp add: satisfiable_def)
  obtain I where I: "I model (S \<union> {\<not>. F})" using 1 by auto
  hence 2: "\<forall>G\<in>(S \<union> {\<not>. F}). t_v_evaluation I G = Ttrue"
    by (auto simp add: model_def)
  hence "\<forall>G\<in>S. t_v_evaluation I G = Ttrue" by blast
  moreover
  have 3: "t_v_evaluation I (\<not>. F) = Ttrue" using 2 by simp
  hence "t_v_evaluation I F = Ffalse"
    proof (cases "t_v_evaluation I F")
      assume "t_v_evaluation I F = Ttrue"
      thus ?thesis using 3 by(simp add:v_negation_def)
      next
      assume "t_v_evaluation I F = Ffalse"
      thus ?thesis by simp
    qed
  ultimately
  show "False" using assms
    by (simp add: consecuencia_def, simp add: model_def)
qed

text \<open>
  \begin{lema}
  Si @{text "S \<union> {\<not> F}"} no es satisfiable, entonces @{text "S \<Turnstile> F"}.
  \end{lema}

  \noindent Su formalización es:
\<close>

lemma SatCons:
  assumes "\<not> satisfiable (S \<union> {\<not>. F})"
  shows "S \<Turnstile> F"
proof (rule contrapos_np)
  assume hip: "\<not> S \<Turnstile> F"
  show "satisfiable (S \<union> {\<not>. F})"
  proof -
    have 1: "\<exists>I. I model S \<and> \<not>(t_v_evaluation I F = Ttrue)"
      using hip by (simp add: consecuencia_def)
    obtain I where I: "I model S \<and> \<not>(t_v_evaluation I F = Ttrue)" using 1 by auto
    hence  "I model S" by simp
    hence 2: "\<forall>G\<in>S. t_v_evaluation I G = Ttrue" by (simp add: model_def)
    have "\<not>(t_v_evaluation I F = Ttrue)" using I by simp
    hence 3: "t_v_evaluation I (\<not>. F) = Ttrue" by (simp add:v_negation_def)
    have  "\<forall>G\<in>(S \<union> {\<not>. F}). t_v_evaluation I G = Ttrue"
    proof (rule ballI)
      fix G
      assume hip2: "G\<in>(S \<union> {\<not>. F})"
      show "t_v_evaluation I G = Ttrue"
      proof (cases)
        assume "G\<in>S"
        thus ?thesis using 2 by simp
        next
        assume "\<not>G\<in>S"
        hence "G = (\<not>. F)"using hip2 by simp
        thus ?thesis using 3 by simp
      qed
    qed
    hence "I model (S \<union> {\<not>. F})" by (simp add: model_def)
    thus ?thesis by (auto simp add: satisfiable_def)
  qed
  next
  show "\<not> satisfiable (S \<union> {\<not>. F})" using assms by simp
qed
(*>*)

text\<open>
  \begin{teorema}\label{EquiConsSat}
  @{text "S \<Turnstile> F"} si y solamente si @{text "S \<union> {\<not> F}"} no es satisfiable.
  \end{teorema}
  \noindent Su formalización es:
\<close>

theorem EquiConsSat:
  shows  "S \<Turnstile> F = (\<not> satisfiable (S \<union> {\<not>. F}))"
(*<*)
using SatCons ConsSat by blast
(*>*)

text \<open>
  Por último formulamos el concepto de tautología.
  \begin{definicion}
    Una fórmula $F$ es una \textbf{tautología} si $I'(F) =\V$ para toda
    interpretación $I$.
  \end{definicion}
  \noindent Su formalización es:
\<close>

definition tautologia :: "'b formula \<Rightarrow> bool" where
  "tautologia F \<equiv> (\<forall>I. ((t_v_evaluation I F) = Ttrue))"
text\<open> Ejemplo:
\begin{lema}
  La f\'ormula @{text "F \<rightarrow> (G \<rightarrow> F)"} es una tautolog\'{\i}a.
  \end{lema}
  \begin{demostracion}
  La demostraci\'on se realiza f\'acilmente por casos en los posibles
  t_v_evaluationes de la f\'ormula $F$ en la interpretaci\'on $I$, utilizando la
  definici\'on del t_v_evaluation de una implicaci\'on. Tal y como se muestra en la
  siguiente tabla:
  $$\begin{array}{c|c|c|l}
           & F   & G \rightarrow F  &  F  \rightarrow  (G \rightarrow F)
                                                                  \\ \hline
  caso\ 1  & \V  & \V               & \ \ \ \     \V              \\ \hline
  caso\ 2  & \F  &                  & \ \ \ \     \V              \\
  \end{array}$$
  \end{demostracion}
  \noindent Su formalizaci\'on es:
\<close>

lemma "tautologia (F  \<rightarrow>. (G \<rightarrow>. F))"
proof -
  have "\<forall>I. t_v_evaluation I (F \<rightarrow>. (G \<rightarrow>. F)) = Ttrue"
  proof
    fix I
    show "t_v_evaluation I (F \<rightarrow>. (G \<rightarrow>. F)) = Ttrue"
    proof (cases "t_v_evaluation I F")
      text\<open> Caso 1: \<close>
    { assume "t_v_evaluation I F = Ttrue"
      thus ?thesis by (simp add: v_implication_def) }
      next
      text\<open> Caso 2: \<close>
    { assume "t_v_evaluation I F = Ffalse"
      thus ?thesis by(simp add: v_implication_def) }
    qed
  qed
  thus ?thesis by (simp add: tautologia_def)
qed

text \<open>
  El concepto de tautología se puede formular en términos del concepto
  de consecuencia lógica:
\<close>

(*<*)
text \<open>
  \begin{lema}
    Todas las interpretaciones son model del conjunto vacío.
  \end{lema}
\<close>

lemma model_de_vacio: "\<forall>(I::'b \<Rightarrow> v_truth). I model {}"
proof -
  have "\<forall>F\<in> {}. t_v_evaluation (I::'b \<Rightarrow> v_truth) F = Ttrue" by simp
  thus "\<forall>I. I model {}" by (simp add: model_def)
qed
(*>*)

text \<open>
  \begin{teorema}
  Una fórmula es tautología si y solamente si es consecuencia del conjunto vacío.
  \end{teorema}
  \noindent Su formalizacion es
\<close>

theorem CNS_tautologia: "tautologia F = ({} \<Turnstile> F)"
(*<*)
by(simp add: tautologia_def consecuencia_def model_de_vacio)
(*>*)

text\<open>
  \begin{teorema}\label{TautSatis}
  La implicación @{text "F \<rightarrow> G" } es una tautología si y solamente si el conjunto
  @{text "{F, \<not>G}"} no es satisfiable.
  \end{teorema}
  \noindent Su formalización es: \<close>

theorem TautSatis:
  shows "tautologia (F \<rightarrow>. G) = (\<not> satisfiable{F, \<not>.G})"
(*<*)
proof -
 { assume h1: "\<not> tautologia (F \<rightarrow>. G)"
   have "satisfiable{F, \<not>.G}"
   proof -
     have "\<exists> I. t_v_evaluation I (F \<rightarrow>. G) \<noteq> Ttrue"
       using h1 by (unfold tautologia_def, auto)
    then obtain I where "t_v_evaluation I (F \<rightarrow>. G) \<noteq> Ttrue" by auto
    hence a: "t_v_evaluation I (F \<rightarrow>. G) = Ffalse" using CasosValor by blast
    hence "t_v_evaluation I F = Ttrue \<and> t_v_evaluation I G = Ffalse"
    proof -
     { assume "t_v_evaluation I F \<noteq> Ttrue \<or> t_v_evaluation I G \<noteq> Ffalse"
       hence "False"
       proof(rule disjE)
         assume "t_v_evaluation I F \<noteq> Ttrue"
         hence "t_v_evaluation I F = Ffalse" using CasosValor by auto
         hence "t_v_evaluation I (F \<rightarrow>. G) = Ttrue"
           by (auto simp add: v_implication_def)
         thus "False" using a by auto
       next
         assume "t_v_evaluation I G \<noteq> Ffalse"
         hence "t_v_evaluation I G = Ttrue" using CasosValor by auto
         hence "t_v_evaluation I (F \<rightarrow>. G) = Ttrue" by( simp add: v_implication_def)
         thus "False" using a by auto
       qed}
     thus "t_v_evaluation I F = Ttrue \<and> t_v_evaluation I G = Ffalse" by auto
   qed
   hence "t_v_evaluation I F = Ttrue \<and> t_v_evaluation I (\<not>.G) = Ttrue"
     by (simp add:v_negation_def)
   hence "\<exists> I. I model {F, \<not>.G}" by (auto simp add: model_def)
   thus "satisfiable {F, \<not>.G}" by(simp add: satisfiable_def)
 qed}
moreover
{ assume h2: "satisfiable {F, \<not>.G}"
  have "\<not> tautologia (F \<rightarrow>. G)"
  proof -
    have "\<exists> I. I model {F, \<not>.G}" using h2 by (simp add: satisfiable_def)
    hence "\<exists> I. t_v_evaluation I F = Ttrue \<and> t_v_evaluation I (\<not>.G) = Ttrue"
      by(simp add: model_def)
    then obtain I where I1: "t_v_evaluation I F = Ttrue" and I2: "t_v_evaluation I (\<not>.G) = Ttrue"
      by auto
    have "t_v_evaluation I G = Ffalse" using I2 NegationValues2 by auto
    hence "t_v_evaluation I (F \<rightarrow>. G) = Ffalse" using I1
      by (simp add: v_implication_def)
    thus "\<not> tautologia (F \<rightarrow>. G)" by (auto, unfold tautologia_def, auto)
  qed}
  ultimately
  show ?thesis by auto
qed

subsection \<open> Equivalencia entre fórmulas \<close>

text\<open>

  \begin{definicion}
   Dos fórmulas $F$ y $G$ son equivalentes si $I'(F) = I'(G)$ para toda
   interpretación $I$, y se representa por $F\equiv G$.
  \end{definicion}
  \noindent Su formalización es:
\<close>

definition equivalentes:: "'b formula  \<Rightarrow> 'b formula \<Rightarrow> bool" where
  "equivalentes F G \<equiv> (\<forall> I. (t_v_evaluation I F) = (t_v_evaluation I G))"

primrec disjunction_atomic :: "'b list \<Rightarrow>'a \<Rightarrow> ('a \<times> 'b)formula"  where
 "disjunction_atomic [] i = FF"
| "disjunction_atomic (x#D) i = (atom (i, x)) \<or>. (disjunction_atomic D i)"

lemma t_v_evaluation_disjunctions1:
  assumes "t_v_evaluation I (disjunction_atomic (a # l) i) = Ttrue"
  shows "t_v_evaluation I (atom (i,a)) = Ttrue \<or> t_v_evaluation I (disjunction_atomic l i) = Ttrue"
proof-
  have
  "(disjunction_atomic (a # l) i) = (atom (i,a)) \<or>. (disjunction_atomic l i)"
    by auto
  hence "t_v_evaluation I ((atom (i ,a)) \<or>. (disjunction_atomic l i)) = Ttrue"
    using assms by auto
  thus ?thesis using DisjunctionValues by blast
qed

lemma t_v_evaluation_atom:
  assumes "t_v_evaluation I (disjunction_atomic l i) = Ttrue"
  shows "\<exists>x. x \<in> set l \<and> (t_v_evaluation I (atom (i,x)) = Ttrue)"
proof-
  have "t_v_evaluation I (disjunction_atomic l i) = Ttrue \<Longrightarrow>
  \<exists>x. x \<in> set l \<and> (t_v_evaluation I (atom (i,x)) = Ttrue)"
  proof(induct l)
    case Nil
    then show ?case by auto
  next
    case (Cons a l)
    show  "\<exists>x. x \<in> set (a # l) \<and> t_v_evaluation I (atom (i,x)) = Ttrue"
    proof-
      have
      "(t_v_evaluation I (atom (i,a)) = Ttrue) \<or> t_v_evaluation I (disjunction_atomic l i)=Ttrue"
        using Cons(2) t_v_evaluation_disjunctions1[of I] by auto
      thus ?thesis
    proof(rule disjE)
      assume "t_v_evaluation I (atom (i,a)) = Ttrue"
      thus ?thesis by auto
    next
      assume "t_v_evaluation I (disjunction_atomic l i) = Ttrue"
      thus ?thesis using Cons by auto
    qed
  qed
qed
  thus ?thesis using assms by auto
qed

definition set_to_list :: "'a set \<Rightarrow> 'a list"
  where "set_to_list s =  (SOME l. set l = s)"

lemma  set_set_to_list:
   "finite s \<Longrightarrow> set (set_to_list s) = s"
  unfolding set_to_list_def by (metis (mono_tags) finite_list some_eq_ex)

(*>*)

(*<*)
end
(*>*)


theory Splay_Tree_Analysis_Base
imports Complex_Main "../Splay_Tree/Splay_Tree"
begin

section "Splay Tree Analysis Basics"

declare size1_def[simp]

abbreviation "\<phi> t == log 2 (size1 t)"

fun \<Phi> :: "'a tree \<Rightarrow> real" where
"\<Phi> Leaf = 0" |
"\<Phi> (Node l a r) = \<Phi> l + \<Phi> r + \<phi> (Node l a r)"

lemma add_log_log1:
  assumes "x > 0" "y > 0" shows "1 + log 2 x + log 2 y < 2 * log 2 (x+y)"
proof -
  have 1: "2*x*y < (x+y)^2" using assms
    by(simp add: numeral_eq_Suc algebra_simps add_pos_pos)
  show ?thesis
    apply(rule powr_less_cancel_iff[of 2, THEN iffD1])
     apply simp
    using assms 1 by(simp add: powr_add log_powr[symmetric] powr_numeral)
qed

subsection "Time"

fun t_splay :: "'a::linorder \<Rightarrow> 'a tree \<Rightarrow> nat" where
"t_splay a Leaf = 1" |
"t_splay a (Node l b r) =
  (if a=b
   then 1
   else if a < b
        then case l of
          Leaf \<Rightarrow> 1 |
          Node ll c lr \<Rightarrow>
            (if a=c then 1
             else if a < c then if ll = Leaf then 1 else t_splay a ll + 1
                  else if lr = Leaf then 1 else t_splay a lr + 1)
        else case r of
          Leaf \<Rightarrow> 1 |
          Node rl c rr \<Rightarrow>
            (if a=c then 1
             else if a < c then if rl = Leaf then 1 else t_splay a rl + 1
                  else if rr = Leaf then 1 else t_splay a rr + 1))"

lemma t_splay_simps[simp]:
  "t_splay a (Node l a r) = 1"
  "a<b \<Longrightarrow> t_splay a (Node Leaf b r) = 1"
  "a<b \<Longrightarrow> t_splay a (Node (Node ll a lr) b r) = 1"
  "a<b \<Longrightarrow> a<c \<Longrightarrow> t_splay a (Node (Node ll c lr) b r) =
   (if ll = Leaf then 1 else t_splay a ll + 1)"
  "a<b \<Longrightarrow> c<a \<Longrightarrow> t_splay a (Node (Node ll c lr) b r) =
   (if lr = Leaf then 1 else t_splay a lr + 1)"
  "b<a \<Longrightarrow> t_splay a (Node l b Leaf) = 1"
  "b<a \<Longrightarrow> t_splay a (Node l b (Node rl a rr)) = 1"
  "b<a \<Longrightarrow> a<c \<Longrightarrow> t_splay a (Node l b (Node rl c rr)) =
  (if rl=Leaf then 1 else t_splay a rl + 1)"
  "b<a \<Longrightarrow> c<a \<Longrightarrow> t_splay a (Node l b (Node rl c rr)) =
  (if rr=Leaf then 1 else t_splay a rr + 1)"
by auto

declare t_splay.simps(2)[simp del]

fun t_splay_max :: "'a::linorder tree \<Rightarrow> nat" where
"t_splay_max Leaf = 1" |
"t_splay_max (Node l b Leaf) = 1" |
"t_splay_max (Node l b (Node rl c rr)) = (if rr=Leaf then 1 else t_splay_max rr + 1)"

definition t_delete :: "'a::linorder \<Rightarrow> 'a tree \<Rightarrow> nat" where
"t_delete a t = (if t = Leaf then 0 else t_splay a t + (case splay a t of
  Node l x r \<Rightarrow>
    if x=a then case l of Leaf \<Rightarrow> 0 | _ \<Rightarrow> t_splay_max l
    else 0))"

lemma ex_in_set_tree: "t \<noteq> Leaf \<Longrightarrow> bst t \<Longrightarrow>
  \<exists>a' \<in> set_tree t. splay a' t = splay a t \<and> t_splay a' t = t_splay a t"
proof(induction a t rule: splay.induct)
  case 1 thus ?case by simp
next
  case (2 a l c r)
  show ?case
  proof cases
    assume "a=c" thus ?thesis using "2.prems" by auto
  next
    assume "a\<noteq>c"
    hence "a<c \<or> c<a" by (metis neqE)
    thus ?thesis
    proof
      assume "a<c"
      show ?thesis
      proof(cases l)
        case Leaf thus ?thesis using `a<c` by(auto)
      next
        case (Node ll b lr)[simp]
        have "b < c" using "2.prems" by (auto)
        show ?thesis
        proof cases
          assume "a=b" thus ?thesis using `a<c` by auto
        next
          assume "a\<noteq>b"
          hence "a<b \<or> b<a" by (metis neqE)
          thus ?thesis
          proof
            assume "a<b"
            show ?thesis
            proof cases
              assume "ll = Leaf" thus ?thesis using `a<c` `a<b` `b<c` by(auto)
            next
              assume "ll \<noteq> Leaf"
              hence "splay a ll \<noteq> Leaf" by simp
              then obtain lll u llr where [simp]: "splay a ll = Node lll u llr"
                by (metis tree.exhaust)
              have "bst ll" using "2.prems" by simp
              from "2.IH"(1)[OF `a\<noteq>c` `a<c` Node `a\<noteq>b` `a<b` `ll \<noteq> Leaf` `ll \<noteq> Leaf` `bst ll`]
              obtain e where "e \<in> set_tree ll" "splay e ll = splay a ll" "t_splay e ll = t_splay a ll"
                by blast
              moreover hence "e<b" using "2.prems"(2) by auto
              ultimately show ?thesis using `a<c` `a<b` `b<c` `bst ll` by force
            qed
          next
            assume "b<a" hence "\<not> a<b" by simp
            show ?thesis
            proof cases
              assume "lr = Leaf" thus ?thesis using `a<c` `b<a` by(auto)
            next
              assume "lr \<noteq> Leaf"
              hence "splay a lr \<noteq> Leaf" by simp
              then obtain lrl u lrr where [simp]: "splay a lr = Node lrl u lrr"
                by (metis tree.exhaust)
              have "bst lr" using "2.prems" by simp
              from "2.IH"(2)[OF `a\<noteq>c` `a<c` Node `a\<noteq>b` `\<not>a<b` `lr \<noteq> Leaf` `lr \<noteq> Leaf` `bst lr`]
              obtain e where "e \<in> set_tree lr" "splay e lr = splay a lr" "t_splay e lr = t_splay a lr"
                by blast
              moreover hence "b<e & e<c" using "2.prems"(2) by simp
              ultimately show ?thesis using `a<c` `b<a` `b<c` `bst lr` by force
            qed
          qed
        qed
      qed
    next
      assume "c<a" hence "\<not>a<c" by simp
      show ?thesis
      proof(cases r)
        case Leaf thus ?thesis using `c<a` by(auto)
      next
        case (Node rl b rr)[simp]
        have "c < b" using "2.prems" by (auto)
        show ?thesis
        proof cases
          assume "a=b" thus ?thesis using `c<a` by auto
        next
          assume "a\<noteq>b"
          hence "a<b \<or> b<a" by (metis neqE)
          thus ?thesis
          proof
            assume "a<b" hence "\<not> b<a" by simp
            show ?thesis
            proof cases
              assume "rl = Leaf" thus ?thesis using `c<a` `a<b` by(auto)
            next
              assume "rl \<noteq> Leaf"
              hence "splay a rl \<noteq> Leaf" by simp
              then obtain rll u rlr where [simp]: "splay a rl = Node rll u rlr"
                by (metis tree.exhaust)
              have "bst rl" using "2.prems" by simp
              from "2.IH"(3)[OF `a\<noteq>c` `\<not>a<c` Node `a\<noteq>b` `a<b` `rl \<noteq> Leaf` `rl \<noteq> Leaf` `bst rl`]
              obtain e where "e \<in> set_tree rl" "splay e rl = splay a rl" "t_splay e rl = t_splay a rl"
                by blast
              moreover hence "c<e & e<b" using "2.prems"(2) by simp
              ultimately show ?thesis using `c<a` `a<b` `c<b` `bst rl` by force
            qed
          next
            assume "b<a" hence "\<not>a<b" by simp
            show ?thesis
            proof cases
              assume "rr = Leaf" thus ?thesis using `c<a` `b<a` `c<b` by(auto)
            next
              assume "rr \<noteq> Leaf"
              hence "splay a rr \<noteq> Leaf" by simp
              then obtain rrl u rrr where [simp]: "splay a rr = Node rrl u rrr"
                by (metis tree.exhaust)
              have "bst rr" using "2.prems" by simp
              from "2.IH"(4)[OF `a\<noteq>c` `\<not>a<c` Node `a\<noteq>b` `\<not>a<b` `rr \<noteq> Leaf` `rr \<noteq> Leaf` `bst rr`]
              obtain e where "e \<in> set_tree rr" "splay e rr = splay a rr" "t_splay e rr = t_splay a rr"
                by blast
              moreover hence "b<e" using "2.prems"(2) by simp
              ultimately show ?thesis using `c<a` `b<a` `c<b` `bst rr` by force
            qed
          qed
        qed
      qed
    qed
  qed
qed

datatype 'a op\<^sub>s\<^sub>t = Splay 'a | Insert 'a | Delete 'a

fun nxt\<^sub>s\<^sub>t :: "'a::linorder op\<^sub>s\<^sub>t \<Rightarrow> 'a tree \<Rightarrow> 'a tree" where
"nxt\<^sub>s\<^sub>t (Splay a) t = splay a t" |
"nxt\<^sub>s\<^sub>t (Insert a) t = Splay_Tree.insert a t" |
"nxt\<^sub>s\<^sub>t (Delete a) t = Splay_Tree.delete a t"

fun t\<^sub>s\<^sub>t :: "'a::linorder op\<^sub>s\<^sub>t \<Rightarrow> 'a tree \<Rightarrow> real" where
"t\<^sub>s\<^sub>t (Splay a) t = t_splay a t" |
"t\<^sub>s\<^sub>t (Insert a) t = t_splay a t" |
"t\<^sub>s\<^sub>t (Delete a) t = t_delete a t"

end