(*  Title:      RSAPSS/Productdivides.thy
    Author:     Christina Lindenberg, Kai Wirt, Technische Universität Darmstadt
    Copyright:  2005 - Technische Universität Darmstadt
*)

header "Lemmata for modular arithmetic with primes"

theory Productdivides
imports Pdifference
begin

lemma productdivides_lemma: "\<lbrakk>x mod z = (0::nat)\<rbrakk> \<Longrightarrow> ((y*x) mod (y*z) = 0)"
  apply (subst mod_eq_0_iff [of "y*x" "y*z"])
  apply auto
  done

lemma productdivides: "\<lbrakk>x mod a = (0::nat); x mod b = 0; prime a; prime b; a \<noteq> b\<rbrakk> \<Longrightarrow> x mod (a*b) = 0"
  apply (simp add: mod_eq_0_iff [of x a])
  apply (erule exE)
  apply (simp)
  apply (rule disjI2)
  apply (simp add: dvd_eq_mod_eq_0 [symmetric])
  apply (drule prime_dvd_mult_nat [of b])
  apply (erule disjE)
  apply auto
  apply (simp add: prime_nat_def)
  apply auto
  done

lemma specializedtoprimes1:
  fixes p::nat
  shows "\<lbrakk>prime p; prime q; p \<noteq> q; a mod p = b mod p ; a mod q = b mod q\<rbrakk>
         \<Longrightarrow> a mod (p*q) = b mod (p*q)"
by (metis equalmodstrick1 equalmodstrick2 productdivides)

lemma specializedtoprimes1a:
 fixes p::nat
 shows "\<lbrakk>prime p; prime q; p \<noteq> q; a mod p = b mod p; a mod q = b mod q; b < p*q \<rbrakk>
    \<Longrightarrow> a mod (p*q) = b"
by (metis Divides.mod_less specializedtoprimes1)

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_bin_nat_times
imports "../../Test_Base"
begin

datatype Nat = Z | S "Nat"

datatype Bin = One | ZeroAnd "Bin" | OneAnd "Bin"

fun s :: "Bin => Bin" where
"s (One) = ZeroAnd One"
| "s (ZeroAnd xs) = OneAnd xs"
| "s (OneAnd ys) = ZeroAnd (s ys)"

fun plus2 :: "Bin => Bin => Bin" where
"plus2 (One) y = s y"
| "plus2 (ZeroAnd z) (One) = s (ZeroAnd z)"
| "plus2 (ZeroAnd z) (ZeroAnd ys) = ZeroAnd (plus2 z ys)"
| "plus2 (ZeroAnd z) (OneAnd xs) = OneAnd (plus2 z xs)"
| "plus2 (OneAnd x2) (One) = s (OneAnd x2)"
| "plus2 (OneAnd x2) (ZeroAnd zs) = OneAnd (plus2 x2 zs)"
| "plus2 (OneAnd x2) (OneAnd ys2) = ZeroAnd (s (plus2 x2 ys2))"

fun times :: "Bin => Bin => Bin" where
"times (One) y = y"
| "times (ZeroAnd xs1) y = ZeroAnd (times xs1 y)"
| "times (OneAnd xs12) y = plus2 (ZeroAnd (times xs12 y)) y"

fun plus :: "Nat => Nat => Nat" where
"plus (Z) y = y"
| "plus (S z) y = S (plus z y)"

fun times2 :: "Nat => Nat => Nat" where
"times2 (Z) y = Z"
| "times2 (S z) y = plus y (times2 z y)"

fun toNat :: "Bin => Nat" where
"toNat (One) = S Z"
| "toNat (ZeroAnd xs) = plus (toNat xs) (toNat xs)"
| "toNat (OneAnd ys) = plus (plus (S Z) (toNat ys)) (toNat ys)"

theorem property0 :
  "((toNat (times x y)) = (times2 (toNat x) (toNat y)))"
  oops

end


(******************************************************************************)
(* Project: Isabelle/UTP Toolkit                                              *)
(* File: List_Lexord_Alt.thy                                                  *)
(* Authors: Simon Foster and Frank Zeyda                                      *)
(* Emails: simon.foster@york.ac.uk and frank.zeyda@york.ac.uk                 *)
(******************************************************************************)

section \<open>Alternative List Lexicographic Order\<close>

theory List_Lexord_Alt
  imports Main
begin

text \<open> Since we can't instantiate the order class twice for lists, and we want prefix as
  the default order for the UTP we here add syntax for the lexicographic order relation. \<close>

definition list_lex_less :: "'a::linorder list \<Rightarrow> 'a list \<Rightarrow> bool" (infix "<\<^sub>l" 50)
where "xs <\<^sub>l ys \<longleftrightarrow> (xs, ys) \<in> lexord {(u, v). u < v}"

lemma list_lex_less_neq [simp]: "x <\<^sub>l y \<Longrightarrow> x \<noteq> y"
  apply (simp add: list_lex_less_def)
  apply (meson case_prodD less_irrefl lexord_irreflexive mem_Collect_eq)
done

lemma not_less_Nil [simp]: "\<not> x <\<^sub>l []"
  by (simp add: list_lex_less_def)

lemma Nil_less_Cons [simp]: "[] <\<^sub>l a # x"
  by (simp add: list_lex_less_def)

lemma Cons_less_Cons [simp]: "a # x <\<^sub>l b # y \<longleftrightarrow> a < b \<or> a = b \<and> x <\<^sub>l y"
  by (simp add: list_lex_less_def)
end


theory Generators
imports Main  "HOL-Library.FuncSet" "HOL-Algebra.Group"
begin

datatype ('a,'b) monoidgentype = C 'a  'b (infix "!" 63)

datatype ('a,'b) groupgentype = P "('a,'b) monoidgentype"
                               | N  "('a,'b) monoidgentype"

type_synonym ('a,'b) word = "(('a,'b) groupgentype) list"

primrec inverse::"('a,'b) groupgentype \<Rightarrow> ('a,'b) groupgentype"
  where
"inverse (P x) = (N x)"
|"inverse (N x) = (P x)"

primrec wordinverse::"('a,'b) word \<Rightarrow> ('a, 'b) word"
  where
"wordinverse [] = []"
|"wordinverse (x#xs) =  (wordinverse xs)@[inverse x]"

inductive_set spanset::"('a,'b) word set\<Rightarrow> ('a,'b) word set" ("\<langle>_\<rangle>")
  for S::"('a,'b) word set"
  where
"x \<in> S \<Longrightarrow> x \<in> \<langle>S\<rangle>"
|"x \<in> inver ` S \<Longrightarrow> x \<in> \<langle>S\<rangle>"
|"x \<in> S \<Longrightarrow> y \<in> \<langle>S\<rangle> \<Longrightarrow> x@y \<in> \<langle>S\<rangle>"
|"x \<in> inver ` S \<Longrightarrow> ys \<in> \<langle>S\<rangle> \<Longrightarrow> x@y \<in> \<langle>S\<rangle>"

definition setlistcross::"'a set \<Rightarrow> 'a list \<Rightarrow> 'a list set"
 where
"setlistcross S xs = {[s]@xs | s. s \<in> S}"

value "setlistcross {(1::nat), 2, 3} [(4::nat), 5, 6]"

primrec lengthword::"nat \<Rightarrow> 'a set \<Rightarrow> 'a list set"
  where
"lengthword 0 S = {[s] | s. s \<in> S}"
|"lengthword (Suc n) S = \<Union> {setlistcross S xs | xs. xs \<in> (lengthword n S)}"

abbreviation "ngroupword \<equiv> \<lambda> n (S::('a,'b) word set). lengthword n (S \<union> (wordinverse ` S))"

datatype char = G | H

value "ngroupword 1 {[P (C G (1::nat))], [N (C G (2::nat))], [P (C H (3::nat))]}"

(*reduction removes cancellations next to each other*)
fun reduction:: "('a,'b) word \<Rightarrow> ('a,'b) word"
 where
