section \<open>The Pointwise Less-Than Relation Between Two Sets\<close>

theory Nash_Extras
  imports "HOL-Library.Ramsey" "HOL-Library.Countable_Set"

begin

definition less_sets :: "['a::order set, 'a::order set] \<Rightarrow> bool" (infixr "\<lless>" 50)
    where "A \<lless> B \<equiv> \<forall>x\<in>A. \<forall>y\<in>B. x < y"

lemma less_setsD: "\<lbrakk>A \<lless> B; a \<in> A; b \<in> B\<rbrakk> \<Longrightarrow> a < b"
  by (auto simp: less_sets_def)

lemma less_sets_irrefl [simp]: "A \<lless> A \<longleftrightarrow> A = {}"
  by (auto simp: less_sets_def)

lemma less_sets_trans: "\<lbrakk>A \<lless> B; B \<lless> C; B \<noteq> {}\<rbrakk> \<Longrightarrow> A \<lless> C"
  unfolding less_sets_def using less_trans by blast

lemma less_sets_weaken1: "\<lbrakk>A' \<lless> B; A \<subseteq> A'\<rbrakk> \<Longrightarrow> A \<lless> B"
  by (auto simp: less_sets_def)

lemma less_sets_weaken2: "\<lbrakk>A \<lless> B'; B \<subseteq> B'\<rbrakk> \<Longrightarrow> A \<lless> B"
  by (auto simp: less_sets_def)

lemma less_sets_imp_disjnt: "A \<lless> B \<Longrightarrow> disjnt A B"
  by (auto simp: less_sets_def disjnt_def)

lemma less_sets_UN1: "less_sets (\<Union>\<A>) B \<longleftrightarrow> (\<forall>A\<in>\<A>. A \<lless> B)"
  by (auto simp: less_sets_def)

lemma less_sets_UN2: "less_sets A (\<Union> \<B>) \<longleftrightarrow> (\<forall>B\<in>\<B>. A \<lless> B)"
  by (auto simp: less_sets_def)

lemma less_sets_Un1: "less_sets (A \<union> A') B \<longleftrightarrow> A \<lless> B \<and> A' \<lless> B"
  by (auto simp: less_sets_def)

lemma less_sets_Un2: "less_sets A (B \<union> B') \<longleftrightarrow> A \<lless> B \<and> A \<lless> B'"
  by (auto simp: less_sets_def)

lemma strict_sorted_imp_less_sets:
  "strict_sorted (as @ bs) \<Longrightarrow> (list.set as) \<lless> (list.set bs)"
  by (simp add: less_sets_def sorted_wrt_append)

lemma Sup_nat_less_sets_singleton:
  fixes n::nat
  assumes "Sup T < n" "finite T"
  shows "less_sets T {n}"
  using assms Max_less_iff
  by (auto simp: Sup_nat_def less_sets_def split: if_split_asm)

end


section \<open>Isabelle Formalization I\<close>

theory Boo1 imports Main
begin

text "Boolos's inference"

locale boolax_1 =
  fixes F :: " 'a \<times> 'a \<Rightarrow> 'a "
  fixes s :: " 'a \<Rightarrow> 'a "
  fixes D :: " 'a \<Rightarrow>  bool "
  fixes e ::  " 'a "
  assumes A1: "F(x, e) = s(e)"
  and A2:  "F(e, s(y)) = s(s(F(e, y)))"
  and A3: "F(s(x), s(y)) = F(x, F(s(x), y))"
  and A4:  "D(e)"
  and A5: "D(x) \<longrightarrow> D(s(x))"

context boolax_1
begin

text "Definitions"

definition (in boolax_1) induct :: "'a set => bool"
  where " induct X \<equiv> e \<in> X \<and> (\<forall>x. (x \<in> X \<longrightarrow> s(x) \<in>  X))"

definition (in boolax_1) N :: "'a \<Rightarrow> bool"
  where "N x \<equiv> (\<forall>X. (induct X \<longrightarrow> x \<in> X))"

