(*
 * Copyright Data61, CSIRO (ABN 41 687 119 230)
 *
 * SPDX-License-Identifier: BSD-2-Clause
 *)

(* Author: Jeremy Dawson, NICTA *)

section \<open>Dedicated operation for the most significant bit\<close>

theory Most_significant_bit
  imports
    "HOL-Library.Word"
    Bits_Int
    More_Word
    More_Arithmetic
begin

class msb =
  fixes msb :: \<open>'a \<Rightarrow> bool\<close>

instantiation int :: msb
begin

definition \<open>msb x \<longleftrightarrow> x < 0\<close> for x :: int

instance ..

end

lemma msb_conv_bin_sign: "msb x \<longleftrightarrow> bin_sign x = -1"
by(simp add: bin_sign_def not_le msb_int_def)

lemma msb_bin_rest [simp]: "msb (x div 2) = msb x"
  for x :: int
  by (simp add: msb_int_def)

lemma int_msb_and [simp]: "msb ((x :: int) AND y) \<longleftrightarrow> msb x \<and> msb y"
by(simp add: msb_int_def)

lemma int_msb_or [simp]: "msb ((x :: int) OR y) \<longleftrightarrow> msb x \<or> msb y"
by(simp add: msb_int_def)

lemma int_msb_xor [simp]: "msb ((x :: int) XOR y) \<longleftrightarrow> msb x \<noteq> msb y"
by(simp add: msb_int_def)

lemma int_msb_not [simp]: "msb (NOT (x :: int)) \<longleftrightarrow> \<not> msb x"
by(simp add: msb_int_def not_less)

lemma msb_shiftl [simp]: "msb (push_bit n (x :: int)) \<longleftrightarrow> msb x"
by(simp add: msb_int_def)

lemma msb_shiftr [simp]: "msb (drop_bit r (x :: int)) \<longleftrightarrow> msb x"
by(simp add: msb_int_def)

lemma msb_bin_sc [simp]: "msb (bin_sc n b x) \<longleftrightarrow> msb x"
by(simp add: msb_conv_bin_sign)

lemma msb_0 [simp]: "msb (0 :: int) = False"
by(simp add: msb_int_def)

lemma msb_1 [simp]: "msb (1 :: int) = False"
by(simp add: msb_int_def)

lemma msb_numeral [simp]:
  "msb (numeral n :: int) = False"
  "msb (- numeral n :: int) = True"
by(simp_all add: msb_int_def)

instantiation word :: (len) msb
begin