"reduction [] = []"
|"reduction [x] = [x]"
|"reduction (g1#g2#wrd) = (if (g1 = inverse g2)
                             then reduction wrd
                             else (g1#(reduction (g2#wrd))))"

value "reduction [P (C G (3::nat)), N (C G (3::nat)), (N (C G (2::nat)))]"

fun reduced::"('a,'b) word \<Rightarrow> bool"
  where
"reduced [] = True"
|"reduced [g] = True"
|"reduced (g#h#wrd) = (if (g \<noteq> inverse h) then reduced (h#wrd) else False)"

primrec iter::"nat \<Rightarrow>('a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a)"
  where
"iter 0 f = (\<lambda> x. x)"
|"iter (Suc n) f = (\<lambda> x. f ((iter n f) x))"

(*Prove the following*)
lemma fixedpt_iteration:
  assumes "f x = x"
  shows "iter (n+1) f x = x"
  using assms
proof(induction n)
  case 0
  then show ?case by simp
next
  case (Suc n)
  then show ?case by simp
qed

lemma iterative_fixed_pt:
  assumes "iter (n+1) f x = iter n f x"
  shows "iter (k+(n+1)) f x = iter (k+n) f x"
  using assms
proof(induction k)
  case 0
  then show ?case
    by force
next
  case (Suc m)
  have "iter (m + (n + 1)) f x = iter (Suc m + n) f x" by simp
  then show ?case using Suc.IH Suc.prems by fastforce
qed

(*prove converse of the following too*)
lemma assumes "reduced wrd"
  shows "reduction wrd = wrd"
  using assms
proof(induction wrd rule: reduction.induct)
  case 1
  then show ?case by simp
next
  case (2 x)
  then show ?case by simp
next
  case (3 g1 g2 wrd)
  then show ?case
  proof(cases "g1 = inverse g2")
    case True
      then show ?thesis using 3
        by force
    next
    case False
    have "reduced (g2#wrd)" using False 3 by force
      then show ?thesis using False 3 by force
    qed
qed

lemma length_reduction:
 "length (reduction wrd) \<le> length wrd"
proof(induction wrd rule: reduction.induct)
case 1
  then show ?case by simp
next
case (2 x)
  then show ?case by simp
next
  case (3 g1 g2 wrd)
  then show ?case
  proof(cases "g1 = inverse g2")
    case True
    then show ?thesis using 3 by force
  next
    case False
    then show ?thesis using 3
    by auto
 qed
qed

lemma decreasing_length:
  assumes "reduction wrd \<noteq> wrd"
  shows "length (reduction wrd) < length wrd"
  using assms
proof(induction wrd rule: reduction.induct)
case 1
  then show ?case by simp
next
  case (2 x)
  then show ?case by simp
next
  case (3 g1 g2 wrd)
  then show ?case
  proof(cases "g1 = inverse g2")
    case True
    then have red_inv:"reduction (g1#g2#wrd) = reduction wrd" by auto
    then show ?thesis
    proof(cases "reduction wrd = wrd")
      case True
      then have "reduction (g1#g2#wrd) = wrd" using red_inv by auto
      then have "length (reduction (g1#g2#wrd)) = length wrd" by auto
      then show ?thesis
        by simp
    next
      case False
      then have "length (reduction wrd) < length wrd" using 3 True by argo
      then show ?thesis using red_inv by force
    qed
  next
    case False
    have prem:"reduction (g1#g2#wrd) \<noteq> (g1#g2#wrd)" using 3 by argo
    then have "reduction (g1#g2#wrd) = g1#reduction (g2#wrd)" using False by auto
    then have "reduction (g2#wrd) \<noteq> g2#wrd" using prem by fastforce
    then have "length (g2#wrd) > length (reduction (g2#wrd))" using 3 False by blast
    then have "length (g1#g2#wrd) > length (reduction (g1#g2#wrd))" using False by force
    then show ?thesis by fast
  qed
qed

lemma if_length_reduction_eq:
  assumes "length (reduction (wrd)) = length wrd"
  shows "reduction wrd = wrd"
  using assms
proof(induction wrd rule: reduction.induct)
case 1
  then show ?case
    by simp
next
  case (2 x)
  then show ?case by simp
next
case (3 g1 g2 wrd)
  then show ?case
  proof(cases "g1 = inverse g2")
    case True
    then have "reduction (g1#g2#wrd) = reduction (wrd)" by simp
    then have "length (reduction (g1#g2#wrd)) = length (reduction (wrd))" by auto
    moreover have "length (wrd) > length (reduction wrd)" using 3 by (metis \<open>reduction (g1 # g2 # wrd) = reduction wrd\<close> decreasing_length impossible_Cons le_cases)
    then show ?thesis using 3 by auto
  next
    case False
    then show ?thesis using "3.prems" decreasing_length nat_neq_iff by blast
  qed
qed

(*"reduction-reduced lemma"*)
lemma reduction_fixpt:
  assumes "reduction wrd = wrd"
  shows "reduced wrd"
  using assms
proof(induction wrd rule:reduction.induct)
case 1
then show ?case by simp
next
case (2 x)
  then show ?case by simp
next
  case (3 g1 g2 wrd)
  then show ?case by (metis decreasing_length impossible_Cons length_Cons less_Suc_eq less_or_eq_imp_le list.inject reduced.simps(3) reduction.simps(3))
qed

(*Show that length decreases if and only the word after reduction is not the same as the original word*)

(*show that if after reduction of a word it does not change, that subsequent reductions will be ineffective*)

(*use the word length argument decrement argument to show that the reduced word is finally reduced*)

value "reduced  [P (C G (1::nat)), N (C G (2::nat)), P (C G (1::nat))]"

inductive reln::"('a,'b) word \<Rightarrow> ('a,'b) word \<Rightarrow> bool" (infixr "~" 65)
  where
refl[intro!]: "a ~ a" |
sym: "a ~ b \<Longrightarrow> b ~ a" |
trans: "a ~ b \<Longrightarrow> b ~ c \<Longrightarrow> a ~ c" |
base: "[g, inverse g] ~ []" |
mult: "xs ~ xs' \<Longrightarrow> ys ~ ys' \<Longrightarrow> (xs@ys) ~ (xs'@ys')"

lemma assumes "h = inverse g"
  shows "[g, h] ~ []"
  using assms reln.base inverse.simps by simp

lemma relation: "(xs@ys) ~ xs@[g,inverse g]@ys"
  using reln.base reln.refl reln.mult
proof-
  have "(xs@[g, inverse g]) ~ xs" using reln.base reln.mult reln.refl by fastforce
  then show ?thesis using mult[of "xs@[g, inverse g]" "xs" "ys" "ys"] reln.refl reln.sym
    by auto
qed

lemma inverse_of_inverse:
  assumes "g = inverse h"
  shows "h = inverse g"
  using assms inverse.simps
  by (metis groupgentype.exhaust)

lemma rel_to_reduction:"xs ~ reduction xs"
proof(induction xs rule:reduction.induct )
  case 1
  then show ?case
    using reln.refl by auto
next
  case (2 x)
  then show ?case using reln.refl by auto
next
  case (3 g1 g2 wrd)
  then show ?case
  proof(cases "g1 = inverse g2")
    case True
    have "[g1,  g2] ~ []" using reln.base[of "g1"] inverse_of_inverse[of "g1" "g2"] True
      by blast
    then have 1:"([g1,g2]@wrd) ~ wrd" using reln.mult refl by fastforce
    with 3(1) have 2:"reduction ([g1,g2]@wrd) ~ wrd" using reln.trans True
      using append_Cons append_Nil reduction.simps(3) reln.sym by auto
    then show ?thesis using 1 reln.sym reln.trans
      by (metis append_Cons append_Nil)
next
  case False
  then have "([g1]@(g2#wrd)) ~ ([g1]@(reduction (g2#wrd)))" using 3(2) reln.mult reln.refl
    by blast
  then have "([g1]@(g2#wrd)) ~ (reduction (g1#g2#wrd))" using False by simp
  then show ?thesis by simp
qed
qed

definition wordeq::"('a,'b) word \<Rightarrow> ('a,'b) word set" ("[[_]]")
  where
"wordeq wrd = {wrds. wrd ~ wrds}"

(*This is approach for normal form using newsmans lemma*)

definition cancel_at :: "nat \<Rightarrow> ('a,'b) word \<Rightarrow> ('a,'b) word"
where "cancel_at i l = take i l @ drop (2+i) l"

definition cancels_to_1_at ::  "nat \<Rightarrow> ('a,'b) word \<Rightarrow> ('a,'b) word \<Rightarrow> bool"
where  "cancels_to_1_at i l1 l2 = (0\<le>i \<and> (1+i) < length l1
                              \<and> (inverse (l1 ! i) = (l1 ! (1+i)))
                              \<and> (l2 = cancel_at i l1))"

definition cancels_to_1 :: "('a,'b) word \<Rightarrow> ('a,'b) word \<Rightarrow> bool"
where "cancels_to_1 l1 l2 = (\<exists>i. cancels_to_1_at i l1 l2)"

definition cancels_to  :: "('a,'b) word \<Rightarrow> ('a,'b) word \<Rightarrow> bool"
where "cancels_to = (cancels_to_1)^**"

lemma "cancels_to wrd (reduction wrd)"
  sorry

lemma "cancels_to wrd (iter n reduction wrd)"
  sorry

lemma cancels_to_trans [trans]:
  "\<lbrakk> cancels_to a b; cancels_to b c \<rbrakk> \<Longrightarrow> cancels_to a c"
  sorry

lemma "cancels_to x y \<Longrightarrow> x ~ y"
  unfolding cancels_to_def
proof(induction rule: rtranclp.induct)
  case (rtrancl_refl a)
  then show ?case by blast
next
  case (rtrancl_into_rtrancl a b c)
  then have "cancels_to_1 b c" by simp
  then obtain i where i:"cancels_to_1_at i b c" unfolding cancels_to_1_def by meson
  then have c_def:"(take i b)@(drop (i + 2) b) = c" unfolding cancels_to_1_at_def cancel_at_def
    by force
  moreover have "b!i = inverse (b!(i+1))" using i  unfolding cancels_to_1_at_def cancel_at_def
    using inverse_of_inverse
    by (simp add: inverse_of_inverse add.commute)
  then have "[b!i, b!(i+1)] ~ []"
    by (metis base inverse_of_inverse)
  then have "([b!i, b!(i+1)]@(drop (i+2) b)) ~ []@(drop (i+2) b)"
    using reln.refl reln.mult by fast
  then have "((take i b)@(([b!i, b!(i+1)]@(drop (i+2) b)))) ~ (take i b)@(drop (i+2) b)"
    using reln.refl reln.mult
    by (simp add: mult reln.refl)
  then have "b ~ c" using c_def
    by (metis Cons_nth_drop_Suc add.commute add_2_eq_Suc' append_Cons append_self_conv2 cancels_to_1_at_def i id_take_nth_drop linorder_not_less plus_1_eq_Suc trans_le_add2)
  then show ?case using reln.trans rtrancl_into_rtrancl(3) by fast
qed

definition cancels_eq::"('a,'b) word \<Rightarrow> ('a,'b)  word \<Rightarrow> bool"
  where
"cancels_eq = (\<lambda> wrd1 wrd2. cancels_to wrd1 wrd2 \<or> cancels_to wrd2 wrd1)^**"

(*results to prove: cancels eq a b, then (1) cancels eq c@a c@b and (2) cancels eq a@c and b@c*)

(*Try proving this*)
lemma  "x ~ y \<Longrightarrow> cancels_eq x y"
proof(induction rule:reln.induct)
case (refl a)
then show ?case unfolding cancels_eq_def cancels_to_def by simp
next
  case (sym a b)
  then show ?case unfolding cancels_eq_def
    by (metis (no_types, lifting) sympD sympI symp_rtranclp)
next
  case (trans a b c)
  then show ?case sorry
next
  case (base g)
  then show ?case sorry
next
  case (mult xs xs' ys ys')
  then show ?case sorry
qed

lemma "x ~ y \<longleftrightarrow>  cancels_eq x y"
(*Prove the following:
  (1) if xs and ys can be reduced to same element, they are related.
  (2) if xs and ys are related, they have the same final reduction.
  (3) If xs is a related to a reduced word, the reduced word is unique.
  (4) Every element is related to its reduced form.
*)

(*
(1) Every element is related to the reduced word obtained by applying
   the iter algorithm.
(2) If two elements reduce to the same word obtained by the iter algorithm, they are related.
(3) Reduced word obtained by our (iter application) algorithm is unique in the equivalence
class.
(4) If two elements have the same reduced word (obtained by applying the iter
algorithm), the two elements are related.
*)

lemma reln_of_iter:"xs ~ iter n (reduction) xs"
proof(induction n)
  case 0
  then show ?case using reln.refl[of "xs"] unfolding iter.simps .
next
  case (Suc n)
  have loc:"iter n (reduction) xs ~ iter (Suc n) reduction xs" unfolding iter.simps(2)
    using rel_to_reduction[of "iter n (reduction) xs "] .
  show ?case using reln.trans[OF "Suc" loc] .
qed

lemma iter_eq_implies_reln:
  assumes "iter n reduction xs = iter m reduction ys"
  shows "xs ~ ys"
proof-
  have "xs ~ iter n reduction xs" using reln_of_iter[of "xs" "n"] .
  moreover have "ys ~ iter m reduction ys" using reln_of_iter[of "ys" "m"] .
  ultimately show ?thesis using assms reln.refl reln.trans
    by (metis reln.sym)
qed

lemma   "wrd1 ~ wrd2 \<Longrightarrow> reduced wrd1 \<Longrightarrow> reduced wrd2 \<Longrightarrow> wrd1 = wrd2"
proof(induction rule: reln.induct)
  case (refl a)
  then show ?case by fast
next
  case (sym a b)
  then show ?case by simp
next
  case (trans a b c)
  then show ?case sorry
next
  case (base g)
  then show ?case using reduced.simps
    by (metis inverse_of_inverse)
next
  case (mult xs xs' ys ys')
  then show ?case sorry
  (*use the result that if (xs@ys) is reduced, xs and ys are reduced *)
qed

quotient_type ('a,'b) wordclass = "('a,'b) word"/"reln"
  using reln.refl reln.sym reln.trans  equivpI reflpI sympI transpI
  by metis

lift_definition mult::"('a,'b) wordclass \<Rightarrow> ('a,'b) wordclass \<Rightarrow> ('a,'b) wordclass" (infixr "*" 65)
 is List.append
  by (simp add: mult)

(*Prove the following: Product of Abs of two wordclasses is the Abs of the product*)

(*Look up the difference between Abs_wordclasss and abs_wordclass, by experiment or reading.
Same for Rep_wordclass and rep_wordclass*)

lemma "abs_wordclass (wrd) * abs_wordclass (wrd') = abs_wordclass (wrd@wrd')"
  by (simp add: mult.abs_eq)

lemma "Rep_wordclass (Abs_wordclass wrdset) = wrdset"

(*Try to finish this lemma along with the lemmas above*)
lemma "rep_wordclass (abs_wordclass wrd) = wrd"
  unfolding wordeq_def sorry
qed


section  \<open>Undirected Graphs\<close>
theory Undirected_Graph
imports
  Common
begin
subsection \<open>Nodes and Edges\<close>

typedef 'v ugraph
  = "{ (V::'v set , E). E \<subseteq> V\<times>V \<and> finite V \<and> sym E \<and> irrefl E }"
  unfolding sym_def irrefl_def by blast

setup_lifting type_definition_ugraph

lift_definition nodes_internal :: "'v ugraph \<Rightarrow> 'v set" is fst .
lift_definition edges_internal :: "'v ugraph \<Rightarrow> ('v\<times>'v) set" is snd .
lift_definition graph_internal :: "'v set \<Rightarrow> ('v\<times>'v) set \<Rightarrow> 'v ugraph"
  is "\<lambda>V E. if finite V \<and> finite E then (V\<union>fst`E\<union>snd`E, (E\<union>E\<inverse>)-Id) else ({},{})"
  by (auto simp: sym_def irrefl_def; force)

definition nodes :: "'v ugraph \<Rightarrow> 'v set"
  where "nodes = nodes_internal"
definition edges :: "'v ugraph \<Rightarrow> ('v\<times>'v) set"
  where "edges = edges_internal"
definition graph :: "'v set \<Rightarrow> ('v\<times>'v) set \<Rightarrow> 'v ugraph"
  where "graph = graph_internal"

lemma edges_subset: "edges g \<subseteq> nodes g \<times> nodes g"
  unfolding edges_def nodes_def by transfer auto

lemma nodes_finite[simp, intro!]: "finite (nodes g)"
  unfolding edges_def nodes_def by transfer auto

lemma edges_sym: "sym (edges g)"
  unfolding edges_def nodes_def by transfer auto

lemma edges_irrefl: "irrefl (edges g)"
  unfolding edges_def nodes_def by transfer auto

lemma nodes_graph: "\<lbrakk>finite V; finite E\<rbrakk> \<Longrightarrow> nodes (graph V E) = V\<union>fst`E\<union>snd`E"
  unfolding edges_def nodes_def graph_def by transfer auto

lemma edges_graph: "\<lbrakk>finite V; finite E\<rbrakk> \<Longrightarrow> edges (graph V E) = (E\<union>E\<inverse>)-Id"
  unfolding edges_def nodes_def graph_def by transfer auto

lemmas graph_accs = nodes_graph edges_graph

lemma nodes_edges_graph_presentation: "\<lbrakk>finite V; finite E\<rbrakk>
    \<Longrightarrow> nodes (graph V E) = V \<union> fst`E \<union> snd`E \<and> edges (graph V E) = E\<union>E\<inverse> - Id"
  by (simp add: graph_accs)

lemma graph_eq[simp]: "graph (nodes g) (edges g) = g"
  unfolding edges_def nodes_def graph_def
  apply transfer
  unfolding sym_def irrefl_def
  apply (clarsimp split: prod.splits)
  by (fastforce simp: finite_subset)

lemma edges_finite[simp, intro!]: "finite (edges g)"
  using edges_subset finite_subset by fastforce

lemma graph_cases[cases type]: obtains V E
  where "g = graph V E" "finite V" "finite E" "E\<subseteq>V\<times>V" "sym E" "irrefl E"
proof -
  show ?thesis
    apply (rule that[of "nodes g" "edges g"])
    using edges_subset edges_sym edges_irrefl[of g]
    by auto
qed

lemma graph_eq_iff: "g=g' \<longleftrightarrow> nodes g = nodes g' \<and> edges g = edges g'"
  unfolding edges_def nodes_def graph_def by transfer auto

lemma edges_sym': "(u,v)\<in>edges g \<Longrightarrow> (v,u)\<in>edges g" using edges_sym
  by (blast intro: symD)

lemma edges_irrefl'[simp,intro!]: "(u,u)\<notin>edges g"
  by (meson edges_irrefl irrefl_def)

lemma edges_irreflI[simp, intro]: "(u,v)\<in>edges g \<Longrightarrow> u\<noteq>v" by auto

lemma edgesT_diff_sng_inv_eq[simp]:
  "(edges T - {(x, y), (y, x)})\<inverse> = edges T - {(x, y), (y, x)}"
  using edges_sym' by fast

lemma nodesI[simp,intro]: assumes "(u,v)\<in>edges g" shows "u\<in>nodes g" "v\<in>nodes g"
  using assms edges_subset by auto

lemma split_edges_sym: "\<exists>E. E\<inter>E\<inverse> = {} \<and> edges g = E \<union> E\<inverse>"
  using split_sym_rel[OF edges_sym edges_irrefl, of g] by metis

subsection \<open>Connectedness Relation\<close>

lemma rtrancl_edges_sym': "(u,v)\<in>(edges g)\<^sup>* \<Longrightarrow> (v,u)\<in>(edges g)\<^sup>*"
  by (simp add: edges_sym symD sym_rtrancl)

lemma trancl_edges_subset: "(edges g)\<^sup>+ \<subseteq> nodes g \<times> nodes g"
  by (simp add: edges_subset trancl_subset_Sigma)

lemma find_crossing_edge:
  assumes "(u,v)\<in>E\<^sup>*" "u\<in>V" "v\<notin>V"
  obtains u' v' where "(u',v')\<in>E\<inter>V\<times>-V"
  using assms apply (induction rule: converse_rtrancl_induct)
  by auto

subsection \<open>Constructing Graphs\<close>

definition "graph_empty \<equiv> graph {} {}"
definition "ins_node v g \<equiv> graph (insert v (nodes g)) (edges g)"
definition "ins_edge e g \<equiv> graph (nodes g) (insert e (edges g))"
definition "graph_join g\<^sub>1 g\<^sub>2 \<equiv> graph (nodes g\<^sub>1 \<union> nodes g\<^sub>2) (edges g\<^sub>1 \<union> edges g\<^sub>2)"
definition "restrict_nodes g V \<equiv> graph (nodes g \<inter> V) (edges g \<inter> V\<times>V)"
definition "restrict_edges g E \<equiv> graph (nodes g) (edges g \<inter> (E\<union>E\<inverse>))"

definition "nodes_edges_consistent V E \<equiv> finite V \<and> irrefl E \<and> sym E \<and> E \<subseteq> V\<times>V"

  show ?G1 ?G2 using assms
    by (auto simp: nodes_edges_consistent_def nodes_graph edges_graph irrefl_def)

qed

lemma nec_empty[simp]: "nodes_edges_consistent {} {}"
  by (auto simp: nodes_edges_consistent_def irrefl_def sym_def)

lemma graph_empty_accs[simp]:
  "nodes graph_empty = {}"
  "edges graph_empty = {}"
  unfolding graph_empty_def by (auto)

lemma edges_ins_edge_ss: "edges g \<subseteq> edges (ins_edge e g)"
  by (auto simp: edges_ins_edge)

lemma nodes_join[simp]: "nodes (graph_join g\<^sub>1 g\<^sub>2) = nodes g\<^sub>1 \<union> nodes g\<^sub>2"
  and edges_join[simp]: "edges (graph_join g\<^sub>1 g\<^sub>2) = edges g\<^sub>1 \<union> edges g\<^sub>2"
  unfolding graph_join_def
  by (auto simp: graph_accs dest: edges_sym')

lemma nodes_restrict_nodes[simp]: "nodes (restrict_nodes g V) = nodes g \<inter> V"
  and edges_restrict_nodes[simp]: "edges (restrict_nodes g V) = edges g \<inter> V\<times>V"
  unfolding restrict_nodes_def
  by (auto simp: graph_accs dest: edges_sym')

lemma nodes_restrict_edges[simp]: "nodes (restrict_edges g E) = nodes g"
  and edges_restrict_edges[simp]: "edges (restrict_edges g E) = edges g \<inter> (E\<union>E\<inverse>)"
  unfolding restrict_edges_def
  by (auto simp: graph_accs dest: edges_sym')

lemma unrestricte_edges: "edges (restrict_edges g E) \<subseteq> edges g" by auto
lemma unrestrictn_edges: "edges (restrict_nodes g V) \<subseteq> edges g" by auto

lemma unrestrict_nodes: "nodes (restrict_edges g E) \<subseteq> nodes g" by auto

subsection \<open>Paths\<close>

fun path where
  "path g u [] v \<longleftrightarrow> u=v"
| "path g u (e#ps) w \<longleftrightarrow> (\<exists>v. e=(u,v) \<and> e\<in>edges g \<and> path g v ps w)"

lemma path_emptyI[intro!]: "path g u [] u" by auto

lemma path_append[simp]:
  "path g u (p1@p2) w \<longleftrightarrow> (\<exists>v. path g u p1 v \<and> path g v p2 w)"
  by (induction p1 arbitrary: u) auto

lemma path_transs1[trans]:
  "path g u p v \<Longrightarrow> (v,w)\<in>edges g \<Longrightarrow> path g u (p@[(v,w)]) w"
  "(u,v)\<in>edges g \<Longrightarrow> path g v p w \<Longrightarrow> path g u ((u,v)#p) w"
  "path g u p1 v \<Longrightarrow> path g v p2 w \<Longrightarrow> path g u (p1@p2) w"
  by auto

lemma path_graph_empty[simp]: "path graph_empty u p v \<longleftrightarrow> v=u \<and> p=[]"
  by (cases p) auto

abbreviation "revp p \<equiv> rev (map prod.swap p)"
lemma revp_alt: "revp p = rev (map (\<lambda>(u,v). (v,u)) p)" by auto

lemma path_rev[simp]: "path g u (revp p) v \<longleftrightarrow> path g v p u"
  by (induction p arbitrary: v) (auto dest: edges_sym')

lemma path_rev_sym[sym]: "path g v p u \<Longrightarrow> path g u (revp p) v" by simp

lemma path_transs2[trans]:
  "path g u p v \<Longrightarrow> (w,v)\<in>edges g \<Longrightarrow> path g u (p@[(v,w)]) w"
  "(v,u)\<in>edges g \<Longrightarrow> path g v p w \<Longrightarrow> path g u ((u,v)#p) w"
  "path g u p1 v \<Longrightarrow> path g w p2 v \<Longrightarrow> path g u (p1@revp p2) w"
  by (auto dest: edges_sym')

lemma path_edges: "path g u p v \<Longrightarrow> set p \<subseteq> edges g"
  by (induction p arbitrary: u) auto

lemma path_graph_cong:
  "\<lbrakk>path g\<^sub>1 u p v; set p \<subseteq> edges g\<^sub>1 \<Longrightarrow> set p \<subseteq> edges g\<^sub>2\<rbrakk> \<Longrightarrow> path g\<^sub>2 u p v"
  apply (frule path_edges; simp)
  apply (induction p arbitrary: u)
  by auto

lemma path_endpoints:
  assumes "path g u p v" "p\<noteq>[]" shows "u\<in>nodes g" "v\<in>nodes g"
  subgoal using assms by (cases p) (auto intro: nodesI)
  subgoal using assms by (cases p rule: rev_cases) (auto intro: nodesI)
  done

lemma path_mono: "edges g \<subseteq> edges g' \<Longrightarrow> path g u p v \<Longrightarrow> path g' u p v"
  by (meson path_edges path_graph_cong subset_trans)

lemmas unrestricte_path = path_mono[OF unrestricte_edges]
lemmas unrestrictn_path = path_mono[OF unrestrictn_edges]

lemma unrestrict_path_edges: "path (restrict_edges g E) u p v \<Longrightarrow> path g u p v"
  by (induction p arbitrary: u) auto

lemma unrestrict_path_nodes: "path (restrict_nodes g E) u p v \<Longrightarrow> path g u p v"
  by (induction p arbitrary: u) auto

subsubsection \<open>Paths and Connectedness\<close>

lemma rtrancl_edges_iff_path: "(u,v)\<in>(edges g)\<^sup>* \<longleftrightarrow> (\<exists>p. path g u p v)"
  apply rule
  subgoal
    apply (induction rule: converse_rtrancl_induct)
    by (auto dest: path_transs1)
  apply clarify
  subgoal for p by (induction p arbitrary: u; force)
  done

lemma rtrancl_edges_pathE:
  assumes "(u,v)\<in>(edges g)\<^sup>*" obtains p where "path g u p v"
  using assms by (auto simp: rtrancl_edges_iff_path)

lemma path_rtrancl_edgesD: "path g u p v \<Longrightarrow> (u,v)\<in>(edges g)\<^sup>*"
  by (auto simp: rtrancl_edges_iff_path)

subsubsection \<open>Simple Paths\<close>

definition "uedge \<equiv> \<lambda>(a,b). {a,b}"

definition "simple p \<equiv> distinct (map uedge p)"

lemma in_uedge_conv[simp]: "x\<in>uedge (u,v) \<longleftrightarrow> x=u \<or> x=v"
  by (auto simp: uedge_def)

lemma uedge_eq_iff: "uedge (a,b) = uedge (c,d) \<longleftrightarrow> a=c \<and> b=d \<or> a=d \<and> b=c"
  by (auto simp: uedge_def doubleton_eq_iff)

lemma uedge_degen[simp]: "uedge (a,a) = {a}"
  by (auto simp: uedge_def)

lemma uedge_in_set_eq: "uedge (u, v) \<in> uedge ` S \<longleftrightarrow> (u,v)\<in>S \<or> (v,u)\<in>S"
  by (auto simp: uedge_def doubleton_eq_iff)

lemma uedge_commute: "uedge (a,b) = uedge (b,a)" by auto

lemma simple_empty[simp]: "simple []"
  by (auto simp: simple_def)

lemma simple_cons[simp]: "simple (e#p) \<longleftrightarrow> uedge e \<notin> uedge ` set p \<and> simple p"
  by (auto simp: simple_def)

lemma simplify_pathD:
  "path g u p v \<Longrightarrow> \<exists>p'. path g u p' v \<and> simple p' \<and> set p' \<subseteq> set p"
proof (induction p arbitrary: u v rule: length_induct)
  case A: (1 p)
  then show ?case proof (cases "simple p")
    assume "simple p" with A.prems show ?case by blast
  next
    assume "\<not>simple p"
    then consider p\<^sub>1 a b p\<^sub>2 p\<^sub>3 where "p=p\<^sub>1@[(a,b)]@p\<^sub>2@[(a,b)]@p\<^sub>3"
                | p\<^sub>1 a b p\<^sub>2 p\<^sub>3 where "p=p\<^sub>1@[(a,b)]@p\<^sub>2@[(b,a)]@p\<^sub>3"
      by (auto
        simp: simple_def map_eq_append_conv uedge_eq_iff
        dest!: not_distinct_decomp)
    then obtain p' where "path g u p' v" "length p' < length p" "set p' \<subseteq> set p"
    proof cases
      case [simp]: 1
      from A.prems have "path g u (p\<^sub>1@[(a,b)]@p\<^sub>3) v" by auto
      from that[OF this] show ?thesis by auto
    next
      case [simp]: 2
      from A.prems have "path g u (p\<^sub>1@p\<^sub>3) v" by auto
      from that[OF this] show ?thesis by auto
    qed
    with A.IH show ?thesis by blast
  qed
qed

lemma simplify_pathE:
  assumes "path g u p v"
  obtains p' where "path g u p' v" "simple p'" "set p' \<subseteq> set p"
  using assms by (auto dest: simplify_pathD)

subsubsection \<open>Splitting Paths\<close>

lemma find_crossing_edge_on_path:
  assumes "path g u p v" "\<not>P u" "P v"
  obtains u' v' where "(u',v')\<in>set p" "\<not>P u'" "P v'"
  using assms by (induction p arbitrary: u) auto

lemma find_crossing_edges_on_path:
  assumes P: "path g u p v" and "P u" "P v"
  obtains "\<forall>(u,v)\<in>set p. P u \<and> P v"
        | u\<^sub>1 v\<^sub>1 v\<^sub>2 u\<^sub>2 p\<^sub>1 p\<^sub>2 p\<^sub>3
          where "p=p\<^sub>1@[(u\<^sub>1,v\<^sub>1)]@p\<^sub>2@[(u\<^sub>2,v\<^sub>2)]@p\<^sub>3" "P u\<^sub>1" "\<not>P v\<^sub>1" "\<not>P u\<^sub>2" "P v\<^sub>2"
proof (cases "\<forall>(u,v)\<in>set p. P u \<and> P v")
  case True with that show ?thesis by blast
next
  case False
  with P \<open>P u\<close> have "\<exists>(u\<^sub>1,v\<^sub>1)\<in>set p. P u\<^sub>1 \<and> \<not>P v\<^sub>1"
    apply clarsimp apply (induction p arbitrary: u) by auto
  then obtain u\<^sub>1 v\<^sub>1 where "(u\<^sub>1,v\<^sub>1)\<in>set p" and PRED1: "P u\<^sub>1" "\<not>P v\<^sub>1" by blast
  then obtain p\<^sub>1 p\<^sub>2\<^sub>3 where [simp]: "p=p\<^sub>1@[(u\<^sub>1,v\<^sub>1)]@p\<^sub>2\<^sub>3"
    by (auto simp: in_set_conv_decomp)
  with P have "path g v\<^sub>1 p\<^sub>2\<^sub>3 v" by auto
  from find_crossing_edge_on_path[where P=P, OF this \<open>\<not>P v\<^sub>1\<close> \<open>P v\<close>] obtain u\<^sub>2 v\<^sub>2
    where "(u\<^sub>2,v\<^sub>2)\<in>set p\<^sub>2\<^sub>3" "\<not>P u\<^sub>2" "P v\<^sub>2" .
  then show thesis using PRED1
    by (auto simp: in_set_conv_decomp intro: that)
qed

lemma find_crossing_edge_rtrancl:
  assumes "(u,v)\<in>(edges g)\<^sup>*" "\<not>P u" "P v"
  obtains u' v' where "(u',v')\<in>edges g" "\<not>P u'" "P v'"
  using assms
  by (metis converse_rtrancl_induct)

lemma path_change:
  assumes "u\<in>S" "v\<notin>S" "path g u p v" "simple p"
  obtains x y p1 p2 where
    "(x,y) \<in> set p" "x \<in> S" "y \<notin> S"
    "path (restrict_edges g (-{(x,y),(y,x)})) u p1 x"
    "path (restrict_edges g (-{(x,y),(y,x)})) y p2 v"
proof -
  from find_crossing_edge_on_path[where P="\<lambda>x. x\<notin>S"] assms obtain x y where
    1: "(x,y)\<in>set p" "x\<in>S" "y\<notin>S" by blast
  then obtain p1 p2 where [simp]: "p=p1@[(x,y)]@p2"
    by (auto simp: in_set_conv_decomp)

  let ?g' = "restrict_edges g (-{(x,y),(y,x)})"

  from \<open>path g u p v\<close> have P1: "path g u p1 x" and P2: "path g y p2 v" by auto
  from \<open>simple p\<close>
    have "uedge (x,y)\<notin>set (map uedge p1)" "uedge (x,y)\<notin>set (map uedge p2)"
  by auto
  then have "path ?g' u p1 x" "path ?g' y p2 v"
    using path_graph_cong[OF P1, of ?g'] path_graph_cong[OF P2, of ?g']
    by (auto simp: uedge_in_set_eq)
  with 1 show ?thesis by (blast intro: that)
qed

subsection \<open>Cycles\<close>

definition "cycle_free g \<equiv> \<nexists>p u. p\<noteq>[] \<and> simple p \<and> path g u p u"

lemma cycle_free_alt_in_nodes:
  "cycle_free g \<equiv> \<nexists>p u. p\<noteq>[] \<and> u\<in>nodes g \<and> simple p \<and> path g u p u"
  by (smt cycle_free_def path_endpoints(2))

lemma cycle_freeI:
  assumes "\<And>p u. \<lbrakk> path g u p u; p\<noteq>[]; simple p \<rbrakk> \<Longrightarrow> False"
  shows "cycle_free g"
  using assms unfolding cycle_free_def by auto

lemma cycle_freeD:
  assumes "cycle_free g" "path g u p u" "p\<noteq>[]" "simple p"
  shows False
  using assms unfolding cycle_free_def by auto

lemma cycle_free_antimono: "edges g \<subseteq> edges g' \<Longrightarrow> cycle_free g' \<Longrightarrow> cycle_free g"
  unfolding cycle_free_def
  by (auto dest: path_mono)

lemma cycle_free_empty[simp]: "cycle_free graph_empty"
  unfolding cycle_free_def by auto

lemma cycle_free_no_edges: "edges g = {} \<Longrightarrow> cycle_free g"
  by (rule cycle_freeI) (auto simp: neq_Nil_conv)

  with Cons.IH[of u' p''] Cons.prems show ?case by simp
qed

subsubsection \<open>Characterization by Removing Edge\<close>

lemma cycle_free_alt: "cycle_free g
  \<longleftrightarrow> (\<forall>e\<in>edges g. e\<notin>(edges (restrict_edges g (-{e,prod.swap e})))\<^sup>*)"
  apply (rule)
  apply (clarsimp simp del: edges_restrict_edges)
  subgoal premises prems for u v proof -
    note edges_restrict_edges[simp del]
    let ?rg = "(restrict_edges g (- {(u,v), (v,u)}))"
    from \<open>(u, v) \<in> (edges ?rg)\<^sup>*\<close>
    obtain p where P: "path ?rg u p v" and "simple p"
      by (auto simp: rtrancl_edges_iff_path elim: simplify_pathE)
    from P have "path g u p v" by (rule unrestricte_path)
    also note \<open>(u, v) \<in> edges g\<close> finally have "path g u (p @ [(v, u)]) u" .
    moreover from path_edges[OF P] have "uedge (u,v) \<notin> set (map uedge p)"
      by (auto simp: uedge_eq_iff edges_restrict_edges)
    with \<open>simple p\<close> have "simple (p @ [(v, u)])"
      by (auto simp: uedge_eq_iff uedge_in_set_eq)
    ultimately show ?thesis using \<open>cycle_free g\<close>
      unfolding cycle_free_def by blast
  qed
  apply (clarsimp simp: cycle_free_def)
  subgoal premises prems for p u proof -
    from \<open>p\<noteq>[]\<close> \<open>path g u p u\<close> obtain v p' where
      [simp]: "p=(u,v)#p'" and "(u,v)\<in>edges g" "path g v p' u"
      by (cases p) auto
    from \<open>simple p\<close> have "simple p'" "uedge (u,v) \<notin> set (map uedge p')" by auto
    hence "(u,v)\<notin>set p'" "(v,u)\<notin>set p'" by (auto simp: uedge_in_set_eq)
    with \<open>path g v p' u\<close>
      have "path (restrict_edges g (-{(u,v),(v,u)})) v p' u" (is "path ?rg _ _ _")
      by (erule_tac path_graph_cong) auto

    hence "(u,v)\<in>(edges ?rg)\<^sup>*"
      by (meson path_rev rtrancl_edges_iff_path)
    with prems(1) \<open>(u,v)\<in>edges g\<close> show False by auto
  qed
  done

lemma cycle_free_altI:
  assumes "\<And>u v. \<lbrakk> (u,v)\<in>edges g; (u,v)\<in>(edges g - {(u,v),(v,u)})\<^sup>* \<rbrakk> \<Longrightarrow> False"
  shows "cycle_free g"
  unfolding cycle_free_alt using assms by (force)

lemma cycle_free_altD:
  assumes "cycle_free g"
  assumes "(u,v)\<in>edges g"
  shows "(u,v)\<notin>(edges g - {(u,v),(v,u)})\<^sup>*"
  using assms unfolding cycle_free_alt by (auto)

lemma remove_redundant_edge:
  assumes "(u, v) \<in> (edges g - {(u, v), (v, u)})\<^sup>*"
  shows "(edges g - {(u, v), (v, u)})\<^sup>* = (edges g)\<^sup>*" (is "?E'\<^sup>* = _")
proof
  show "?E'\<^sup>* \<subseteq> (edges g)\<^sup>*"
    by (simp add: Diff_subset rtrancl_mono)
next
  show "(edges g)\<^sup>* \<subseteq> ?E'\<^sup>*"
  proof clarify
    fix a b assume "(a,b)\<in>(edges g)\<^sup>*" then
    show "(a,b)\<in>?E'\<^sup>*"
    proof induction
      case base
      then show ?case by simp
    next
      case (step b c)
      then show ?case
      proof (cases "(b,c)\<in>{(u,v),(v,u)}")
        case True

        have SYME: "sym (?E'\<^sup>*)"
          apply (rule sym_rtrancl)
          using edges_sym[of g]
          by (auto simp: sym_def)
        with step.IH assms have
          IH': "(b,a) \<in> ?E'\<^sup>*"
          by (auto intro: symD)

        from True show ?thesis apply safe
          subgoal using assms step.IH by simp
          subgoal using assms IH' apply (rule_tac symD[OF SYME]) by simp
          done

      next
        case False
        then show ?thesis
          by (meson DiffI rtrancl.rtrancl_into_rtrancl step.IH step.hyps(2))
      qed

    qed
  qed
qed

subsection \<open>Connected Graphs\<close>

definition connected
  where "connected g \<equiv> nodes g \<times> nodes g \<subseteq> (edges g)\<^sup>*"

lemma connectedI[intro?]:
  assumes "\<And>u v. \<lbrakk>u\<in>nodes g; v\<in>nodes g\<rbrakk> \<Longrightarrow> (u,v)\<in>(edges g)\<^sup>*"
  shows "connected g"
  using assms unfolding connected_def by auto

subsection \<open>Component Containing Node\<close>
definition "reachable_nodes g r \<equiv> (edges g)\<^sup>*``{r}"
definition "component_of g r
  \<equiv> ins_node r (restrict_nodes g (reachable_nodes g r))"

lemma reachable_nodes_refl[simp, intro!]: "r \<in> reachable_nodes g r"
  by (auto simp: reachable_nodes_def)

lemma reachable_nodes_step:
  "edges g `` reachable_nodes g r \<subseteq> reachable_nodes g r"
  by (auto simp: reachable_nodes_def)

lemma reachable_nodes_steps:
  "(edges g)\<^sup>* `` reachable_nodes g r \<subseteq> reachable_nodes g r"
  by (auto simp: reachable_nodes_def)

lemma reachable_nodes_step':
  assumes "u \<in> reachable_nodes g r" "(u, v) \<in> edges g"
  shows "v\<in>reachable_nodes g r" "(u, v) \<in> edges (component_of g r)"
proof -
  show "v \<in> reachable_nodes g r"
    by (meson ImageI assms(1) assms(2) reachable_nodes_step rev_subsetD)
  then show "(u, v) \<in> edges (component_of g r)"
    by (simp add: assms(1) assms(2) component_of_def)
qed

lemma reachable_nodes_steps':
  assumes "u \<in> reachable_nodes g r" "(u, v) \<in> (edges g)\<^sup>*"
  shows "v\<in>reachable_nodes g r" "(u, v) \<in> (edges (component_of g r))\<^sup>*"
proof -
  show "v\<in>reachable_nodes g r" using reachable_nodes_steps assms by fast
  show "(u, v) \<in> (edges (component_of g r))\<^sup>*"
    using assms(2,1)
    apply (induction rule: converse_rtrancl_induct)
    subgoal by auto
    subgoal by (smt converse_rtrancl_into_rtrancl reachable_nodes_step')
    done
qed

lemma reachable_not_node: "r\<notin>nodes g \<Longrightarrow> reachable_nodes g r = {r}"
  by (force elim: converse_rtranclE simp: reachable_nodes_def intro: nodesI)

lemma nodes_of_component[simp]: "nodes (component_of g r) = reachable_nodes g r"
  apply (rule equalityI)
  unfolding component_of_def reachable_nodes_def
  subgoal by auto
  subgoal by clarsimp (metis nodesI(2) rtranclE)
  done

lemma component_connected[simp, intro!]: "connected (component_of g r)"
proof (rule connectedI; simp)
  fix u v
  assume A: "u \<in> reachable_nodes g r" "v \<in> reachable_nodes g r"
  hence "(u,r)\<in>(edges g)\<^sup>*" "(r,v)\<in>(edges g)\<^sup>*"
    by (auto simp: reachable_nodes_def dest: rtrancl_edges_sym')
  hence "(u,v)\<in>(edges g)\<^sup>*" by (rule rtrancl_trans)
  with A show "(u, v) \<in> (edges (component_of g r))\<^sup>*"
    by (rule_tac reachable_nodes_steps'(2))
qed

lemma component_edges_subset: "edges (component_of g r) \<subseteq> edges g"
  by (auto simp: component_of_def)

lemma component_path: "u\<in>nodes (component_of g r) \<Longrightarrow>
  path (component_of g r) u p v \<longleftrightarrow> path g u p v"
  apply rule
  subgoal by (erule path_mono[OF component_edges_subset])
  subgoal by (induction p arbitrary: u) (auto simp: reachable_nodes_step')
  done

lemma component_cycle_free: "cycle_free g \<Longrightarrow> cycle_free (component_of g r)"
  by (meson component_edges_subset cycle_free_antimono)

lemma component_of_connected_graph:
  "\<lbrakk>connected g; r\<in>nodes g\<rbrakk> \<Longrightarrow> component_of g r = g"
  unfolding graph_eq_iff
  apply safe
  subgoal by simp (metis Image_singleton_iff nodesI(2) reachable_nodes_def rtranclE)
  subgoal by (simp add: connectedD reachable_nodes_def)
  subgoal by (simp add: component_of_def)
  subgoal by (simp add: connectedD reachable_nodes_def reachable_nodes_step'(2))
  done

lemma component_of_not_node: "r\<notin>nodes g \<Longrightarrow> component_of g r = graph {r} {}"
  by (clarsimp simp: graph_eq_iff component_of_def reachable_not_node graph_accs)

subsection \<open>Trees\<close>

definition "tree g \<equiv> connected g \<and> cycle_free g "

lemma tree_empty[simp]: "tree graph_empty" by (simp add: tree_def)

lemma component_of_tree: "tree T \<Longrightarrow> tree (component_of T r)"
  unfolding tree_def using component_connected component_cycle_free by auto

subsubsection \<open>Joining and Splitting Trees on Single Edge\<close>

lemma join_connected:
  assumes CONN: "connected g\<^sub>1" "connected g\<^sub>2"
  assumes IN_NODES: "u\<in>nodes g\<^sub>1" "v\<in>nodes g\<^sub>2"
  shows "connected (ins_edge (u,v) (graph_join g\<^sub>1 g\<^sub>2))" (is "connected ?g'")
  unfolding connected_def
proof clarify
  fix a b
  assume A: "a\<in>nodes ?g'" "b\<in>nodes ?g'"

  have ESS: "(edges g\<^sub>1)\<^sup>* \<subseteq> (edges ?g')\<^sup>*" "(edges g\<^sub>2)\<^sup>* \<subseteq> (edges ?g')\<^sup>*"
    using edges_ins_edge_ss
    by (force intro!: rtrancl_mono)+

  have UV: "(u,v)\<in>(edges ?g')\<^sup>*"
    by (simp add: edges_ins_edge r_into_rtrancl)

  show "(a,b)\<in>(edges ?g')\<^sup>*"
  proof -
    {
      assume "a\<in>nodes g\<^sub>1" "b\<in>nodes g\<^sub>1"
      hence ?thesis using \<open>connected g\<^sub>1\<close> ESS(1) unfolding connected_def by blast
    } moreover {
      assume "a\<in>nodes g\<^sub>2" "b\<in>nodes g\<^sub>2"
      hence ?thesis using \<open>connected g\<^sub>2\<close> ESS(2) unfolding connected_def by blast
    } moreover {
      assume "a\<in>nodes g\<^sub>1" "b\<in>nodes g\<^sub>2"
      with connectedD[OF CONN(1)] connectedD[OF CONN(2)] ESS
      have ?thesis by (meson UV IN_NODES contra_subsetD rtrancl_trans)
    } moreover {
      assume "a\<in>nodes g\<^sub>2" "b\<in>nodes g\<^sub>1"
      with connectedD[OF CONN(1)] connectedD[OF CONN(2)] ESS
      have ?thesis
        by (meson UV IN_NODES contra_subsetD rtrancl_edges_sym' rtrancl_trans)
    }
    ultimately show ?thesis using A IN_NODES by auto
  qed
qed

lemma join_cycle_free:
  assumes CYCF: "cycle_free g\<^sub>1" "cycle_free g\<^sub>2"
  assumes DJ: "nodes g\<^sub>1 \<inter> nodes g\<^sub>2 = {}"
  assumes IN_NODES: "u\<in>nodes g\<^sub>1" "v\<in>nodes g\<^sub>2"
  shows "cycle_free (ins_edge (u,v) (graph_join g\<^sub>1 g\<^sub>2))" (is "cycle_free ?g'")
proof (rule cycle_freeI)
  fix p a
  assume P: "path ?g' a p a" "p\<noteq>[]" "simple p"
  from path_endpoints[OF this(1,2)] IN_NODES
    have A_NODE: "a\<in>nodes g\<^sub>1 \<union> nodes g\<^sub>2"
    by auto
  thus False proof
    assume N1: "a\<in>nodes g\<^sub>1"
    have "set p \<subseteq> nodes g\<^sub>1 \<times> nodes g\<^sub>1"
    proof (cases
      rule: find_crossing_edges_on_path[where P="\<lambda>x. x\<in>nodes g\<^sub>1", OF P(1) N1 N1])
      case 1
      then show ?thesis by auto
    next
      case (2 u\<^sub>1 v\<^sub>1 v\<^sub>2 u\<^sub>2 p\<^sub>1 p\<^sub>2 p\<^sub>3)
      then show ?thesis using \<open>simple p\<close> P
        apply clarsimp
        apply (drule path_edges)+
        apply (cases "u=v"; clarsimp simp: edges_ins_edge uedge_in_set_eq)
        apply (metis DJ IntI IN_NODES empty_iff)
        by (metis DJ IntI empty_iff nodesI uedge_eq_iff)

    qed
    hence "set p \<subseteq> edges g\<^sub>1" using DJ edges_subset path_edges[OF P(1)] IN_NODES
      by (auto simp: edges_ins_edge split: if_splits; blast)
    hence "path g\<^sub>1 a p a" by (meson P(1) path_graph_cong)
    thus False using cycle_freeD[OF CYCF(1)] P(2,3) by blast
  next
    assume N2: "a\<in>nodes g\<^sub>2"
    have "set p \<subseteq> nodes g\<^sub>2 \<times> nodes g\<^sub>2"
    proof (cases
      rule: find_crossing_edges_on_path[where P="\<lambda>x. x\<in>nodes g\<^sub>2", OF P(1) N2 N2])
      case 1
      then show ?thesis by auto
    next
      case (2 u\<^sub>1 v\<^sub>1 v\<^sub>2 u\<^sub>2 p\<^sub>1 p\<^sub>2 p\<^sub>3)
      then show ?thesis using \<open>simple p\<close> P
        apply clarsimp
        apply (drule path_edges)+
        apply (cases "u=v"; clarsimp simp: edges_ins_edge uedge_in_set_eq)
        apply (metis DJ IntI IN_NODES empty_iff)
        by (metis DJ IntI empty_iff nodesI uedge_eq_iff)

    qed
    hence "set p \<subseteq> edges g\<^sub>2" using DJ edges_subset path_edges[OF P(1)] IN_NODES
      by (auto simp: edges_ins_edge split: if_splits; blast)
    hence "path g\<^sub>2 a p a" by (meson P(1) path_graph_cong)
    thus False using cycle_freeD[OF CYCF(2)] P(2,3) by blast
  qed
qed

lemma join_trees:
  assumes TREE: "tree g\<^sub>1" "tree g\<^sub>2"
  assumes DJ: "nodes g\<^sub>1 \<inter> nodes g\<^sub>2 = {}"
  assumes IN_NODES: "u\<in>nodes g\<^sub>1" "v\<in>nodes g\<^sub>2"
  shows "tree (ins_edge (u,v) (graph_join g\<^sub>1 g\<^sub>2))"
  using assms join_cycle_free join_connected unfolding tree_def by metis

lemma split_tree:
  assumes "tree T" "(x,y)\<in>edges T"
  defines "E' \<equiv> (edges T - {(x,y),(y,x)})"
  obtains T1 T2 where
    "tree T1" "tree T2"
    "nodes T1 \<inter> nodes T2 = {}" "nodes T = nodes T1 \<union> nodes T2"
    "edges T1 \<union> edges T2 = E'"
    "nodes T1 = { u. (x,u)\<in>E'\<^sup>*}" "nodes T2 = { u. (y,u)\<in>E'\<^sup>*}"
    "x\<in>nodes T1" "y\<in>nodes T2"
proof -
  (* TODO: Use component_of here! *)
  define N1 where "N1 = { u. (x,u)\<in>E'\<^sup>* }"
  define N2 where "N2 = { u. (y,u)\<in>E'\<^sup>* }"

  define T1 where "T1 = restrict_nodes T N1"
  define T2 where "T2 = restrict_nodes T N2"

  have SYME: "sym (E'\<^sup>*)"
    apply (rule sym_rtrancl)
    using edges_sym[of T] by (auto simp: sym_def E'_def)

  from assms have "connected T" "cycle_free T" unfolding tree_def by auto
  from \<open>cycle_free T\<close> have "cycle_free T1" "cycle_free T2"
    unfolding T1_def T2_def
    using cycle_free_antimono unrestrictn_edges by blast+

  from \<open>(x,y) \<in> edges T\<close> have XYN: "x\<in>nodes T" "y\<in>nodes T"
    using edges_subset by auto
  from XYN have [simp]: "nodes T1 = N1" "nodes T2 = N2"
    unfolding T1_def T2_def N1_def N2_def unfolding E'_def
    apply (safe)
    apply (all \<open>clarsimp\<close>)
    by (metis DiffD1 nodesI(2) rtrancl.simps)+

  have "x\<in>N1" "y\<in>N2" by (auto simp: N1_def N2_def)

  have "N1 \<inter> N2 = {}"
  proof (safe;simp)
    fix u
    assume "u\<in>N1" "u\<in>N2"
    hence "(x,u)\<in>E'\<^sup>*" "(u,y)\<in>E'\<^sup>*" by (auto simp: N1_def N2_def symD[OF SYME])
    with cycle_free_altD[OF \<open>cycle_free T\<close> \<open>(x,y)\<in>edges T\<close>] show False
      unfolding E'_def by (meson rtrancl_trans)
  qed

  have N1C: "E'``N1 \<subseteq> N1"
    unfolding N1_def
    apply clarsimp
    by (simp add: rtrancl.rtrancl_into_rtrancl)

  have N2C: "E'``N2 \<subseteq> N2"
    unfolding N2_def
    apply clarsimp
    by (simp add: rtrancl.rtrancl_into_rtrancl)

  have XE1: "(x,u) \<in> (edges T1)\<^sup>*" if "u\<in>N1" for u
  proof -
    from that have "(x,u)\<in>E'\<^sup>*" by (auto simp: N1_def)
    then show ?thesis using \<open>x\<in>N1\<close>
      unfolding T1_def
    proof (induction rule: converse_rtrancl_induct)
      case (step y z)
      with N1C have "z\<in>N1" by auto
      with step.hyps(1) step.prems have "(y,z)\<in>Restr (edges T) N1"
        unfolding E'_def by auto
      with step.IH[OF \<open>z\<in>N1\<close>] show ?case
        by (metis converse_rtrancl_into_rtrancl edges_restrict_nodes)
    qed auto
  qed

  have XE2: "(y,u) \<in> (edges T2)\<^sup>*" if "u\<in>N2" for u
  proof -
    from that have "(y,u)\<in>E'\<^sup>*" by (auto simp: N2_def)
    then show ?thesis using \<open>y\<in>N2\<close>
      unfolding T2_def
    proof (induction rule: converse_rtrancl_induct)
      case (step y z)
      with N2C have "z\<in>N2" by auto
      with step.hyps(1) step.prems have "(y,z)\<in>Restr (edges T) N2"
        unfolding E'_def by auto
      with step.IH[OF \<open>z\<in>N2\<close>] show ?case
        by (metis converse_rtrancl_into_rtrancl edges_restrict_nodes)
    qed auto
  qed

  have "connected T1"
    apply rule
    apply simp
    apply (drule XE1)+
    by (meson rtrancl_edges_sym' rtrancl_trans)

  have "connected T2"
    apply rule
    apply simp
    apply (drule XE2)+
    by (meson rtrancl_edges_sym' rtrancl_trans)

  have "u\<in>N1 \<union> N2" if "u\<in>nodes T" for u
  proof -
    from connectedD[OF \<open>connected T\<close> \<open>x\<in>nodes T\<close> that ]
    obtain p where P: "path T x p u" "simple p"
      by (auto simp: rtrancl_edges_iff_path elim: simplify_pathE)
    show ?thesis proof cases
      assume "(x,y)\<notin>set p \<and> (y,x)\<notin>set p"
      with P(1) have "path (restrict_edges T E') x p u"
        unfolding E'_def by (erule_tac path_graph_cong) auto
      from path_rtrancl_edgesD[OF this]
      show ?thesis unfolding N1_def E'_def by auto
    next
      assume "\<not>((x,y)\<notin>set p \<and> (y,x)\<notin>set p)"
      with P obtain p' where
        "uedge (x,y)\<notin>set (map uedge p')" "path T y p' u \<or> path T x p' u"
        by (auto simp: in_set_conv_decomp uedge_commute)
      hence "path (restrict_edges T E') y p' u \<or> path (restrict_edges T E') x p' u"
        apply (clarsimp simp: uedge_in_set_eq E'_def)
        by (smt ComplD DiffI Int_iff UnCI edges_restrict_edges insertE
                path_graph_cong subset_Compl_singleton subset_iff)
      then show ?thesis unfolding N1_def N2_def E'_def
        by (auto dest: path_rtrancl_edgesD)
    qed
  qed
  then have "nodes T = N1 \<union> N2"
    unfolding N1_def N2_def using XYN
    unfolding E'_def
    apply (safe)
    subgoal by auto []
    subgoal by (metis DiffD1 nodesI(2) rtrancl.cases)
    subgoal by (metis DiffD1 nodesI(2) rtrancl.cases)
    done

  have "edges T1 \<union> edges T2 \<subseteq> E'"
    unfolding T1_def T2_def E'_def using \<open>N1 \<inter> N2 = {}\<close> \<open>x \<in> N1\<close> \<open>y \<in> N2\<close>
    by auto
  also have "edges T1 \<union> edges T2 \<supseteq> E'"
  proof -
    note ED1 = nodesI[where g=T, unfolded \<open>nodes T = N1\<union>N2\<close>]
    have "E' \<subseteq> edges T" by (auto simp: E'_def)
    thus "edges T1 \<union> edges T2 \<supseteq> E'"
      unfolding T1_def T2_def
      using ED1 N1C N2C by (auto; blast)
  qed
  finally have "edges T1 \<union> edges T2 = E'" .

  show ?thesis
    apply (rule that[of T1 T2, unfolded tree_def]; (intro conjI)?; fact?)
    apply simp_all
    apply fact+
    done
qed

subsection \<open>Spanning Trees\<close>

definition "is_spanning_tree G T
  \<equiv> tree T \<and> nodes T = nodes G \<and> edges T \<subseteq> edges G"

(* TODO: Move *)
lemma connected_singleton[simp]: "connected (ins_node u graph_empty)"
  unfolding connected_def by auto

lemma path_singleton[simp]: "path (ins_node u graph_empty) v p w \<longleftrightarrow> v=w \<and> p=[]"
  by (cases p) auto

lemma tree_singleton[simp]: "tree (ins_node u graph_empty)"
  by (simp add: cycle_free_no_edges tree_def)

(* TODO: Move *)
lemma tree_add_edge_in_out:
  assumes "tree T"
  assumes "u\<in>nodes T" "v\<notin>nodes T"
  shows "tree (ins_edge (u,v) T)"
proof -
  from assms have [simp]: "u\<noteq>v" by auto
  have "ins_edge (u,v) T = ins_edge (u,v) (graph_join T (ins_node v graph_empty))"
    by (auto simp: graph_eq_iff)
  also have "tree \<dots>"
    apply (rule join_trees)
    using assms
    by auto
  finally show ?thesis .
qed

text \<open>Remove edges on cycles until the graph is cycle free\<close>
lemma ex_spanning_tree:
  "connected g \<Longrightarrow> \<exists>t. is_spanning_tree g t"
  using edges_finite[of g]
proof (induction "edges g" arbitrary: g rule: finite_psubset_induct)
  case psubset
  show ?case proof (cases "cycle_free g")
    case True
    with \<open>connected g\<close> show ?thesis by (auto simp: is_spanning_tree_def tree_def)
  next
    case False
    then obtain u v where
          EDGE: "(u,v)\<in>edges g"
      and RED: "(u,v)\<in>(edges g - {(u,v),(v,u)})\<^sup>*"
      using cycle_free_altI by metis
    from \<open>connected g\<close>
      have "connected (restrict_edges g (- {(u,v),(v,u)}))" (is "connected ?g'")
      unfolding connected_def
      by (auto simp: remove_redundant_edge[OF RED])
    moreover have "edges ?g' \<subset> edges g" using EDGE by auto
    ultimately obtain t where "is_spanning_tree ?g' t"
      using psubset.hyps(2)[of ?g'] by blast
    hence "is_spanning_tree g t" by (auto simp: is_spanning_tree_def)
    thus ?thesis ..
  qed
qed

section \<open>Weighted Undirected Graphs\<close>

definition weight :: "('v set \<Rightarrow> nat) \<Rightarrow> 'v ugraph \<Rightarrow> nat"
  where "weight w g \<equiv> (\<Sum>e\<in>edges g. w (uedge e)) div 2"

lemma weight_alt: "weight w g = (\<Sum>e\<in>uedge`edges g. w e)"
proof -
  from split_edges_sym[of g] obtain E where
    "edges g = E \<union> E\<inverse>" and "E\<inter>E\<inverse>={}" by auto
  hence [simp, intro!]: "finite E" by (metis edges_finite finite_Un)
  hence [simp, intro!]: "finite (E\<inverse>)" by blast

  have [simp]: "(\<Sum>e\<in>E\<inverse>. w (uedge e)) = (\<Sum>e\<in>E. w (uedge e))"
    apply (rule sum.reindex_cong[where l=prod.swap and A="E\<inverse>" and B="E"])
    by (auto simp: uedge_def insert_commute)

  have [simp]: "inj_on uedge E" using \<open>E\<inter>E\<inverse>=_\<close>
    by (auto simp: uedge_def inj_on_def doubleton_eq_iff)

  have "weight w g = (\<Sum>e\<in>E. w (uedge e))"
    unfolding weight_def \<open>edges g = _\<close> using \<open>E\<inter>E\<inverse>={}\<close>
    by (auto simp: sum.union_disjoint)
  also have "\<dots> = (\<Sum>e\<in>uedge`E. w e)"
    using sum.reindex[of uedge E w]
    by auto
  also have "uedge`E = uedge`(edges g)"
    unfolding \<open>edges g = _\<close> uedge_def using \<open>E\<inter>E\<inverse>={}\<close>
    by auto
  finally show ?thesis .
qed

lemma weight_empty[simp]: "weight w graph_empty = 0" unfolding weight_def by auto

lemma weight_ins_edge[simp]: "\<lbrakk>u\<noteq>v; (u,v)\<notin>edges g\<rbrakk>
  \<Longrightarrow> weight w (ins_edge (u,v) g) = w {u,v} + weight w g"
  unfolding weight_def
  apply clarsimp
  apply (subst sum.insert)
  by (auto dest: edges_sym' simp: uedge_def insert_commute)

lemma uedge_img_disj_iff[simp]:
  "uedge`edges g\<^sub>1 \<inter> uedge`edges g\<^sub>2 = {} \<longleftrightarrow> edges g\<^sub>1 \<inter> edges g\<^sub>2 = {}"
  by (auto simp: uedge_eq_iff dest: edges_sym')+

lemma weight_join[simp]: "edges g\<^sub>1 \<inter> edges g\<^sub>2 = {}
  \<Longrightarrow> weight w (graph_join g\<^sub>1 g\<^sub>2) = weight w g\<^sub>1 + weight w g\<^sub>2"
  unfolding weight_alt by (auto simp: sum.union_disjoint image_Un)

lemma weight_cong: "edges g\<^sub>1 = edges g\<^sub>2 \<Longrightarrow> weight w g\<^sub>1 = weight w g\<^sub>2"
  by (auto simp: weight_def)

lemma weight_mono: "edges g \<subseteq> edges g' \<Longrightarrow> weight w g \<le> weight w g'"
  unfolding weight_alt by (rule sum_mono2) auto

lemma weight_ge_edge:
  assumes "(x,y)\<in>edges T"
  shows "weight w T \<ge> w {x,y}"
  using assms unfolding weight_alt
  by (auto simp: uedge_def intro: member_le_sum)

lemma weight_del_edge[simp]:
  assumes "(x,y)\<in>edges T"
  shows "weight w (restrict_edges T (- {(x, y), (y, x)})) = weight w T - w {x,y}"
proof -
  define E where "E = uedge ` edges T - {{x,y}}"
  have [simp]: "(uedge ` (edges T - {(x, y), (y, x)})) = E"
    by (safe; simp add: E_def uedge_def doubleton_eq_iff; blast)

  from assms have [simp]: "uedge ` edges T = insert {x,y} E"
    unfolding E_def by force

  have [simp]: "{x,y}\<notin>E" unfolding E_def by blast

  then show ?thesis
    unfolding weight_alt
    apply simp
    by (metis E_def \<open>uedge ` edges T = insert {x, y} E\<close> insertI1 sum_diff1_nat)
qed

subsection \<open>Minimum Spanning Trees\<close>

definition "is_MST w g t \<equiv> is_spanning_tree g t
  \<and> (\<forall>t'. is_spanning_tree g t' \<longrightarrow> weight w t \<le> weight w t')"

lemma exists_MST: "connected g \<Longrightarrow> \<exists>t. is_MST w g t"
  using ex_has_least_nat[of "is_spanning_tree g"] ex_spanning_tree
  unfolding is_MST_def
  by blast

end


theory SmallListDemo
imports "$HIPSTER_HOME/IsaHipster"
begin

datatype 'a Lst =
  Emp
  | Cons "'a" "'a Lst"

fun app :: "'a Lst \<Rightarrow> 'a Lst \<Rightarrow> 'a Lst"
where
  "app Emp xs = xs"
| "app (Cons x xs) ys = Cons x (app xs ys)"

hipster app
lemma lemma_a [thy_expl]: "app y Emp = y"
  apply (induct y)
  by simp_all

lemma lemma_aa [thy_expl]: "app (app y z) x2 = app y (app z x2)"
  apply (induct y arbitrary: x2 z)
  by simp_all

fun len ::  "'a Lst \<Rightarrow> nat"
where
  "len Emp = 0"
| "len (Cons x xs) = 1 + (len xs)"

(* hipster app len *)
lemma lemma_ab [thy_expl]: "len y + len z = len (app y z)"
  apply (induct y arbitrary: z)
  by simp_all

fun rev :: "'a Lst \<Rightarrow> 'a Lst"
where
  "rev Emp = Emp"
| "rev (Cons x xs) = app (rev xs) (Cons x Emp)"

(*hipster rev len *)
lemma lemma_ac [thy_expl]: "app (SmallListDemo.rev z) (SmallListDemo.rev y) =
SmallListDemo.rev (app y z)"
  apply hipster_induct
  apply (induct y arbitrary: z)
  apply (simp_all add: lemma_a)
  by (metis lemma_aa)

lemma lemma_ad [thy_expl]: "len (SmallListDemo.rev y) = len y"
  apply (induct y)
  apply simp_all
  by (metis One_nat_def Suc_eq_plus1 Suc_eq_plus1_left lemma_ab len.simps(1) len.simps(2))

lemma lemma_ae [thy_expl]: "SmallListDemo.rev (SmallListDemo.rev y) = y"
  apply (induct y)
  apply simp_all
  by (metis Lst.distinct(1) SmallListDemo.rev.simps(1) SmallListDemo.rev.simps(2) app.elims app.simps(2) lemma_ac)

fun filt :: "('a \<Rightarrow> bool) \<Rightarrow> 'a Lst \<Rightarrow> 'a Lst"
where
  "filt p Emp = Emp"
| "filt p (Cons x xs) = (if (p x) then (Cons x (filt p xs)) else (filt p xs))"

hipster app filt
lemma lemma_af [thy_expl]: "filt y (filt y z) = filt y z"
  apply (induct z)
  by simp_all

lemma lemma_ag [thy_expl]: "filt z (filt y x2) = filt y (filt z x2)"
  apply (induct x2)
  by simp_all

lemma lemma_ah [thy_expl]: "app (filt y z) (filt y x2) = filt y (app z x2)"
  apply (induct z arbitrary: x2)
  by simp_all

fun mem :: "'a \<Rightarrow> 'a Lst \<Rightarrow> bool"
where
  "mem x Emp = False"
| "mem x (Cons y ys) = ((x=y) \<or> (mem x ys))"

hipster mem rev
lemma lemma_ai [thy_expl]: "mem y (app x2 (Lst.Cons z x3)) = mem y (Lst.Cons z (app x2 x3))"
  apply (induct x2 arbitrary: x3)
  apply simp_all
  by auto

lemma lemma_aj [thy_expl]: "mem y (app z (app z x2)) = mem y (app z x2)"
  apply (induct z arbitrary: x2)
  by (simp_all add: lemma_ai)

lemma lemma_ak [thy_expl]: "mem y (app z (app x3 x2)) = mem y (app z (app x2 x3))"
  apply (induct x2 arbitrary: x3 z)
  apply (simp_all add: lemma_a)
  by (metis lemma_aa lemma_ai mem.simps(2))

lemma lemma_al [thy_expl]: "mem y (SmallListDemo.rev z) = mem y z"
  apply (induct z)
  by (simp_all add: lemma_a lemma_ai)

lemma lemma_am [thy_expl]: "mem y (app z (SmallListDemo.rev x2)) = mem y (app z x2)"
  apply (induct x2 arbitrary: z)
  apply simp_all
  by (smt SmallListDemo.rev.simps(2) app.simps(2) lemma_ac lemma_ae lemma_ai lemma_al mem.simps(2))

end


theory Ex20
imports Main
begin

(*distributivity of "or" over "and"*)
lemma "A \<or> (B \<and> C) \<longleftrightarrow> (A \<or> B) \<and> (A \<or> C)"
proof -
{
  assume "A \<or> (B \<and> C)"
  {
    assume A
    hence "A \<or> B" by (rule disjI1)
    from \<open>A\<close> have "A \<or> C" by (rule disjI1)
    with \<open>A \<or> B\<close> have "(A \<or> B) \<and> (A \<or> C)" by (rule conjI)
  }
  moreover
  {
    assume "B \<and> C"
    hence C by (rule conjE)
    from \<open>B \<and> C\<close> have B by (rule conjE)
    hence "A \<or> B" by (rule disjI2)
    from \<open>C\<close> have "A \<or> C" by (rule disjI2)
    with \<open>A \<or> B\<close> have "(A \<or> B) \<and> (A \<or> C)" by (rule conjI)
  }
  from \<open>A \<or> (B \<and> C)\<close> and  calculation and this have " (A \<or> B) \<and> (A \<or> C)" by (rule disjE)
}
moreover
{
  assume "(A \<or> B) \<and> (A \<or> C)"
  hence "(A \<or> B)" by (rule conjE)
  from \<open>(A \<or> B) \<and> (A \<or> C)\<close> have "(A \<or> C)" by (rule conjE)
  {
    assume A
    hence "A \<or> (B \<and> C)" by (rule disjI1)
  }
  moreover
  {
    assume C
    {
      assume A
      hence "A \<or> (B \<and> C)" by (rule disjI1)
    }
    moreover
    {
      assume B
      from this and  \<open>C\<close> have "B \<and> C" by (rule conjI)
      hence  "A \<or> (B \<and> C)" by (rule disjI2)
    }
    from \<open>A \<or> B\<close> and  calculation and this  have "A \<or> (B \<and> C)" by (rule disjE)
  }
  from \<open>A \<or> C\<close> and calculation and this  have  "A \<or> (B \<and> C)" by (rule disjE)
}
ultimately show ?thesis by (rule iffI)
qed