definition (in boolax_1) E :: "'a \<Rightarrow> bool"
  where "E x \<equiv> (N x \<and> D x)"

definition (in boolax_1) M :: "'a \<Rightarrow> bool"
  where "M x \<equiv> (\<forall>y. (N y \<longrightarrow>  E(F(x, y))))"

definition (in boolax_1) Q :: "'a \<Rightarrow> bool"
  where "Q x \<equiv> E(F(e, x))"

text "Lemmas"

lemma lem1: "N e" by (simp add: N_def induct_def)

lemma lem3: "N(s(s(s(s(e)))))" by (simp add: lem1 lem2)

lemma lem4: "E e" using A4 E_def lem1 by auto

lemma lem5: "E x \<longrightarrow> E(s(x))" by (simp add: A5 E_def lem2)

lemma lem6: "E(s(e))" by (simp add: lem4 lem5)

lemma lem7: "Q e" by (simp add: A1 Q_def lem6)

lemma lem8: "Q x \<longrightarrow> Q(s(x))" by (simp add: A2 Q_def lem5)

lemma lem9: "N x \<longrightarrow> Q x" by (metis N_def induct_def lem7 lem8 mem_Collect_eq)

lemma lem10: "M e"  by (meson Q_def M_def lem9)

lemma lem11: "E (F(s(n), e))" by (simp add: A1 lem6)

lemma lem12: "M x \<and> E (F(s(x), y)) \<longrightarrow> E (F(s(x), s(y)))" by (simp add: A3 E_def M_def)

lemma lem13: "M x \<longrightarrow> induct {y. E (F(s(x), y))}" using A1 induct_def lem12 lem6 by auto

lemma lem14: "M x \<longrightarrow> M(s(x))" by (metis CollectD M_def N_def lem13)

lemma lem15: "N x \<longrightarrow> M x" by (metis N_def induct_def lem10 lem14 mem_Collect_eq)

lemma lem16: "N x \<and> N y \<longrightarrow> E(F(x,y))" using M_def lem15 by blast

lemma lem17: "E(F(s(s(s(s(e)))), s(s(s(s(e))))))" by (simp add: lem16 lem3)

lemma lem18: "D(F(s(s(s(s(e)))), s(s(s(s(e))))))" using E_def lem17 by auto

end

end


theory ex_2_10
  imports Main
begin
datatype tree0 = Tip | Node tree0 tree0

fun nodes::"tree0 \<Rightarrow> nat" where
"nodes Tip = 1" |
"nodes (Node l r) = 1 + (nodes l) + (nodes r)"
fun explode::"nat \<Rightarrow> tree0 \<Rightarrow> tree0" where
"explode 0 t = t" |
"explode (Suc n) t = explode n (Node t t)"

lemma explode_size_ind: "nodes(explode (Suc n) t) = Suc(2 * nodes(explode n t))"
  apply(induction n arbitrary:t)
  by(auto)
lemma inv_Suc:"Suc y = k \<Longrightarrow> y = k - 1"
  by(auto)

theorem explode_size[simp]: "nodes(explode n t) = 2 ^ n * Suc(nodes t) - 1"
  apply(rule inv_Suc)
  apply(induction n)
  apply(simp)
  by(auto simp add: explode_size_ind simp del:explode.simps)
end


(*
    $Id: ex.thy,v 1.4 2012/01/04 14:35:44 webertj Exp $
    Author: Farhad Mehta
*)

header {* Recursive Functions and Induction: Zip *}

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

text {*
Read the chapter about total recursive functions in the ``Tutorial on
Isabelle/HOL'' (@{text fun}, Chapter 3.5).
*}

text {*
In this exercise you will define a function @{text Zip} that merges two lists
by interleaving.
 Examples:
@{text "Zip [a1, a2, a3]  [b1, b2, b3] = [a1, b1, a2, b2, a3, b3]"}
 and
@{text "Zip [a1] [b1, b2, b3] = [a1, b1, b2, b3]"}.

Use three different approaches to define @{text Zip}:
\begin{enumerate}
\item by primitive recursion on the first list,
\item by primitive recursion on the second list,
\item by total recursion (using @{text fun}).
\end{enumerate}
*}