definition msb_word :: \<open>'a word \<Rightarrow> bool\<close>
  where \<open>msb a \<longleftrightarrow> bin_sign (signed_take_bit (LENGTH('a) - 1) (uint a)) = - 1\<close>

lemma msb_word_eq:
  \<open>msb w \<longleftrightarrow> bit w (LENGTH('a) - 1)\<close> for w :: \<open>'a::len word\<close>
  by (simp add: msb_word_def bin_sign_lem bit_uint_iff)

instance ..

end

lemma msb_word_iff_bit:
  \<open>msb w \<longleftrightarrow> bit w (LENGTH('a) - Suc 0)\<close>
  for w :: \<open>'a::len word\<close>
  by (simp add: msb_word_def bin_sign_def bit_uint_iff)

lemma word_msb_def:
  "msb a \<longleftrightarrow> bin_sign (sint a) = - 1"
  by (simp add: msb_word_def sint_uint)

lemma word_msb_sint: "msb w \<longleftrightarrow> sint w < 0"
  by (simp add: msb_word_eq bit_last_iff)

lemma msb_word_iff_sless_0:
  \<open>msb w \<longleftrightarrow> w <s 0\<close>
  by (simp add: word_msb_sint word_sless_alt)

lemma msb_word_of_int: "msb (word_of_int x::'a::len word) = bit x (LENGTH('a) - 1)"
  by (simp add: word_msb_def bin_sign_lem)

lemma word_msb_numeral [simp]:
  "msb (numeral w::'a::len word) = bit (numeral w :: int) (LENGTH('a) - 1)"
  unfolding word_numeral_alt by (rule msb_word_of_int)

lemma word_msb_neg_numeral [simp]:
  "msb (- numeral w::'a::len word) = bit (- numeral w :: int) (LENGTH('a) - 1)"
  unfolding word_neg_numeral_alt by (rule msb_word_of_int)

lemma word_msb_0 [simp]: "\<not> msb (0::'a::len word)"
  by (simp add: word_msb_def bin_sign_def sint_uint sbintrunc_eq_take_bit)

lemma word_msb_1 [simp]: "msb (1::'a::len word) \<longleftrightarrow> LENGTH('a) = 1"
  unfolding word_1_wi msb_word_of_int eq_iff [where 'a=nat]
  by (simp add: Suc_le_eq)

lemma word_msb_nth: "msb w = bit (uint w) (LENGTH('a) - 1)"
  for w :: "'a::len word"
  by (simp add: word_msb_def sint_uint bin_sign_lem)

lemma msb_nth: "msb w = bit w (LENGTH('a) - 1)"
  for w :: "'a::len word"
  by (fact msb_word_eq)

lemma word_msb_n1 [simp]: "msb (-1::'a::len word)"
  by (simp add: msb_word_eq not_le)

lemma msb_shift: "msb w \<longleftrightarrow> drop_bit (LENGTH('a) - 1) w \<noteq> 0"
  for w :: "'a::len word"
  by (simp add: msb_word_eq bit_iff_odd_drop_bit drop_bit_eq_zero_iff_not_bit_last)

lemmas word_ops_msb = msb1 [unfolded msb_nth [symmetric, unfolded One_nat_def]]

lemma word_sint_msb_eq: "sint x = uint x - (if msb x then 2 ^ size x else 0)"
  apply (cases \<open>LENGTH('a)\<close>)
   apply (simp_all add: msb_word_def bin_sign_def bit_simps word_size)
  apply transfer
  apply (auto simp add: take_bit_Suc_from_most signed_take_bit_eq_if_positive signed_take_bit_eq_if_negative minus_exp_eq_not_mask ac_simps)
  apply (subst disjunctive_add)
   apply (simp_all add: bit_simps)
  done

lemma word_sle_msb_le: "x <=s y \<longleftrightarrow> (msb y \<longrightarrow> msb x) \<and> ((msb x \<and> \<not> msb y) \<or> x \<le> y)"
  apply (simp add: word_sle_eq word_sint_msb_eq word_size word_le_def)
  apply safe
   apply (rule order_trans[OF _ uint_ge_0])
   apply (simp add: order_less_imp_le)
  apply (erule notE[OF leD])
  apply (rule order_less_le_trans[OF _ uint_ge_0])
  apply simp
  done

lemma word_sless_msb_less: "x <s y \<longleftrightarrow> (msb y \<longrightarrow> msb x) \<and> ((msb x \<and> \<not> msb y) \<or> x < y)"
  by (auto simp add: word_sless_eq word_sle_msb_le)

lemma not_msb_from_less:
  "(v :: 'a word) < 2 ^ (LENGTH('a :: len) - 1) \<Longrightarrow> \<not> msb v"
  apply (clarsimp simp add: msb_nth)
  apply (drule less_mask_eq)
  apply (drule word_eqD, drule(1) iffD2)
  apply (simp add: bit_simps)
  done

lemma scast_eq_ucast:
  "\<not> msb x \<Longrightarrow> scast x = ucast x"
  apply (cases \<open>LENGTH('a)\<close>)
  apply simp
  apply (rule bit_word_eqI)
  apply (auto simp add: bit_signed_iff bit_unsigned_iff min_def msb_word_eq)
  apply (erule notE)
  apply (metis le_less_Suc_eq test_bit_bin)
  done

lemma msb_ucast_eq:
    "LENGTH('a) = LENGTH('b) \<Longrightarrow>
         msb (ucast x :: ('a::len) word) = msb (x :: ('b::len) word)"
  by (simp add: msb_word_eq bit_simps)

lemma msb_big:
  \<open>msb a \<longleftrightarrow> 2 ^ (LENGTH('a) - Suc 0) \<le> a\<close>
  for a :: \<open>'a::len word\<close>
  using bang_is_le [of a \<open>LENGTH('a) - Suc 0\<close>]
  apply (auto simp add: msb_nth word_le_not_less)
  apply (rule ccontr)
  apply (erule notE)
  apply (rule ccontr)
    apply (clarsimp simp: not_less)
  apply (subgoal_tac "a = a AND mask (LENGTH('a) - Suc 0)")
   apply (cut_tac and_mask_less' [where w=a and n="LENGTH('a) - Suc 0"])
    apply clarsimp
  apply simp
  apply (simp flip: take_bit_eq_mask)
  apply (rule sym)
  apply (simp add: take_bit_eq_self_iff_drop_bit_eq_0 drop_bit_eq_zero_iff_not_bit_last)
  done

end


theory P4 imports Main
begin

fun alls :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where
"alls Q Nil = True" |
"alls Q (x # xs) = ((Q x) \<and> (alls Q xs))"

fun exs :: "('a \<Rightarrow> bool) \<Rightarrow> 'a list \<Rightarrow> bool" where
"exs Q Nil \<longleftrightarrow> False" |
"exs Q (x # xs) \<longleftrightarrow> (Q x) \<or> (exs Q xs)"

lemma "alls (\<lambda>x. P x \<and> Q x) xs = (alls P xs \<and> alls Q xs)"
  apply (induct xs)
   apply auto
  done

lemma [simp]: "exs P (xs @ [x]) = (P x \<or> (exs P xs))"
  apply (induct xs)
   apply auto
  done

lemma "alls P (rev xs) = alls P xs"
proof (induct xs)
case Nil
  then show "alls P (rev []) = alls P []" by simp
next
case (Cons a xs)
  then show "alls P (rev (a # xs)) = alls P (a # xs)" by simp
qed

lemma "exs (\<lambda>x. P x \<and> Q x) xs = (exs P xs \<and> exs Q xs)"
  nitpick
  oops

lemma "exs P (map f xs) = exs (P o f) xs"
  apply (induct xs)
   apply auto
  done

lemma "exs P (rev xs) = exs P xs"
  apply (induct xs)
   apply auto
  done

lemma "exs (\<lambda>x. P x \<or> Q x) xs = ((exs P xs) \<or> (exs Q xs))"
  apply (induct xs)
   apply auto
  done

lemma "exs P xs = (\<not>(alls (\<lambda>x. (\<not> P x)) xs))"
  apply (induct xs)
   apply auto
  done

fun is_in :: "'a \<Rightarrow> 'a list \<Rightarrow> bool" where
"is_in x Nil = False" |
"is_in x (y # xs) = (if x=y then True else (is_in x xs))"

lemma "is_in a xs = (exs (\<lambda>x. a=x) xs)"
  apply (induct xs)
  apply auto
  done

fun nodups :: "'a list \<Rightarrow> bool" where
"nodups Nil = True" | "nodups (x # xs) = ((\<not>(is_in x xs)) \<and> (nodups xs))"

fun del_element :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
"del_element x Nil = Nil" |
"del_element x (y # xs) = (if x=y then (del_element x xs) else (y # (del_element x xs)))"

fun deldups :: "'a list \<Rightarrow> 'a list" where
"deldups Nil = Nil" | "deldups (x # xs) = (x # (del_element x (deldups xs)))"

lemma reduction [simp]: "length (del_element x xs) \<le> length xs"
  apply (induct xs)
   apply auto
  done

theorem "length (deldups xs) <= length xs"
proof (induct xs)
case Nil
then show ?case
  by simp
next
  case (Cons a xs)
  then show ?case
  proof -
    have "length (del_element a (deldups xs)) \<le> length xs"
    by (meson Cons.hyps dual_order.trans reduction)
    then show ?thesis
      by simp
    qed
qed

lemma del_no [simp]: "\<not> (is_in x xs) \<Longrightarrow> \<not> (is_in x (del_element a xs))"
  apply (induct xs)
   apply auto
  done

lemma [simp]: "\<not> is_in a (del_element a xs)"
  apply (induct xs)
   apply auto
  done

lemma no_dup_no_dup [simp]: "nodups xs \<Longrightarrow> (nodups (del_element a xs))"
proof (induct xs arbitrary: a rule: nodups.induct)
  case 1
  then show ?case by simp
next
  case (2 x xs)
  then show ?case by simp
qed

theorem "nodups (deldups xs)"
proof (induct xs)
case Nil
then show ?case by simp
next
  case (Cons a xs)
  then show ?case by simp
qed

theorem "deldups (rev xs) = rev (deldups xs)"
  nitpick
  oops

end


theory PropLib
imports FOL
begin

theorem FalseI: "\<not> P \<and> P \<Longrightarrow> False"
  apply(rule mp[where P="\<not>P \<and> P"])

    --\<open>first goal @{term "\<not> P \<and> P \<longrightarrow> False"}\<close>
    apply(rule conjunct1[where Q="False \<longrightarrow> \<not> P \<and> P"])
    apply(fold iff_def)
    apply(rule FOL.IFOL_simps(9))

    --\<open>second goal @{term "\<not> P \<and> P"}\<close>
    apply(assumption)
  done

lemma impI2': "P \<longrightarrow> Q \<Longrightarrow> \<not> P \<or> Q"
  apply(unfold not_disj_iff_imp)
  apply(assumption)
  done

lemma disjE2: "A \<or> A \<Longrightarrow> A"
  apply(erule disjE)
  apply(assumption)+
  done

lemma disjE2': "\<not>\<not>A \<or> A \<Longrightarrow> A"
  apply(erule disjE)
  apply(rule notnotD)
  apply(assumption)+
  done

theorem add1: "(A \<longleftrightarrow> \<not> A) \<longleftrightarrow> False"
  apply(unfold iff_def)
  apply(rule conjI)
    --\<open>first goal\<close>
    apply(rule impI)
    apply(rule FalseI[where P="A"])
    apply(rule conjI)
      --\<open>first goal\<close>
      apply(erule conjE[where P="(A \<longrightarrow> \<not> A)" and Q="(\<not> A \<longrightarrow> A)"])
      apply(rule disjE2)
      apply(rule impI2')
      apply(assumption)
      --\<open>second goal\<close>
      apply(erule conjE)
      apply(rule disjE2')
      apply(rule impI2')
      apply(assumption)
    --\<open>second goal\<close>
    apply(rule impI)
    apply(erule FalseE)
  done

end


theory Week2

imports Main Week1

begin

print_statement notE
(*2 Negation Elimination v1*)

lemma negative_paradox: "\<not> A\<longrightarrow> A\<longrightarrow> B"
proof (rule impI)
  assume "\<not>A"
  show "A\<longrightarrow> B"
  proof
    assume A
    with `\<not> A` show B by (rule notE)
(*
from `\<not> A` have B using `A` by (rule notE)
thus B.*)
(*then show B using `\<not> A` by blast: not working*)
  qed
qed

(*2 Negation Elimination v1*)

lemma "A\<longrightarrow> \<not>A\<longrightarrow> B"
proof (rule impI)
  assume A
  show "\<not>A\<longrightarrow> B"
  proof
    assume "\<not>A"
    then show B using `A` by (rule notE)
(*with `A` show B by (rule notI: not working*)
  qed
qed

lemma modus_tollens: "(A\<longrightarrow> B) \<longrightarrow>(\<not> B\<longrightarrow> \<not> A)"
proof(rule impI)
  assume "A\<longrightarrow> B"
  show "\<not>B\<longrightarrow> \<not>A"
  proof (rule impI)
    assume "\<not>B"
    show "\<not>A"
    proof (rule notI)
      assume A
      with `A \<longrightarrow> B` have B by (rule mp)
      with `\<not>B` show False by (rule notE) (*HOW*)
    qed
  qed
qed

lemma "\<not>(A\<longrightarrow> B)\<longrightarrow> \<not>B"
proof (rule impI)
  assume "\<not>(A\<longrightarrow> B)"
  show "\<not>B"
  proof (rule notI)
    assume B
    have "A\<longrightarrow> B"
    proof (rule impI)
      assume A
      from `B` show B.
          qed
          with `\<not>(A\<longrightarrow> B )` show False by (rule notE ) (*HOW*)

  qed
qed

thm ccontr
lemma contradiction: "(\<not> A\<longrightarrow> False)\<longrightarrow> A"
proof (rule impI)
  assume "(\<not> A\<longrightarrow> False)"
  show A
  proof (rule ccontr)
    assume "\<not>A"
    with `\<not> A \<longrightarrow> False` show False by (rule mp )
  qed
qed

print_statement notE
lemma double_negation_elimination: "\<not>\<not>A \<longrightarrow> A"
proof(rule impI)
  assume "\<not>\<not>A"
  show A
  proof(rule ccontr)
    assume "\<not>A"
    with `\<not>\<not>A` show False by (rule notE)
  qed
qed

(*Exercises*)
print_statement contrapos_pn
lemma "A \<Longrightarrow> \<not>\<not>A"
proof
  assume A
  show "\<not>A \<Longrightarrow> False"
  proof(rule ccontr)
    assume "\<not>A"
    with `A` show False by blast
    qed
  qed

(*difference in proofs*)
lemma "A \<longrightarrow> \<not>\<not>A"
proof (rule impI)
  assume A
  show "\<not>\<not>A"
  proof (rule notI)
    assume "\<not>A"
    with `A` show False by blast
  qed
qed

lemma contraposition:  "(A\<longrightarrow> \<not>B)\<longrightarrow> (B\<longrightarrow> \<not>A)"
proof (rule impI)
  assume "(A\<longrightarrow> \<not>B)"
  show "(B\<longrightarrow> \<not>A)"
  proof (rule impI)
    assume B
    show "\<not>A"
    proof
      assume A
      from `A\<longrightarrow> \<not>B` have "\<not>B" using `A` by (rule mp)
      then show False using `B` by (rule notE)
    qed
  qed
qed

thm ccontr
lemma "(\<not>B \<longrightarrow> \<not>A)\<longrightarrow>(A\<longrightarrow> B)"
proof (rule impI)
  assume "(\<not>B \<longrightarrow> \<not>A)"
  show "A\<longrightarrow> B"
  proof (rule impI)
    assume A
    show B
    proof (rule ccontr)
      assume "\<not>B"
      with `\<not>B \<longrightarrow> \<not>A` have "\<not>A" by (rule mp)
(* from `\<not>B \<longrightarrow> \<not>A` have "\<not>A" using `\<not>B` by (rule mp )*)
      thus False using `A` by (rule notE)
    qed
  qed
qed

lemma "A \<longrightarrow> \<not> (A \<longrightarrow> \<not> A)"
proof (rule impI)
  assume A
  show "\<not>(A \<longrightarrow> \<not> A)"
  proof (rule notI)
    assume "(A \<longrightarrow> \<not> A)"
    from `A \<longrightarrow> \<not>A` have "\<not>A" using `A` by (rule mp)
    thus False using `A` by (rule notE)
  qed
qed

lemma god_exists: "\<not>(A\<longrightarrow> B) \<longrightarrow> A"  (*similar to "\<not>(A\<longrightarrow> B)\<longrightarrow> \<not>B" *)
proof (rule impI)
  assume "\<not>(A\<longrightarrow> B)"
  show A
  proof (rule ccontr)
    assume "\<not>A"
    have "A \<longrightarrow> B"
    proof (rule impI)
      assume A
      with `\<not> A` show B by (rule notE)
    qed
    with `\<not> (A \<longrightarrow> B )` show False by (rule notE )
        qed
      qed

end


(* Author: Lukas Koller *)
theory CompleteGraph
  imports Main tsp.Misc tsp.Berge
begin

definition "is_complete E \<equiv> (\<forall>u v. u \<in> Vs E \<and> v \<in> Vs E \<and> u \<noteq> v \<longrightarrow> {u,v} \<in> E)"

lemma is_completeI: "(\<And>u v. u \<in> Vs E \<Longrightarrow> v \<in> Vs E \<Longrightarrow> u \<noteq> v \<Longrightarrow> {u,v} \<in> E) \<Longrightarrow> is_complete E"
  unfolding is_complete_def by auto

lemma is_completeE: "is_complete E \<Longrightarrow> u \<in> Vs E \<Longrightarrow> v \<in> Vs E \<Longrightarrow> u \<noteq> v \<Longrightarrow> {u,v} \<in> E"
  unfolding is_complete_def by auto

definition "complete_graph V \<equiv> {{u,v} | u v. u \<in> V \<and> v \<in> V \<and> u \<noteq> v}"

text \<open>With @{const complete_graph} we construct a complete graph for a given set of vertices.\<close>

lemma complete_graph_Vs_subset: "Vs (complete_graph V) \<subseteq> V" (is "Vs ?E\<^sub>V \<subseteq> V")
proof
  fix v
  assume "v \<in> Vs ?E\<^sub>V"
  then obtain e where "v \<in> e" "e \<in> ?E\<^sub>V"
    by (elim vs_member_elim)
  thus "v \<in> V"
    by (auto simp: complete_graph_def)
qed

lemma complete_graph_memberI:
  assumes "u \<in> V" "v \<in> V" "u \<noteq> v"
  shows "{u,v} \<in> complete_graph V"
  unfolding complete_graph_def using assms by auto

lemma complete_graph_memberE:
  assumes "e \<in> complete_graph V"
  obtains u v where "e = {u,v}" "u \<in> V" "v \<in> V" "u \<noteq> v"
  using assms[unfolded complete_graph_def] by auto

lemma complete_graph_union: "complete_graph V\<^sub>1 \<union> complete_graph V\<^sub>2 \<subseteq> complete_graph (V\<^sub>1 \<union> V\<^sub>2)"
proof
  fix e
  assume "e \<in> complete_graph V\<^sub>1 \<union> complete_graph V\<^sub>2"
  then consider "e \<in> complete_graph V\<^sub>1" | "e \<in> complete_graph V\<^sub>2"
    by auto
  thus "e \<in> complete_graph (V\<^sub>1 \<union> V\<^sub>2)"
    by cases (auto elim: complete_graph_memberE simp: complete_graph_def)
qed

context graph_abs
begin

lemma subset_complete_graph:
  assumes "Vs E \<subseteq> V"
  shows "E \<subseteq> complete_graph V"
proof
  fix e
  assume "e \<in> E"
  then obtain u v where "e = {u,v}" and "u \<noteq> v"
    using graph by auto
  moreover hence "u \<in> Vs E" "v \<in> Vs E"
    using \<open>e \<in> E\<close> by (auto intro: vs_member_intro)
  moreover hence "u \<in> V" "v \<in> V"
    using assms by auto
  ultimately show "e \<in> complete_graph V"
    unfolding complete_graph_def by auto
qed

lemma Vs_complete_graph_eq_V:
  assumes "card V \<noteq> 1"
  shows "Vs (complete_graph V) = V"
proof
  show "V \<subseteq> Vs (complete_graph V)"
  proof
    fix v
    assume "v \<in> V"
    moreover then obtain u where "u \<in> V" "u \<noteq> v"
      using assms by (elim card_neq_1_obtain_mem) auto
    ultimately have "{v,u} \<in> complete_graph V"
      unfolding complete_graph_def by auto
    thus "v \<in> Vs (complete_graph V)"
      by (intro edges_are_Vs)
  qed
qed (rule complete_graph_Vs_subset)

end

lemma complete_graph_is_complete: "is_complete (complete_graph V)" (is "is_complete ?E\<^sub>V")
proof (rule is_completeI)
  fix u v
  assume "u \<in> Vs ?E\<^sub>V" "v \<in> Vs ?E\<^sub>V" "u \<noteq> v"
  moreover hence "u \<in> V" "v \<in> V"
    using complete_graph_Vs_subset by fastforce+
  ultimately show "{u,v} \<in> ?E\<^sub>V"
    by (auto simp: complete_graph_def)
qed

lemma complete_graph_empty: "complete_graph {} = {}"
  unfolding complete_graph_def by auto

lemma complete_graph_insert:
  "complete_graph (insert v V) = complete_graph V \<union> {{u,v} | u. u \<in> V \<and> u \<noteq> v}"
  unfolding complete_graph_def by auto

lemma finite_complete_graph:
  assumes "finite V"
  shows "finite (complete_graph V)"
  using assms by (induction V) (auto simp: complete_graph_insert complete_graph_empty)

lemma graph_complete_graph:
  assumes "finite V"
  shows "graph_invar (complete_graph V)"
proof (rule graph_invarI2)
  show "finite (complete_graph V)"
    using assms by (rule finite_complete_graph)
  show "\<And>e. e\<in>complete_graph V \<Longrightarrow> \<exists>u v. e = {u,v} \<and> u \<noteq> v"
    by (auto simp: complete_graph_def)
qed

locale compl_graph_abs =
  graph_abs E for E +
  assumes complete: "is_complete E"
begin

lemma edge_in_E_intro: "u \<in> Vs E \<Longrightarrow> v \<in> Vs E \<Longrightarrow> u \<noteq> v \<Longrightarrow> {u,v} \<in> E"
  using complete[unfolded is_complete_def] by auto

text \<open>In a complete graph any sequence of nodes is a path.\<close>
lemma path_complete_graph:
  assumes "distinct_adj P" (* assumption: consecutive nodes are not equal! *)
      and "set P \<subseteq> Vs E"
  shows "path E P"
  using assms complete
proof (induction P rule: list012.induct)
  case (3 u v P)
  moreover hence "{u,v} \<in> E"
    by (auto intro: edge_in_E_intro)
  moreover have "path E (v#P)"
    using calculation by (auto simp: distinct_adj_ConsD)
  ultimately show ?case
    by (auto intro: path.intros)
qed auto

lemma prepend_path_by_vertex:
  assumes "path E P" "w \<in> Vs E" "P \<noteq> [] \<Longrightarrow> hd P \<noteq> w"
  shows "path E (w#P)"
proof cases
  assume "P = []"
  thus ?thesis
    using assms by (auto intro: path.intros)
next
  assume "P \<noteq> []"
  moreover hence "hd P \<noteq> w"
    using assms by auto
  moreover have "hd P \<in> Vs E"
    using assms calculation by (intro mem_path_Vs) auto
  ultimately have "{w,hd P} \<in> E"
    using assms by (auto intro: edge_in_E_intro)
  hence "path E ([w] @ P)"
    using assms by (intro path_append) auto
  thus ?thesis
    by auto
qed

lemma extend_path_by_vertex:
  assumes "path E P" "v \<in> Vs E" "P \<noteq> [] \<Longrightarrow> last P \<noteq> v"
  shows "path E (P @ [v])"
proof cases
  assume "P = []"
  thus ?thesis
    using assms by (auto intro: path.intros)
next
  assume "P \<noteq> []"
  moreover hence "last P \<noteq> v"
    using assms by auto
  moreover have "last P \<in> Vs E"
    using assms calculation by (intro mem_path_Vs) auto
  ultimately have "{last P,v} \<in> E"
    using assms by (auto intro: edge_in_E_intro)
  thus ?thesis
    using assms by (auto intro: path_append path.intros)
qed

lemma distinct_path_through_vertices:
  assumes "V \<subseteq> Vs E"
  obtains P where "path E P" "distinct P" "set P = V"
  using finite_vertices[OF assms(1)] assms
proof -
  obtain P where "set P = V" "distinct P"
    using finite_vertices[OF assms(1)] finite_distinct_list by auto
  moreover hence "path E P"
    using assms by (auto intro: path_complete_graph simp: distinct_distinct_adj)
  ultimately show ?thesis
    using that by auto
qed

lemma extend_path_by_edge_last_neq:
  assumes "path E P" "{u,v} \<in> E" "P \<noteq> [] \<Longrightarrow> last P \<noteq> u"
  shows "path E (P @ [u,v])"
proof cases
  assume "P = []"
  thus ?thesis
    using assms by (auto intro: edge_is_path)
next
  assume "P \<noteq> []"
  moreover hence "last P \<in> Vs E"
    using assms path_Vs_subset[of E P] by auto
  moreover have "u \<in> Vs E"
    using assms by (auto intro: vs_member_intro)
  moreover hence "{last P,u} \<in> E"
    using assms calculation by (auto intro: edge_in_E_intro)
  moreover have "path E [u,v]"
    using assms by (auto intro: edge_is_path)
  ultimately show ?thesis
    using assms by (auto intro: path_append)
qed

lemma extend_path_by_edge:
  assumes "path E P" "e \<in> E"
  obtains u v where "e = {u,v}" "path E (P @ [u,v])"
proof -
  obtain u v where [simp]: "e = {u,v}" "u \<noteq> v"
    using assms graph by auto
  then consider "P = []" "{u,v} \<in> E" | "last P \<noteq> u" "{u,v} \<in> E" | "last P \<noteq> v" "{v,u} \<in> E"
    using assms by (fastforce simp: insert_commute)
  thus ?thesis
    using assms that by cases (intro that, auto intro: extend_path_by_edge_last_neq)
qed

end

locale restr_compl_graph_abs =
  compl_graph_abs E +
  restr_graph_abs E V for V and E +
  assumes V_subset: "V \<subseteq> Vs E"
begin

lemma E\<^sub>V_complete: "is_complete E\<^sub>V"
proof (rule is_completeI)
  fix u v
  assume "u \<in> Vs E\<^sub>V" "v \<in> Vs E\<^sub>V" "u \<noteq> v"
  moreover hence "u \<in> Vs E" "v \<in> Vs E"
    using Vs_subset[of E\<^sub>V E] by (auto simp: E\<^sub>V_def)
  moreover have "{u,v} \<in> E"
    using calculation by (auto intro: edge_in_E_intro)
  moreover have "u \<in> V"
    using calculation Vs_subset_restr_graph by (fastforce simp: E\<^sub>V_def)
  moreover have "v \<in> V"
    using calculation Vs_subset_restr_graph by (fastforce simp: E\<^sub>V_def)
  ultimately show "{u,v} \<in> E\<^sub>V"
    by (auto simp: E\<^sub>V_def)
qed

lemma edge_in_E\<^sub>V_intro: "u \<in> Vs E\<^sub>V \<Longrightarrow> v \<in> Vs E\<^sub>V \<Longrightarrow> u \<noteq> v \<Longrightarrow> {u,v} \<in> E\<^sub>V"
  using E\<^sub>V_complete[unfolded is_complete_def] by auto

lemma Vs_E\<^sub>V_eq_V:
  assumes "card V \<noteq> 1"
  shows "Vs E\<^sub>V = V"
  using assms
proof (intro equalityI)
  show "V \<subseteq> Vs E\<^sub>V"
  proof (cases "V = {}")
    assume "V \<noteq> {}"
    show ?thesis
    proof
      fix v
      assume "v \<in> V"
      moreover then obtain u where "u \<in> V - {v}"
        using assms \<open>V \<noteq> {}\<close>
        by (metis is_singletonI' is_singleton_altdef member_remove remove_def) (* TODO: clean up *)
      moreover have "v \<in> Vs E" "u \<in> Vs E" "u \<noteq> v"
        using V_subset assms calculation by auto
      moreover hence "{u,v} \<in> E"
        using assms by (auto intro: edge_in_E_intro)
      ultimately have "{u,v} \<in> E\<^sub>V"
        unfolding E\<^sub>V_def using assms by auto
      thus "v \<in> Vs E\<^sub>V"
        by (auto intro: vs_member_intro)
    qed
  qed auto
qed (auto simp: Vs_subset_restr_graph)

lemma path_on_E\<^sub>V:
  assumes "card V \<noteq> 1"
      and "path E P" "set P \<subseteq> V"
  shows "path E\<^sub>V P"
proof (rule subset_path)
  show "path E P"
    using assms by auto
  show "set (edges_of_path P) \<subseteq> E\<^sub>V"
  proof
    fix e
    assume "e \<in> set (edges_of_path P)"
    moreover hence "e \<in> E"
      using assms calculation path_edges_subset by blast
    moreover have "e \<subseteq> V"
      using assms calculation edge_of_path_subset_of_vpath by blast
    ultimately show "e \<in> E\<^sub>V"
      unfolding E\<^sub>V_def by auto
  qed
  have "Vs E\<^sub>V = V"
    using assms by (intro Vs_E\<^sub>V_eq_V) auto
  thus "set P \<subseteq> Vs E\<^sub>V"
    using assms by auto
qed

lemma last_short_cut:
  assumes "u \<in> Vs E\<^sub>V" "w \<in> Vs E\<^sub>V"
  shows "last (short_cut E\<^sub>V (u#P @ [w])) = w"
  using assms edge_in_E\<^sub>V_intro
proof (induction "u#P" arbitrary: u P rule: short_cut.induct)
  case (3 E\<^sub>V u v P)
  thus ?case
  proof cases
    assume "{u,v} \<in> E\<^sub>V"
    moreover hence "v \<in> Vs E\<^sub>V"
      by (auto intro: edges_are_Vs)
    ultimately show ?case
      using 3 last_short_cut_simp[of u E\<^sub>V] by auto
  qed auto
qed auto

lemma last_short_cut2:
  assumes "P \<noteq> []" "hd P \<in> Vs E\<^sub>V" "last P \<in> Vs E\<^sub>V"
  shows "last (short_cut E\<^sub>V P) = last P"
  using assms last_short_cut
proof -
  consider u where "P = [u]" | u w P' where "P = u#P' @ [w]"
    using assms by (metis neq_Nil_conv rev_exhaust)
  thus ?thesis
    using assms last_short_cut by cases auto
qed

lemma short_cut_path:
  assumes "path E (u#P)" "u \<in> Vs E\<^sub>V" "card V \<noteq> 1"
  shows "path E\<^sub>V (short_cut E\<^sub>V (u#P))"
proof (intro path_intro2)
  show "set (edges_of_path (short_cut E\<^sub>V (u#P))) \<subseteq> E\<^sub>V"
    by (intro short_cut_edges)
  show "set (short_cut E\<^sub>V (u#P)) \<subseteq> Vs E\<^sub>V"
    using assms by (intro short_cut_Vs_subset) auto
qed

lemma set_short_cut:
  assumes "u \<in> Vs E\<^sub>V"
  shows "set (short_cut E\<^sub>V (u#P)) = (set (u#P) \<inter> Vs E\<^sub>V) \<union> {u}"
  using assms edge_in_E\<^sub>V_intro
proof (induction "u#P" arbitrary: u P rule: short_cut.induct)
  case (3 E\<^sub>V u v P)
  thus ?case
  proof cases
    assume "{u,v} \<in> E\<^sub>V"
    moreover hence "v \<in> Vs E\<^sub>V"
      by (auto simp: edges_are_Vs)
    ultimately show ?thesis
      using 3 by auto
  next
    assume "{u,v} \<notin> E\<^sub>V"
    then consider "u = v" | "v \<notin> Vs E\<^sub>V"
      using "3.prems" by auto
    thus ?case
      using 3 \<open>{u,v} \<notin> E\<^sub>V\<close> by cases auto
  qed
qed auto

lemma short_cut_Vs_superset:
  assumes "u \<in> Vs E\<^sub>V" "Vs E\<^sub>V \<subseteq> set (u#P)"
  shows "Vs E\<^sub>V \<subseteq> set (short_cut E\<^sub>V (u#P))"
  using assms set_short_cut[of u P] by auto

end

context compl_graph_abs
begin

lemma restr_graph_compl: "V \<subseteq> Vs E \<Longrightarrow> is_complete {e \<in> E. e \<subseteq> V}"
  by (intro restr_compl_graph_abs.E\<^sub>V_complete) unfold_locales

lemma restr_graph_Vs: "V \<subseteq> Vs E \<Longrightarrow> card V \<noteq> 1 \<Longrightarrow> Vs {e \<in> E. e \<subseteq> V} = V"
  by (intro restr_compl_graph_abs.Vs_E\<^sub>V_eq_V) unfold_locales

end

(* section \<open>Computing Complete Graphs\<close>

text \<open>Compute a complete graph for a list of vertices.\<close>
fun compl_graph :: "'a list \<Rightarrow> 'a set list" where
  "compl_graph [] = []"
| "compl_graph (u#vs) = (map (\<lambda>v. {u,v}) vs) @ compl_graph vs"

lemma Vs_compl_graph_len_neq1:
  assumes "length vs \<noteq> 1"
  shows "Vs (set (compl_graph vs)) = set vs"
  using assms by (induction vs rule: list012.induct) (auto simp: Vs_def)

lemma Vs_compl_graphE:
  obtains "Vs (set (compl_graph vs)) = {}" "length vs \<le> 1" | "Vs (set (compl_graph vs)) = set vs"
proof (induction vs rule: list012.induct)
  case (3 u v vs)
  moreover hence "Vs (set (compl_graph (u#v#vs))) = set (u#v#vs)"
    by (intro Vs_compl_graph_len_neq1) auto
  ultimately show ?case
    by auto
qed (auto simp: Vs_def)

lemma "v \<in> set vs \<Longrightarrow> {u,v} \<in> set (compl_graph (u#vs))"
  by auto

lemma compl_graph_append_subset: "set (compl_graph vs\<^sub>2) \<subseteq> set (compl_graph (vs\<^sub>1 @ vs\<^sub>2))"
  by (induction vs\<^sub>1) auto

lemma compl_graph_is_complete: "is_complete (set (compl_graph vs))"
proof (intro is_completeI)
  fix u v
  assume "u \<in> Vs (set (compl_graph vs))" "v \<in> Vs (set (compl_graph vs))" "u \<noteq> v"
  moreover then consider "Vs (set (compl_graph vs)) = {}" "length vs \<le> 1"
    | "Vs (set (compl_graph vs)) = set vs"
    by (elim Vs_compl_graphE)
  ultimately have "u \<in> set vs" "v \<in> set vs"
    by auto
  moreover assume "u \<noteq> v"
  ultimately consider vs\<^sub>1 vs\<^sub>2 where "vs = vs\<^sub>1 @ u#vs\<^sub>2" "v \<in> set vs\<^sub>2"
    | vs\<^sub>1 vs\<^sub>2 where "vs = vs\<^sub>1 @ v#vs\<^sub>2" "u \<in> set vs\<^sub>2"
    by (elim list_split_for_2elems[of u vs v])
  thus "{u,v} \<in> set (compl_graph vs)"
  proof cases
    fix vs\<^sub>1 vs\<^sub>2
    assume "vs = vs\<^sub>1 @ u#vs\<^sub>2" "v \<in> set vs\<^sub>2"
    moreover hence "{u,v} \<in> set (compl_graph (u#vs\<^sub>2))"
      by auto
    ultimately show ?thesis
      using compl_graph_append_subset by blast
  next
    fix vs\<^sub>1 vs\<^sub>2
    assume "vs = vs\<^sub>1 @ v#vs\<^sub>2" "u \<in> set vs\<^sub>2"
    moreover hence "{u,v} \<in> set (compl_graph (v#vs\<^sub>2))"
      by auto
    ultimately show ?thesis
      using compl_graph_append_subset by blast
  qed
qed *)

end