consts zip1 :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
consts zip2 :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"
consts zipr :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"

text {*
Show that all three versions of @{text Zip} are equivalent.
*}

text {*
Show that @{text zipr} distributes over @{text append}.
*}

lemma "\<lbrakk>length p = length u; length q = length v\<rbrakk> \<Longrightarrow>
  zipr (p@q) (u@v) = zipr p u @ zipr q v"
(*<*) oops (*>*)

text {*
{\bf Note:} For @{text fun}, the order of your equations is relevant.
If equations overlap, they will be disambiguated before they are added
to the logic.  You can have a look at these equations using @{text
"thm zipr.simps"}.
*}

(*<*) end (*>*)


theory Chap2_2
  imports Main
begin

datatype nat = Z | Suc nat

fun add :: "nat \<Rightarrow> nat \<Rightarrow> nat" where
"add Z n = n"
| "add (Suc m) n = Suc (add m n)"

lemma add_b: "add n Z = n"
  apply (induction n)
   apply (rule add.simps(1))
  apply (subst add.simps(2))
  apply (subst nat.inject)
  apply assumption
  done

lemma add_i:
  assumes f1: "\<And>m. add m n = add n m"
  shows "add m (Suc n) = add (Suc n) m"
  apply (induction m)
   apply (subst add.simps(1))
   apply (rule add_b[symmetric])
  apply (subst (1 2) add.simps(2))
  apply (subst nat.inject)
  apply (subst f1[symmetric])
  apply (subst add.simps(2))
  apply (subst f1)
  apply (subst add.simps(2)[symmetric])
  by assumption

lemma add_comm: "add m n = add n m"
  apply (induction n arbitrary: m)
   apply (subst add.simps(1))
   apply (rule add_b)
  apply (erule add_i)
  done

value "1 + (2::Nat.nat)"

value "1 + (2::int)"

value "1 - (2::Nat.nat)"

value "1 - (2::int)"

fun double :: "nat \<Rightarrow> nat" where
"double Z = Z"
| "double (Suc n) = Suc (Suc (double n))"

lemma double_add: "double n = add n n"
  apply (induction n)
   apply simp+
  apply (subst (2) add_comm)
  by simp

fun count :: "'a list \<Rightarrow> 'a \<Rightarrow> Nat.nat" where
"count [] y = 0"
| "count (x#xs) y = (if x = y then 1 else 0) + count xs y"

lemma count_leq_len: "count xs y \<le> length xs"
  apply (induction xs)
  by simp+

fun snoc :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a list" where
"snoc [] y = [y]"
| "snoc (x#xs) y = x#(snoc xs y)"

fun rev :: "'a list \<Rightarrow> 'a list" where
"rev [] = []"
| "rev (x#xs) = snoc (rev xs) x"

lemma rev_snoc: "rev (snoc xs x) = x#(rev xs)"
  apply (induction xs)
   apply simp
  apply (subst snoc.simps)
  apply (subst rev.simps)
  apply (rule_tac a="rev (snoc xs x)" and b="x#rev xs" in forw_subst)
   apply assumption
  apply (subst snoc.simps)
  apply (subst rev.simps)
  by (rule refl)

lemma rev_inv: "rev (rev xs) = xs"
  apply (induction xs)
   apply simp
  by (simp add: rev_snoc)

fun sum_upto :: "Nat.nat \<Rightarrow> Nat.nat" where
"sum_upto 0 = 0"
| "sum_upto (Nat.Suc n) = n + 1 + sum_upto n"

lemma "sum_upto n = n * (n + 1) div 2"
  apply (induction n)
   apply simp
  apply (subst sum_upto.simps)
  apply (rule_tac a="sum_upto n" and b="n * (n+1) div 2" in forw_subst)
  by simp+

end