(*  Title:      HOL/Library/Indicator_Function.thy
    Author:     Johannes Hoelzl (TU Muenchen)
*)

section \<open>Indicator Function\<close>

theory Indicator_Function
imports Complex_Main Disjoint_Sets
begin

definition "indicator S x = of_bool (x \<in> S)"

text\<open>Type constrained version\<close>
abbreviation indicat_real :: "'a set \<Rightarrow> 'a \<Rightarrow> real" where "indicat_real S \<equiv> indicator S"

lemma indicator_simps[simp]:
  "x \<in> S \<Longrightarrow> indicator S x = 1"
  "x \<notin> S \<Longrightarrow> indicator S x = 0"
  unfolding indicator_def by auto

lemma indicator_pos_le[intro, simp]: "(0::'a::linordered_semidom) \<le> indicator S x"
  and indicator_le_1[intro, simp]: "indicator S x \<le> (1::'a::linordered_semidom)"
  unfolding indicator_def by auto

lemma indicator_abs_le_1: "\<bar>indicator S x\<bar> \<le> (1::'a::linordered_idom)"
  unfolding indicator_def by auto

lemma indicator_eq_0_iff: "indicator A x = (0::'a::zero_neq_one) \<longleftrightarrow> x \<notin> A"
  by (auto simp: indicator_def)

lemma indicator_eq_1_iff: "indicator A x = (1::'a::zero_neq_one) \<longleftrightarrow> x \<in> A"
  by (auto simp: indicator_def)

lemma indicator_UNIV [simp]: "indicator UNIV = (\<lambda>x. 1)"
  by auto

lemma indicator_leI:
  "(x \<in> A \<Longrightarrow> y \<in> B) \<Longrightarrow> (indicator A x :: 'a::linordered_nonzero_semiring) \<le> indicator B y"
  by (auto simp: indicator_def)

lemma split_indicator: "P (indicator S x) \<longleftrightarrow> ((x \<in> S \<longrightarrow> P 1) \<and> (x \<notin> S \<longrightarrow> P 0))"
  unfolding indicator_def by auto

lemma split_indicator_asm: "P (indicator S x) \<longleftrightarrow> (\<not> (x \<in> S \<and> \<not> P 1 \<or> x \<notin> S \<and> \<not> P 0))"
  unfolding indicator_def by auto

lemma indicator_inter_arith: "indicator (A \<inter> B) x = indicator A x * (indicator B x::'a::semiring_1)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_union_arith:
  "indicator (A \<union> B) x = indicator A x + indicator B x - indicator A x * (indicator B x :: 'a::ring_1)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_inter_min: "indicator (A \<inter> B) x = min (indicator A x) (indicator B x::'a::linordered_semidom)"
  and indicator_union_max: "indicator (A \<union> B) x = max (indicator A x) (indicator B x::'a::linordered_semidom)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_disj_union:
  "A \<inter> B = {} \<Longrightarrow> indicator (A \<union> B) x = (indicator A x + indicator B x :: 'a::linordered_semidom)"
  by (auto split: split_indicator)

lemma indicator_compl: "indicator (- A) x = 1 - (indicator A x :: 'a::ring_1)"
  and indicator_diff: "indicator (A - B) x = indicator A x * (1 - indicator B x ::'a::ring_1)"
  unfolding indicator_def by (auto simp: min_def max_def)

lemma indicator_times:
  "indicator (A \<times> B) x = indicator A (fst x) * (indicator B (snd x) :: 'a::semiring_1)"
  unfolding indicator_def by (cases x) auto

lemma indicator_sum:
  "indicator (A <+> B) x = (case x of Inl x \<Rightarrow> indicator A x | Inr x \<Rightarrow> indicator B x)"
  unfolding indicator_def by (cases x) auto

lemma indicator_image: "inj f \<Longrightarrow> indicator (f ` X) (f x) = (indicator X x::_::zero_neq_one)"
  by (auto simp: indicator_def inj_def)

lemma indicator_vimage: "indicator (f -` A) x = indicator A (f x)"
  by (auto split: split_indicator)

lemma mult_indicator_cong:
  fixes f g :: "_ \<Rightarrow> 'a :: semiring_1"
  shows "(\<And>x. x \<in> A \<Longrightarrow> f x = g x) \<Longrightarrow> indicator A x * f x = indicator A x * g x"
  by (auto simp: indicator_def)

lemma
  fixes f :: "'a \<Rightarrow> 'b::semiring_1"
  assumes "finite A"
  shows sum_mult_indicator[simp]: "(\<Sum>x \<in> A. f x * indicator B x) = (\<Sum>x \<in> A \<inter> B. f x)"
    and sum_indicator_mult[simp]: "(\<Sum>x \<in> A. indicator B x * f x) = (\<Sum>x \<in> A \<inter> B. f x)"
  unfolding indicator_def
  using assms by (auto intro!: sum.mono_neutral_cong_right split: if_split_asm)

lemma sum_indicator_eq_card:
  assumes "finite A"
  shows "(\<Sum>x \<in> A. indicator B x) = card (A Int B)"
  using sum_mult_indicator [OF assms, of "\<lambda>x. 1::nat"]
  unfolding card_eq_sum by simp

lemma sum_indicator_scaleR[simp]:
  "finite A \<Longrightarrow>
    (\<Sum>x \<in> A. indicator (B x) (g x) *\<^sub>R f x) = (\<Sum>x \<in> {x\<in>A. g x \<in> B x}. f x :: 'a::real_vector)"
  by (auto intro!: sum.mono_neutral_cong_right split: if_split_asm simp: indicator_def)

lemma LIMSEQ_indicator_incseq:
  assumes "incseq A"
  shows "(\<lambda>i. indicator (A i) x :: 'a::{topological_space,zero_neq_one}) \<longlonglongrightarrow> indicator (\<Union>i. A i) x"
proof (cases "\<exists>i. x \<in> A i")
  case True
  then obtain i where "x \<in> A i"
    by auto
  then have *:
    "\<And>n. (indicator (A (n + i)) x :: 'a) = 1"
    "(indicator (\<Union>i. A i) x :: 'a) = 1"
    using incseqD[OF \<open>incseq A\<close>, of i "n + i" for n] \<open>x \<in> A i\<close> by (auto simp: indicator_def)
  show ?thesis
    by (rule LIMSEQ_offset[of _ i]) (use * in simp)
next
  case False
  then show ?thesis by (simp add: indicator_def)
qed

lemma LIMSEQ_indicator_UN:
  "(\<lambda>k. indicator (\<Union>i<k. A i) x :: 'a::{topological_space,zero_neq_one}) \<longlonglongrightarrow> indicator (\<Union>i. A i) x"
proof -
  have "(\<lambda>k. indicator (\<Union>i<k. A i) x::'a) \<longlonglongrightarrow> indicator (\<Union>k. \<Union>i<k. A i) x"
    by (intro LIMSEQ_indicator_incseq) (auto simp: incseq_def intro: less_le_trans)
  also have "(\<Union>k. \<Union>i<k. A i) = (\<Union>i. A i)"
    by auto
  finally show ?thesis .
qed

lemma LIMSEQ_indicator_decseq:
  assumes "decseq A"
  shows "(\<lambda>i. indicator (A i) x :: 'a::{topological_space,zero_neq_one}) \<longlonglongrightarrow> indicator (\<Inter>i. A i) x"
proof (cases "\<exists>i. x \<notin> A i")
  case True
  then obtain i where "x \<notin> A i"
    by auto
  then have *:
    "\<And>n. (indicator (A (n + i)) x :: 'a) = 0"
    "(indicator (\<Inter>i. A i) x :: 'a) = 0"
    using decseqD[OF \<open>decseq A\<close>, of i "n + i" for n] \<open>x \<notin> A i\<close> by (auto simp: indicator_def)
  show ?thesis
    by (rule LIMSEQ_offset[of _ i]) (use * in simp)
next
  case False
  then show ?thesis by (simp add: indicator_def)
qed

lemma LIMSEQ_indicator_INT:
  "(\<lambda>k. indicator (\<Inter>i<k. A i) x :: 'a::{topological_space,zero_neq_one}) \<longlonglongrightarrow> indicator (\<Inter>i. A i) x"
proof -
  have "(\<lambda>k. indicator (\<Inter>i<k. A i) x::'a) \<longlonglongrightarrow> indicator (\<Inter>k. \<Inter>i<k. A i) x"
    by (intro LIMSEQ_indicator_decseq) (auto simp: decseq_def intro: less_le_trans)
  also have "(\<Inter>k. \<Inter>i<k. A i) = (\<Inter>i. A i)"
    by auto
  finally show ?thesis .
qed

lemma indicator_add:
  "A \<inter> B = {} \<Longrightarrow> (indicator A x::_::monoid_add) + indicator B x = indicator (A \<union> B) x"
  unfolding indicator_def by auto

lemma of_real_indicator: "of_real (indicator A x) = indicator A x"
  by (simp split: split_indicator)

lemma real_of_nat_indicator: "real (indicator A x :: nat) = indicator A x"
  by (simp split: split_indicator)

lemma abs_indicator: "\<bar>indicator A x :: 'a::linordered_idom\<bar> = indicator A x"
  by (simp split: split_indicator)

lemma mult_indicator_subset:
  "A \<subseteq> B \<Longrightarrow> indicator A x * indicator B x = (indicator A x :: 'a::comm_semiring_1)"
  by (auto split: split_indicator simp: fun_eq_iff)

lemma indicator_times_eq_if:
  fixes f :: "'a \<Rightarrow> 'b::comm_ring_1"
  shows "indicator S x * f x = (if x \<in> S then f x else 0)" "f x * indicator S x = (if x \<in> S then f x else 0)"
  by auto

lemma indicator_scaleR_eq_if:
  fixes f :: "'a \<Rightarrow> 'b::real_vector"
  shows "indicator S x *\<^sub>R f x = (if x \<in> S then f x else 0)"
  by simp

lemma indicator_sums:
  assumes "\<And>i j. i \<noteq> j \<Longrightarrow> A i \<inter> A j = {}"
  shows "(\<lambda>i. indicator (A i) x::real) sums indicator (\<Union>i. A i) x"
proof (cases "\<exists>i. x \<in> A i")
  case True
  then obtain i where i: "x \<in> A i" ..
  with assms have "(\<lambda>i. indicator (A i) x::real) sums (\<Sum>i\<in>{i}. indicator (A i) x)"
    by (intro sums_finite) (auto split: split_indicator)
  also have "(\<Sum>i\<in>{i}. indicator (A i) x) = indicator (\<Union>i. A i) x"
    using i by (auto split: split_indicator)
  finally show ?thesis .
next
  case False
  then show ?thesis by simp
qed

text \<open>
  The indicator function of the union of a disjoint family of sets is the
  sum over all the individual indicators.
\<close>

lemma indicator_UN_disjoint:
  "finite A \<Longrightarrow> disjoint_family_on f A \<Longrightarrow> indicator (\<Union>(f ` A)) x = (\<Sum>y\<in>A. indicator (f y) x)"
  by (induct A rule: finite_induct)
    (auto simp: disjoint_family_on_def indicator_def split: if_splits split_of_bool_asm)

end


theory SumOfRange
imports Main
begin

fun sum :: "nat list \<Rightarrow> nat" where
   "sum xs = foldl (op+) 0 xs"

fun egnar :: "nat \<Rightarrow> nat list" where
   "egnar x = (if x \<le> 0 then [] else x # egnar (x-1))"

fun range :: "nat \<Rightarrow> nat list" where
   "range x = rev (egnar x)"

fun sr :: "nat \<Rightarrow> nat" where
   "sr n = (if n\<le>0 then 0 else n + (sr (n-1)))"

theorem sum_range_0 [simp]: "sum (range 0) = 0"
by auto

theorem sum_range [simp]: "n > 0 \<Longrightarrow> sum (range n) = n + sum (range (n-1))"
by (induction n; auto)

theorem srsimp [simp]: "n > 0 \<Longrightarrow> sum (range n) = sr n"
by (induction n; auto)

theorem sr2 [simp]: "n > 0 \<Longrightarrow> 2 * (sr n) = n * (n + 1)"
by (induction n; auto)

theorem
  assumes "n > 0"
  shows "sum (range n) = (n * (n+1)) div 2" (is "?x = _")
proof -
  have  "     ?x =     sr n"       using assms by (simp only: srsimp)
  hence " 2 * ?x = 2 * sr n"       by auto
  hence " 2 * ?x = n * (n + 1)"    using assms by (simp only: sr2)
  thus ?thesis by auto
qed

end


theory Chapter3
imports Main
begin

type_synonym vname = string
type_synonym val = int
type_synonym state = "vname \<Rightarrow> val"

datatype aexp = N int | V vname | Plus aexp aexp

fun aval :: "aexp \<Rightarrow> state \<Rightarrow> val" where
  "aval (N n) s = n" |
  "aval (V v) s = s v" |
  "aval (Plus l r) s = aval l s + aval r s"
value "aval (Plus (N 3) (V ''x'')) ((\<lambda>x. 0) (''x'' := 7))"
value "aval (Plus (V ''y'') (V ''x'')) ((\<lambda>x. 0) (''x'' := 7, ''y'' := 30))"

fun asimp_const :: "aexp \<Rightarrow> aexp" where
  "asimp_const (N n) = N n" |
  "asimp_const (V v) = V v" |
  "asimp_const (Plus l r) = (case (asimp_const l, asimp_const r) of
    (N a, N b) \<Rightarrow> N (a + b) |
    (a, b) \<Rightarrow> Plus a b)"
value "aval (Plus (N 40) (N 2)) (\<lambda>x. 0)"

lemma "aval (asimp_const e) s = aval e s"
  apply (induction e)
  apply (auto split: aexp.split)
  done

fun plus :: "aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
  "plus (N a) (N b) = N (a + b)" |
  "plus (N a) r = (if a = 0 then r else Plus (N a) r)" |
  "plus l (N b) = (if b = 0 then l else Plus l (N b))" |
  "plus l r = Plus l r"

lemma aval_plus [simp]: "aval (plus l r) s = aval l s + aval r s"
  apply (induction l rule: plus.induct)
  apply auto
  done

fun asimp :: "aexp \<Rightarrow> aexp" where
  "asimp (N n) = N n" |
  "asimp (V v) = V v" |
  "asimp (Plus l r) = plus (asimp l) (asimp r)"

lemma "aval (asimp e) s = aval e s"
  apply (induction e)
  apply (auto split: aexp.split)
  done

(* Ex. 3.1 *)
(* Determines if the specified expression has no foldable expressions. *)
fun optimal :: "aexp \<Rightarrow> bool" where
  "optimal (N n) = True" |
  "optimal (V v) = True" |
  "optimal (Plus (N a) (N b)) = False" |
  "optimal (Plus l r) = ((optimal l) & (optimal r))"
value "optimal (N 4) = True"
value "optimal (Plus (N 4) (V ''x'')) = True"
value "optimal (Plus (N 4) (N 3)) = False"

lemma "optimal (asimp_const e) = True"
  apply (induction e)
  apply (auto split: aexp.split)
  done

(* Ex. 3.2 *)
(* Returns the sum of all numerals in the specified expression. *)
fun sumN :: "aexp \<Rightarrow> int" where
  "sumN (N n) = n" |
  "sumN (V v) = 0" |
  "sumN (Plus l r) = (sumN l) + (sumN r)"
value "sumN (Plus (N (-1)) (V [])) = -1"

(* Returns the specified expression with numerals replaced by 0. *)
fun zeroN :: "aexp \<Rightarrow> aexp" where
  "zeroN (N n) = N 0" |
  "zeroN (V v) = V v" |
  "zeroN (Plus l r) = Plus (zeroN l) (zeroN r)"
value "zeroN (Plus (N (- 1)) (V [])) = zeroN (Plus (N 0) (V []))"

(* Returns 'sumN e + zeroN e' *)
fun sepN :: "aexp \<Rightarrow> aexp" where
  "sepN e = Plus (N (sumN e)) (zeroN e)"
value "sepN (Plus (N (- 1)) (V []))"

lemma aval_sepN: "aval (sepN e) s = aval e s"
  apply (induction e)
  apply auto
  done

(* Simplifies the specified expression. *)
fun full_asimp :: "aexp \<Rightarrow> aexp" where
  "full_asimp e = asimp (sepN e)"
value "full_asimp (Plus (Plus ((Plus (V ''x'') (N 7))) (V ''x'')) (N 5))"

lemma aval_full_asimp: "aval (full_asimp e) s = aval e s"
  apply (induction e)
  apply (auto split: aexp.split)
  done

(* Ex. 3.3 *)
(* Substitutes the variable in the expression by the specified expression. *)
fun subst :: "vname \<Rightarrow> aexp \<Rightarrow> aexp \<Rightarrow> aexp" where
  "subst x a (N n) = N n" |
  "subst x a (V v) = (if x = v then a else (V v))" |
  "subst x a (Plus l r) = Plus (subst x a l) (subst x a r)"

lemma subst_

lemma "aval a1 s = aval a2 s \<Longrightarrow> aval (subst x a1 b) s = aval (subst x a2 b) s"
  apply (induction b)
  apply auto
  done

(* Ex. 3.4 *)
(* `aexp` equipped with times operation. *)
datatype aexpt = Nt int | Vt vname | Plust aexpt aexpt | Timest aexpt aexpt

(* Evaluates the specified `aexpt`-expression. *)
fun avalt :: "aexpt \<Rightarrow> state \<Rightarrow> val" where
  "avalt (Nt n) s = n" |
  "avalt (Vt x) s = s x" |
  "avalt (Plust l r) s = avalt l s + avalt r s" |
  "avalt (Timest l r) s = avalt l s * avalt r s"
value "avalt (Timest (Nt 3) (Vt ''x'')) ((\<lambda>x.0) (''x'':=7))"
value "avalt (Timest (Vt ''y'') (Vt ''x'')) ((\<lambda>x.0)(''x'':=7, ''y'':=30))"

(* Folds numeral constants in Plus-expression. *)
fun plust :: "aexpt \<Rightarrow> aexpt \<Rightarrow> aexpt" where
  "plust (Nt l) (Nt r) = Nt (l + r)" |
  "plust (Nt l) r = (if l = 0 then r else Plust (Nt l) r)" |
  "plust l (Nt r) = (if r = 0 then l else Plust l (Nt r))" |
  "plust l r = Plust l r"

(* Folds numeral constants in Times-expression. *)
fun timest :: "aexpt \<Rightarrow> aexpt \<Rightarrow> aexpt" where
  "timest (Nt l) (Nt r) = Nt (l * r)" |
  "timest (Nt l) r = (if l = 0 then (Nt 0) else if l = 1 then r else Timest (Nt l) r)" |
  "timest l (Nt r) = (if r = 0 then (Nt 0) else if r = 1 then l else Timest l (Nt r))" |
  "timest l r = Timest l r"

(* Simplifies the `aexpt`-expression. *)
fun asimpt :: "aexpt \<Rightarrow> aexpt" where
  "asimpt (Nt n) = Nt n" |
  "asimpt (Vt x) = Vt x" |
  "asimpt (Plust l r) = plust (asimpt l) (asimpt r)" |
  "asimpt (Timest l r) = timest (asimpt l) (asimpt r)"

lemma avalt_plus [simp]: "avalt (plust l r) s = avalt l s + avalt r s"
  apply (induction rule: plust.induct)
  apply auto
  done

lemma avalt_times [simp]: "avalt (timest l r) s = avalt l s * avalt r s"
  apply (induction rule: timest.induct)
  apply auto
  done

lemma "avalt (asimpt a) s = avalt a s"
  apply (induction a)
  apply auto
  done

(* Ex. 3.5 *)
(* Expression equipped with post-increment and division operations. *)
datatype aexp2 = N2 int | V2 vname | Incr2 vname
  | Plus2 aexp2 aexp2 | Times2 aexp2 aexp2 | Div2 aexp2 aexp2

(* Evaluates the specified `aexp2`-expression. *)
fun aval2 :: "aexp2 \<Rightarrow> state \<Rightarrow> (val \<times> state) option" where
  "aval2 (N2 n) s = Some (n, s)" |
  "aval2 (V2 x) s = Some (s x, s)" |
  "aval2 (Incr2 x) s = Some (s x, s(x := 1 + s x))" |
  "aval2 (Plus2 l r) s = (case (aval2 l s) of
    None \<Rightarrow> None |
    Some a \<Rightarrow> (case (aval2 r (snd a)) of
      None \<Rightarrow> None |
      Some b \<Rightarrow> Some ((fst a + fst b), snd b)))" |
  "aval2 (Times2 l r) s = (case (aval2 l s) of
    None \<Rightarrow> None |
    Some a \<Rightarrow> (case (aval2 r (snd a)) of
      None \<Rightarrow> None |
      Some b \<Rightarrow> Some ((fst a + fst b), snd b)))" |
  "aval2 (Div2 l r) s = (case (aval2 l s) of
    None \<Rightarrow> None |
    Some a \<Rightarrow> (case (aval2 r (snd a)) of
      None \<Rightarrow> None |
      Some b \<Rightarrow> if (fst b) = 0 then None else Some ((fst a div fst b), snd b)))"
value "aval2 (Incr2 ''a'') ((\<lambda>x. 0) (''a'':=1))"
value "aval2 (Plus2 (Incr2 ''a'') (V2 ''a'')) ((\<lambda>x.0) (''a'':=1))"
value "aval2 (Div2 (N2 4) (N2 2)) (\<lambda>x. 0)"
value "aval2 (Div2 (N2 4) (V2 ''x'')) ((\<lambda>x. 0) (''x'':=0)) = None"

(* Ex. 3.6 *)
(* let x = e_1 in e_2 *)
datatype lexp = Nl int | Vl vname | Plusl lexp lexp | Let vname lexp lexp

(* Evaluates the specified `lexp`-expression. *)
fun lval :: "lexp \<Rightarrow> state \<Rightarrow> int" where
  "lval (Nl n) s = n" |
  "lval (Vl x) s = s x" |
  "lval (Plusl l r) s = lval l s + lval r s" |
  "lval (Let x a b) s = lval b (s(x:=lval a s))"
value "lval (Let ''x'' (Nl 19) (Plusl (Nl 1) (Vl ''x''))) (\<lambda>x. 0)"

(* Inlines `lexp` into `aexp`. *)
fun inline :: "lexp \<Rightarrow> aexp" where
  "inline (Nl n) = (aexp.N n)" |
  "inline (Vl x) = (aexp.V x)" |
  "inline (Plusl l r) = aexp.Plus (inline l) (inline r)" |
  "inline (Let x a b) = subst x (inline a) (inline b)"

lemma "aval (inline a) s = lval a s"
  apply (induction a arbitrary:s)
  apply (auto)
  done

(* 3.2 Boolean Expressions *)
(* Defines boolean expression. *)
datatype bexp = Bc bool | Not bexp | And bexp bexp | Less aexp aexp

(* Evaluates boolean expression. *)
fun bval :: "bexp \<Rightarrow> state \<Rightarrow> bool" where
  "bval (Bc v) s = v" |
  "bval (Not a) s = (\<not> bval a s)" |
  "bval (And a b) s = (bval a s \<and> bval b s)" |
  "bval (Less a b) s = (aval a s < aval b s)"

fun not :: "bexp \<Rightarrow> bexp" where
  "not (Bc True) = Bc False" |
  "not (Bc False) = Bc True" |
  "not a = Not a"

fun "and" :: "bexp \<Rightarrow> bexp \<Rightarrow> bexp" where
  "and (Bc True) b = b" |
  "and a (Bc True) = a" |
  "and (Bc False) b = Bc False" |
  "and a (Bc False) = Bc False" |
  "and a b = And a b"

fun less :: "aexp \<Rightarrow> aexp \<Rightarrow> bexp" where
  "less (N a) (N b) = Bc (a < b)" |
  "less a b = Less a b"

fun bsimp :: "bexp \<Rightarrow> bexp" where
  "bsimp (Bc v) = Bc v" |
  "bsimp (Not b) = not (bsimp b)" |
  "bsimp (And a b) = and (bsimp a) (bsimp b)" |
  "bsimp (Less a b) = less (asimp a) (asimp b)"

(* Ex. 3.7 *)
fun Eq :: "aexp \<Rightarrow> aexp \<Rightarrow> bexp" where
  "Eq a b = And (Not (Less a b)) (Not (Less b a))"
value "bval (Eq (N 4) (Plus (N 1) (N 3))) (\<lambda>x. 0)"

fun Le :: "aexp \<Rightarrow> aexp \<Rightarrow> bexp" where
  "Le a b = Not (Less b a)"

lemma "bval (Eq a b) s = (aval a s = aval b s)"
  apply (induction a)
  apply auto
  done

lemma "bval (Le a b) s = (aval a s \<le> aval b s)"
  apply (induction a)
  apply auto
  done

(* Ex. 3.8 *)
datatype ifexp = Bc2 bool | If ifexp ifexp ifexp | Less2 aexp aexp

fun ifval :: "ifexp \<Rightarrow> state \<Rightarrow> bool" where
  "ifval (Bc2 v) s = v" |
  "ifval (If a b c) s = (if (ifval a s) then (ifval b s) else (ifval c s))" |
  "ifval (Less2 a b) s = (aval a s < aval b s)"

fun b2ifexp :: "bexp \<Rightarrow> ifexp" where
  "b2ifexp (Bc v) = Bc2 v" |
  "b2ifexp (Not b) = If (b2ifexp b) (Bc2 False) (Bc2 True)" |
  "b2ifexp (And a b) = If (b2ifexp a) (b2ifexp b) (Bc2 False)" |
  "b2ifexp (Less a b) = (Less2 a b)"

fun nand :: "bexp \<Rightarrow> bexp \<Rightarrow> bexp" where
  "nand a b = Not (And a b)"

fun or :: "bexp \<Rightarrow> bexp \<Rightarrow> bexp" where
  "or a b = nand (Not a) (Not b)"

fun mux :: "bexp \<Rightarrow> bexp \<Rightarrow> bexp \<Rightarrow> bexp" where
  "mux a b c = or (And a b) (And (Not a) c)"

fun if2bexp :: "ifexp \<Rightarrow> bexp" where
  "if2bexp (Bc2 v) = Bc v" |
  "if2bexp (Less2 a b) = Less a b" |
  "if2bexp (If a b c) = (mux (if2bexp a) (if2bexp b) (if2bexp c))"

lemma "ifval (b2ifexp a) s = bval a s"
  apply (induction a)
  apply auto
  done

lemma "bval (if2bexp a) s = ifval a s"
  apply (induction a)
  apply (auto)
  done

(* Ex. 3.9 *)
(* Purely boolean expression. *)
datatype pbexp = VAR vname | NOT pbexp | AND pbexp pbexp | OR pbexp pbexp

fun pbval :: "pbexp \<Rightarrow> (vname \<Rightarrow> bool) \<Rightarrow> bool" where
  "pbval (VAR x) s = s x" |
  "pbval (NOT a) s = (\<not>pbval a s)" |
  "pbval (AND l r) s = (pbval l s \<and> pbval r s)" |
  "pbval (OR l r) s = (pbval l s \<or> pbval r s)"

fun is_nnf :: "pbexp \<Rightarrow> bool" where
  "is_nnf (VAR x) = True" |
  "is_nnf (NOT (VAR x)) = True" |
  "is_nnf (NOT a) = False" |
  "is_nnf (AND l r) = (is_nnf l \<and> is_nnf r)" |
  "is_nnf (OR l r) = (is_nnf l \<and> is_nnf r)"

fun nnf :: "pbexp \<Rightarrow> pbexp" where
  "nnf (VAR x) = (VAR x)" |
  "nnf (NOT (VAR x)) = NOT (VAR x)" |
  "nnf (NOT (NOT a)) = nnf a" |
  "nnf (NOT (AND l r)) = OR (nnf (NOT l)) (nnf (NOT r))" |
  "nnf (NOT (OR l r)) = AND (nnf (NOT l)) (nnf (NOT r))" |
  "nnf (AND l r) = AND (nnf l) (nnf r)" |
  "nnf (OR l r) = OR (nnf l) (nnf r)"

lemma not_nnf [simp]: "pbval (nnf (NOT a)) s = (\<not>pbval (nnf a) s)"
  apply (induction a)
  apply auto
  done

lemma "pbval (nnf a) s = pbval a s"
  apply (induction a)
  apply auto
  done

lemma "is_nnf (nnf a)"
  apply (induction a rule:nnf.induct)
  apply auto
  done

fun dnf_and :: "pbexp \<Rightarrow> pbexp \<Rightarrow> pbexp" where
  "dnf_and l (OR l2 r2) = OR (dnf_and l l2) (dnf_and l r2)" |
  "dnf_and (OR l2 r2) r = OR (dnf_and l2 r) (dnf_and r2 r)" |
  "dnf_and l r = AND l r"

lemma pbval_dnf_and [simp]: "pbval (dnf_and l r) s = pbval (AND l r) s"
  apply (induction l r rule: dnf_and.induct)
  apply auto
  done

fun dnf_of_nnf :: "pbexp \<Rightarrow> pbexp" where
  "dnf_of_nnf (VAR x) = VAR x" |
  (* See NNF. *)
  "dnf_of_nnf (NOT a) = NOT a" |
  "dnf_of_nnf (OR l r) = OR (dnf_of_nnf l) (dnf_of_nnf r)" |
  "dnf_of_nnf (AND l r) = dnf_and (dnf_of_nnf l) (dnf_of_nnf r)"

lemma "pbval (dnf_of_nnf a) s = pbval a s"
  apply (induction a)
  apply auto
  done

fun is_dnf_sub :: "pbexp \<Rightarrow> bool" where
  "is_dnf_sub (VAR x) = True" |
  "is_dnf_sub (NOT a) = True" |
  "is_dnf_sub (AND l r) = (is_dnf_sub l \<and> is_dnf_sub r)" |
  "is_dnf_sub (OR l r) = False"

fun is_dnf :: "pbexp \<Rightarrow> bool" where
  "is_dnf (VAR x) = True" |
  (* See NNF. *)
  "is_dnf (NOT a) = True" |
  "is_dnf (AND l r) = (is_dnf_sub l \<and> is_dnf_sub r)" |
  "is_dnf (OR l r) = (is_dnf l \<and> is_dnf r)"

lemma is_dnf_and [simp]: "is_dnf l \<Longrightarrow> is_dnf r \<Longrightarrow> is_dnf (dnf_and l r)"
  apply (induction l r rule:dnf_and.induct)
  apply auto
  done

lemma "is_nnf a \<Longrightarrow> is_dnf (dnf_of_nnf a)"
  apply (induction a)
  apply (auto)
  done

(* 3.3 Stack machine and compilation *)
(* Stack-machine control expression. *)
datatype instr = LOADI val | LOAD vname | ADD

type_synonym stack = "val list"

(*
fun exec1 :: "instr \<Rightarrow> state \<Rightarrow> stack \<Rightarrow> stack" where
  "exec1 (LOADI n) _ stk = n # stk" |
  "exec1 (LOAD x) s stk = s(x) # stk" |
  "exec1 ADD _ (j # i # stk) = (i + j) # stk"

fun exec :: "instr list \<Rightarrow> state \<Rightarrow> stack \<Rightarrow> stack" where
  "exec [] _ stk = stk" |
  "exec (i # is) s stk = exec is s (exec1 i s stk)"
value "exec [LOADI 5, LOAD ''y'', ADD] ((\<lambda>x. 0) (''x'':=42, ''y'':=43)) [50]"

fun comp :: "aexp \<Rightarrow> instr list" where
  "comp (N n) = [LOADI n]" |
  "comp (V x) = [LOAD x]" |
  "comp (Plus l r) = comp l @ comp r @ [ADD]"

lemma exec_chain [simp]: "exec (l @ r) s stk = exec r s (exec l s stk)"
  apply (induction l arbitrary: stk)
  apply auto
  done

lemma "exec (comp a) s stk = aval a s # stk"
  apply (induction a arbitrary: stk)
  apply auto
  done
*)

(* Ex. 3.10 *)
fun exec1 :: "instr \<Rightarrow> state \<Rightarrow> stack \<Rightarrow> stack option" where
  "exec1 (LOADI n) _ stk = Some (n # stk)" |
  "exec1 (LOAD x) s stk = Some (s(x) # stk)" |
  "exec1 ADD _ (j # i # stk) = Some ((i + j) # stk)" |
  "exec1 ADD _ stk = None"

fun exec :: "instr list \<Rightarrow> state \<Rightarrow> stack \<Rightarrow> stack option" where
  "exec [] _ stk = Some stk" |
  "exec (i # is) s stk = (case (exec1 i s stk) of
    Some newStack \<Rightarrow> exec is s newStack |
    None \<Rightarrow> None)"

fun comp :: "aexp \<Rightarrow> instr list" where
  "comp (N n) = [LOADI n]" |
  "comp (V x) = [LOAD x]" |
  "comp (Plus l r) = comp l @ comp r @ [ADD]"

lemma exec_chain [simp]: "exec l s stk = Some newStack \<Longrightarrow> exec (l @ r) s stk = exec r s newStack"
  apply (induction l arbitrary: stk)
  apply (auto split: option.split)
  done

lemma "exec (comp a) s stk = Some (aval a s # stk)"
  apply (induction a arbitrary: stk)
  apply (auto)
  done

(* Ex. 3.11 *)
type_synonym reg = nat
type_synonym rstate = "reg \<Rightarrow> val"

(* Represents a register machine instructions. *)
datatype instrreg = LDI val reg | LD vname reg | ADDREG reg reg

fun exec1reg :: "instrreg \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
  "exec1reg (LDI n r) s rs = rs(r := n)" |
  "exec1reg (LD x r) s rs = rs(r := s(x))" |
  "exec1reg (ADDREG l r) s rs = rs(l := rs(l) + rs(r))"

fun execreg :: "instrreg list \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
  "execreg [] _ rs = rs" |
  "execreg (i # is) s rs = execreg is s (exec1reg i s rs)"

fun compreg :: "aexp \<Rightarrow> reg \<Rightarrow> instrreg list" where
  "compreg (N n) r = [LDI n r]" |
  "compreg (V x) r = [LD x r]" |
  "compreg (Plus l r) reg = (compreg l reg) @ (compreg r (reg + 1)) @ [ADDREG reg (reg + 1)]"

lemma execreg_chain [simp]: "execreg (l @ r) s rs = execreg r s (execreg l s rs)"
  apply (induction l arbitrary: rs)
  apply auto
  done

value "execreg (compreg (Plus (N 1) (N 2)) 4) (\<lambda>x. 0) (\<lambda>x. 0) 4"

lemma register_seq [simp]: "l < r \<Longrightarrow> execreg (compreg a r) s rs l = rs l"
  apply (induction a arbitrary: rs l r)
  apply auto
  done

lemma "execreg (compreg a r) s rs r = aval a s"
  apply (induction a arbitrary: rs r)
  apply auto
  done

(* Ex. 3.12 *)
(* Register machine with register-accumulator. *)
datatype instr0 = LDI0 val | LD0 vname | MV0 reg | ADD0 reg

fun exec10 :: "instr0 \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
  "exec10 (LDI0 n) s rs = rs(0 := n)" |
  "exec10 (LD0 v) s rs = rs(0 := s(v))" |
  "exec10 (MV0 r) s rs = rs(r := rs(0))" |
  "exec10 (ADD0 r) s rs = rs(0 := (rs 0 + rs r))"

fun exec0 :: "instr0 list \<Rightarrow> state \<Rightarrow> rstate \<Rightarrow> rstate" where
  "exec0 [] _ rs = rs" |
  "exec0 (i # is) s rs = exec0 is s (exec10 i s rs)"

fun comp0 :: "aexp \<Rightarrow> reg \<Rightarrow> instr0 list" where
  "comp0 (N n) r = [LDI0 n]" |
  "comp0 (V x) r = [LD0 x]" |
  "comp0 (Plus p q) r = (comp0 p (r+1)) @ [MV0 (r+1)] @ (comp0 q (r+2)) @ [ADD0 (r+1)]"

value "comp0 (Plus (Plus (N 1) (N 2)) ((N 3))) 1"

lemma exec0_chain [simp]: "exec0 (l @ r) s rs = exec0 r s (exec0 l s rs)"
  apply (induction l arbitrary: rs)
  apply auto
  done

value "exec0 (comp0 (N 0) 1) (\<lambda>x. -1) (\<lambda>r. 0) 0"

lemma exec0_seq [simp]: "0 < l \<Longrightarrow> l < r \<Longrightarrow> exec0 (comp0 a r) s rs l = rs l"
  apply (induction a arbitrary: rs l r)
  apply auto
  done

lemma "exec0 (comp0 a r) s rs 0 = aval a s"
  apply (induction a arbitrary: rs r)
  apply auto
  done

end


(*
  Define file name and import all the stuff from main isabelle

  NOTE: We will be working with natural numbers so we will use 'nat'
*)
theory MergeSort
  imports Main

begin

  (*
    In merge sort we have a function which splits a list into many sub lists and sorts them,
    we also have a function which merges 2 sub lists after they have been sorted.
  *)

  (*
    Function merge takes in two lists and puts them together
    If one of the list is empty we just return the non-empty list
    Other wise we go through each element of both list and compare the values and add them
    to the new list respectively.
  *)
  fun merge :: "nat list \<Rightarrow> nat list \<Rightarrow> nat list"
    where
      "merge [] ys = ys"
    | "merge xs [] = xs"
    | "merge (x # xs) (y # ys) = (
                                   if x \<le> y then
                                     x # merge xs (y # ys)
                                   else
                                     y # merge (x # xs) ys
                                 )"

  (*
    Function sort takes a list and returns a sorted list
    If the list is empty we return the an empty list.
    If the list has one element then it will return that one element in a list.
    Other wise we will get the mid of the list and recursively call sort and merge with the
    top half of the list and the bottom half of the list.
  *)
  fun sort :: "nat list \<Rightarrow> nat list"
    where
      "sort [] = []"
    | "sort [x] = [x]"
    | "sort xs = (
                   let mid = length xs div 2 in
                   merge (sort (take mid xs)) (sort (drop mid xs))
                 )"

  (*
    We will now define a few properties for sorting that need to be true.
  *)

  (*
    We define a property called 'less' which checks if the first element is
    less than all the elements in the list recursively
  *)
  primrec less :: "nat \<Rightarrow> nat list \<Rightarrow> bool"
    where
      "less value []     = True"
    | "less value (x#xs) = (value <= x & less value xs)"

  (*
    We define a property called 'sorted' which calls 'less' to check the value against every other
    value in the list. This ensures that our list is sorted. This is done recursively by calling
    sorted on every sublist.
  *)
  primrec sorted :: "nat list \<Rightarrow> bool"
    where
      "sorted []     = True"
    | "sorted (x#xs) = (less x xs & sorted xs)"

  (*
    We will now prove that our sort function is actually sorting our list.
    We will use our property called sorted which returns a boolean.
    We will start off by defining some of our base cases, we will apply simp to each of the lemma's
    so we can use them in our theorem.
  *)

  (*
    We need to insure that our x value is less than or equal to our y value
    We will use the built in induction tactic which we will apply to our list using auto.
  *)
  lemma compare_values [simp]: "x \<le> y \<Longrightarrow> less y xs \<longrightarrow> less x xs"
    apply (induct_tac xs)
    apply auto
  done

  (*
    We need to insure that the x value is less than all the values in the two lists separately and
    if they are merged.
    We will use the built in induction on both lists with induction on merge as well.
  *)
  lemma less_merge [simp]: "less x (merge xs ys) = (less x xs \<and> less x ys)"
    apply (induct xs ys rule: merge.induct)
    apply auto
  done

  (*
    We need to insure that the merged list is sorted and its equal to the two
    lists sorted separately.
    We will use the built in induction on both lists with induction on merge as well.
  *)
  lemma sorted_merge [simp]: "sorted (merge xs ys) = (sorted xs \<and> sorted ys)"
    apply(induct xs ys rule: merge.induct)
    apply (auto simp add: linorder_not_le order_less_le)
  done

  (*
    Using the bases cases (lemma's) we can now prove that our function sort actually sorts the list
    using our sorted property.
    We will use the built in induction tactic on the list and apply the induction rule on sort.
  *)
  theorem "sorted(sort xs)"
    apply (induct_tac xs rule: sort.induct)
    apply auto
  done

end


theory infinitePrimes
  imports Main "HOL-Number_Theory.Number_Theory"
begin

definition primeNat :: "nat => bool"
  where "primeNat p = (1 < p ∧ (∀m. m dvd p ⟶ m = 1 ∨ m = p))"

theorem infinite_primes: "~ finite {p::nat. primeNat p}"
proof cases
  assume finitePrimes: "finite {p::nat. p ≥ 2 ∧ primeNat p}"

  then have biggerThanPrimes:"∃ bigger. (ALL x: {(p::nat). primeNat p}. x <= bigger)"
    by (metis (no_types, lifting) Collect_cong primeNat_def prime_ge_2_nat prime_nat_iff primes_infinite)

  then obtain bigger :: nat where "ALL (x :: nat). primeNat x ⟶ x ≤ bigger"
    using finite_nat_set_iff_bounded_le primes_infinite by blast

  have False
    by (metis (no_types, lifting) Collect_cong finitePrimes primeNat_def prime_ge_2_nat prime_nat_iff primes_infinite)
  thus ?thesis by auto
next
  assume "¬finite {p::nat. p ≥ 2 ∧ primeNat p}"
  thus ?thesis by auto
qed

end


theory "Exercise-1"
  imports Main
begin

no_notation Nil("[]") and Cons (infixr "#" 65) and append (infixr "@" 65)
hide_type list
hide_const rev

datatype 'a list = Nil ("[]") | Cons 'a "'a list" (infixr "#" 65)

primrec app:: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"(infixr "@" 65)where
"[] @ ys = ys"|
"(x # xs) @ ys = x # (xs @ ys) "

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

lemma app_Nil[simp]:"xs @ [] = xs"
  apply(induct_tac xs)
  apply(auto)
  done
lemma app_assoc[simp]:"xs @ ys @ zs = (xs @ ys ) @ zs"
  apply(induct_tac xs)
  apply(auto)
  done
lemma rev_app [simp]:"rev(xs @ ys) =(rev ys) @( rev xs)"
  apply(induct_tac xs)
  apply(auto)
  done
theorem rev_rev[simp]: "rev(rev xs) = xs"
  apply(induct_tac xs)
  apply (auto)
  done

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

lemma add_02[simp]: "add a 0 = a"
  apply(induction a)
  apply (auto)
  done

primrec double::"nat\<Rightarrow>nat"where
"double 0 = 0"|
"double (Suc m) = Suc( Suc ( double m))"

theorem double_add:"double m = add m m"
  apply (induction m )
  apply auto
  done
primrec length::"'a list \<Rightarrow> nat"where
"length [] = 0"|
"length (x#xs) = Suc(length xs)"
primrec occurs :: "'a \<Rightarrow> 'a list \<Rightarrow> nat" where
"occurs a [] = 0"
| "occurs a (x#xs) = (if (x=a) then Suc (occurs a xs) else occurs a xs)"

lemma "occurs a xs <= length xs"
apply (induct xs)
apply auto
  done

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

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

primrec sum_upto::"nat\<Rightarrow>nat"where
"sum_upto 0 = 0"|
"sum_upto (Suc m) = Suc m + sum_upto m"

theorem "sum_upto n = n*(n+1) div 2"
  apply(induction n)
   apply auto
  done
end


(*
    $Id: sol.thy,v 1.3 2011/06/28 18:11:39 webertj Exp $
    Author: Farhad Mehta, Tobias Nipkow
*)

header {* Tree Traversal *}

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

text {* Define a datatype @{text"'a tree"} for binary trees. Both leaf and
internal nodes store information. *}

datatype 'a tree = Tip "'a" | Node "'a" "'a tree" "'a tree"

text {* Define the functions @{term preOrder}, @{term postOrder}, and @{term
inOrder} that traverse an @{text"'a tree"} in the respective order. *}

primrec preOrder :: "'a tree \<Rightarrow> 'a list" where
  "preOrder (Tip a)      = [a]"
| "preOrder (Node f x y) = f#((preOrder x)@(preOrder y))"

primrec postOrder :: "'a tree \<Rightarrow> 'a list" where
  "postOrder (Tip a)      = [a]"
| "postOrder (Node f x y) = (postOrder x)@(postOrder y)@[f]"

primrec inOrder :: "'a tree \<Rightarrow> 'a list" where
  "inOrder (Tip a)      = [a]"
| "inOrder (Node f x y) = (inOrder x)@[f]@(inOrder y)"

text {* Define a function @{term mirror} that returns the mirror image of an
@{text "'a tree"}. *}

primrec mirror :: "'a tree \<Rightarrow> 'a tree" where
  "mirror (Tip a)      = (Tip a)"
| "mirror (Node f x y) = (Node f (mirror y) (mirror x))"

text {* Suppose that @{term xOrder} and @{term yOrder} are tree traversal
functions chosen from @{term preOrder}, @{term postOrder}, and @{term inOrder}.
Formulate and prove all valid properties of the form \mbox{@{text "xOrder
(mirror xt) = rev (yOrder xt)"}}. *}

theorem  "preOrder (mirror xt) = rev (postOrder xt)"
  apply (induct_tac xt)
  apply auto
done

theorem "postOrder (mirror xt) = rev (preOrder xt)"
  apply (induct_tac xt)
  apply auto
done

theorem "inOrder (mirror xt) = rev (inOrder xt)"
  apply (induct_tac xt)
  apply auto
done

text {* Define the functions @{term root}, @{term leftmost} and @{term
rightmost}, that return the root, leftmost, and rightmost element respectively.
*}

primrec root :: "'a tree \<Rightarrow> 'a" where
  "root (Tip a)      = a"
| "root (Node f x y) = f"

primrec leftmost :: "'a tree \<Rightarrow> 'a" where
  "leftmost (Tip a)      = a"
| "leftmost (Node f x y) = (leftmost x)"

primrec rightmost :: "'a tree \<Rightarrow> 'a" where
  "rightmost (Tip a)      = a"
| "rightmost (Node f x y) = (rightmost y)"

text {* Prove or disprove (by counterexample) the theorems that follow.  You
may have to prove some lemmas first. *}

lemma [simp]: "ys ~= [] \<longrightarrow> last (xs @ ys) = last ys"
  apply (induct_tac xs)
  apply auto
done

theorem "last (inOrder xt) = rightmost xt"
  apply (induct_tac xt)
  apply auto
done

theorem "hd (inOrder xt) = leftmost xt"
  apply (induct_tac xt)
  apply auto
done

theorem "hd (preOrder xt) = last (postOrder xt)"
  apply (induct_tac xt)
  apply auto
done

theorem "hd (preOrder xt) = root xt"
  apply (induct_tac xt)
  apply auto
done

theorem "hd (inOrder xt) = root xt"
  quickcheck
oops

text {*
  Counterexample found: \\
  xt = Node 1 (Tip 0) (Tip 0)
*}

theorem "last (postOrder xt) = root xt"
  apply (induct_tac xt)
  apply auto
done

(*<*) end (*>*)


(*  Title:       Countable Ordinals

    Author:      Brian Huffman, 2005
    Maintainer:  Brian Huffman <brianh at cse.ogi.edu>
*)

header {* Omega *}

theory OrdinalOmega
imports OrdinalFix
begin

subsection {* Embedding naturals in the ordinals *}

primrec ordinal_of_nat :: "nat \<Rightarrow> ordinal"
where
  "ordinal_of_nat 0 = 0"
| "ordinal_of_nat (Suc n) = oSuc (ordinal_of_nat n)"

lemma strict_mono_ordinal_of_nat: "strict_mono ordinal_of_nat"
by (rule strict_mono_natI, simp)

lemma not_limit_ordinal_nat: "\<not> limit_ordinal (ordinal_of_nat n)"
by (induct n) simp_all

lemma ordinal_of_nat_eq [simp]:
"(ordinal_of_nat x = ordinal_of_nat y) = (x = y)"
by (rule strict_mono_cancel_eq[OF strict_mono_ordinal_of_nat])

lemma ordinal_of_nat_less [simp]:
"(ordinal_of_nat x < ordinal_of_nat y) = (x < y)"
by (rule strict_mono_cancel_less[OF strict_mono_ordinal_of_nat])

lemma ordinal_of_nat_le [simp]:
"(ordinal_of_nat x \<le> ordinal_of_nat y) = (x \<le> y)"
by (rule strict_mono_cancel_le[OF strict_mono_ordinal_of_nat])

lemma ordinal_of_nat_plus [simp]:
"ordinal_of_nat x + ordinal_of_nat y = ordinal_of_nat (x + y)"
by (induct y) simp_all

lemma ordinal_of_nat_times [simp]:
"ordinal_of_nat x * ordinal_of_nat y = ordinal_of_nat (x * y)"
by (induct y) (simp_all add: add.commute)

lemma ordinal_of_nat_exp [simp]:
"ordinal_of_nat x ** ordinal_of_nat y = ordinal_of_nat (x ^ y)"
by (induct y, cases x) (simp_all add: mult.commute)

lemma oSuc_plus_ordinal_of_nat:
"oSuc x + ordinal_of_nat n = oSuc (x + ordinal_of_nat n)"
by (induct n) simp_all

lemma less_ordinal_of_nat:
"(x < ordinal_of_nat n) = (\<exists>m. x = ordinal_of_nat m \<and> m < n)"
 apply (induct n)
  apply simp
 apply (safe, simp_all del: ordinal_of_nat.simps)
 apply (auto elim: less_oSucE)
done

lemma le_ordinal_of_nat:
"(x \<le> ordinal_of_nat n) = (\<exists>m. x = ordinal_of_nat m \<and> m \<le> n)"
by (auto simp add: order_le_less less_ordinal_of_nat)

subsection {* Omega, the least limit ordinal *}

definition
  omega :: "ordinal"  ("\<omega>") where
  "omega = oLimit ordinal_of_nat"

lemma less_omegaD: "x < \<omega> \<Longrightarrow> \<exists>n. x = ordinal_of_nat n"
 apply (unfold omega_def)
 apply (drule less_oLimitD)
 apply (clarsimp simp add: less_ordinal_of_nat)
done

lemma omega_leI: "\<forall>n. ordinal_of_nat n \<le> x \<Longrightarrow> \<omega> \<le> x"
by (unfold omega_def, erule oLimit_leI)

lemma nat_le_omega [simp]: "ordinal_of_nat n \<le> \<omega>"
by (unfold omega_def, rule le_oLimit)

lemma nat_less_omega [simp]: "ordinal_of_nat n < \<omega>"
 apply (rule_tac y="ordinal_of_nat (Suc n)" in order_less_le_trans, simp)
 apply (rule nat_le_omega)
done

lemma zero_less_omega [simp]: "0 < \<omega>"
by (cut_tac n=0 in nat_less_omega, simp)

lemma limit_ordinal_omega: "limit_ordinal \<omega>"
 apply (rule limit_ordinalI[rule_format], simp)
 apply (drule less_omegaD, clarify)
 apply (subgoal_tac "ordinal_of_nat (Suc n) < \<omega>", simp)
 apply (simp only: nat_less_omega)
done

lemma Least_limit_ordinal: "(LEAST x. limit_ordinal x) = \<omega>"
 apply (rule Least_equality)
  apply (rule limit_ordinal_omega)
 apply (erule contrapos_pp)
 apply (simp add: linorder_not_le)
 apply (drule less_omegaD, erule exE)
 apply (simp add: not_limit_ordinal_nat)
done

lemma "range f = range ordinal_of_nat \<Longrightarrow> oLimit f = \<omega>"
 apply (rule order_antisym)
  apply (rule oLimit_leI, clarify)
  apply (drule equalityD1)
  apply (drule_tac c="f n" in subsetD, simp)
  apply clarsimp
 apply (rule omega_leI, clarify)
 apply (drule equalityD2)
 apply (drule_tac c="ordinal_of_nat n" in subsetD, simp)
 apply clarsimp
done

subsection {* Arithmetic properties of @{term \<omega>} *}

lemma oSuc_less_omega [simp]: "(oSuc x < \<omega>) = (x < \<omega>)"
by (rule oSuc_less_limit_ordinal[OF limit_ordinal_omega])

lemma oSuc_plus_omega [simp]: "oSuc x + \<omega> = x + \<omega>"
 apply (simp add: omega_def)
 apply (rule oLimit_eqI)
  apply (rule_tac x="Suc n" in exI)
  apply (simp add: oSuc_plus_ordinal_of_nat)
 apply (rule_tac x=n in exI)
 apply (simp add: oSuc_plus_ordinal_of_nat order_less_imp_le)
done

lemma ordinal_of_nat_plus_omega [simp]:
"ordinal_of_nat n + \<omega> = \<omega>"
by (induct n) simp_all

lemma ordinal_of_nat_times_omega [simp]:
"0 < k \<Longrightarrow> ordinal_of_nat k * \<omega> = \<omega>"
 apply (simp add: omega_def)
 apply (rule oLimit_eqI)
  apply (rule_tac exI, rule order_refl)
 apply (rule_tac x=n in exI, simp)
done

lemma ordinal_plus_times_omega: "x + x * \<omega> = x * \<omega>"
 apply (subgoal_tac "x + x * \<omega> = x * (1 + \<omega>)", simp)
 apply (simp del: oSuc_plus_omega add: ordinal_times_distrib)
done

lemma ordinal_plus_absorb: "x * \<omega> \<le> y \<Longrightarrow> x + y = y"
 apply (drule ordinal_plus_minus2)
 apply (erule subst)
 apply (simp only: ordinal_plus_assoc[symmetric] ordinal_plus_times_omega)
done

lemma ordinal_less_plusL: "y < x * \<omega> \<Longrightarrow> y < x + y"
 apply (case_tac "x = 0", simp_all)
 apply (drule ordinal_div_less)
 apply (drule less_omegaD, clarify)
 apply (rule_tac y="x * (1 + ordinal_of_nat n)" in order_less_le_trans)
  apply (simp add: oSuc_plus_ordinal_of_nat)
  apply (erule subst)
  apply (erule ordinal_less_times_div_plus)
 apply (simp add: ordinal_times_distrib)
 apply (erule subst)
 apply (rule ordinal_times_div_le)
done

lemma ordinal_plus_absorb_iff: "(x + y = y) = (x * \<omega> \<le> y)"
 apply safe
  apply (rule ccontr, simp add: linorder_not_le)
  apply (drule ordinal_less_plusL, simp)
 apply (erule ordinal_plus_absorb)
done

lemma ordinal_less_plusL_iff: "(y < x + y) = (y < x * \<omega>)"
 apply safe
  apply (rule ccontr, simp add: linorder_not_less)
  apply (drule ordinal_plus_absorb, simp)
 apply (erule ordinal_less_plusL)
done

subsection {* Additive principal ordinals *}

locale additive_principal =
  fixes a :: ordinal
  assumes not_0:  "0 < a"
  assumes sum_eq: "\<And>b. b < a \<Longrightarrow> b + a = a"

lemma (in additive_principal) sum_less:
"\<lbrakk>x < a; y < a\<rbrakk> \<Longrightarrow> x + y < a"
by (drule sum_eq, erule subst, simp)

lemma (in additive_principal) times_nat_less:
"x < a \<Longrightarrow> x * ordinal_of_nat n < a"
 apply (induct_tac n)
  apply (simp add: not_0)
 apply (simp add: sum_less)
done

lemma not_additive_principal_0: "\<not> additive_principal 0"
by (clarify, drule additive_principal.not_0, simp)

lemma additive_principal_oSuc:
"additive_principal (oSuc a) = (a = 0)"
 apply safe
  apply (rule ccontr, simp)
  apply (subgoal_tac "a + oSuc 0 < oSuc a", simp)
  apply (erule additive_principal.sum_less, simp_all)
 apply (simp add: additive_principal_def)
done

lemma additive_principal_intro2 [rule_format]:
assumes not_0: "0 < a"
shows "(\<forall>x<a. \<forall>y<a. x + y < a) \<longrightarrow> additive_principal a"
 apply (simp add: additive_principal_def not_0)
 apply (rule_tac a=a in oLimit_induct)
   apply simp
  apply clarsimp
  apply (drule_tac x=x in spec, simp)
  apply (drule_tac x=1 in spec, simp)
  apply (simp add: linorder_not_less)
 apply clarsimp
 apply (rule order_antisym)
  apply (rule oLimit_leI, clarify)
  apply (rule order_less_imp_le)
  apply (simp add: strict_mono_less_oLimit)
 apply (rule oLimit_leI, clarify)
 apply (rule_tac n=n in le_oLimitI)
 apply (rule ordinal_le_plusL)
done

lemma additive_principal_1: "additive_principal (oSuc 0)"
by (simp add: additive_principal_def)

lemma additive_principal_omega: "additive_principal \<omega>"
 apply (rule additive_principal.intro)
  apply (rule zero_less_omega)
 apply (drule less_omegaD, clarify)
 apply (rule ordinal_of_nat_plus_omega)
done

lemma additive_principal_times_omega:
"0 < x \<Longrightarrow> additive_principal (x * \<omega>)"
 apply (rule additive_principal.intro)
  apply simp
 apply (simp add: omega_def)
 apply (drule less_oLimitD, clarify, rename_tac k)
 apply (drule_tac x=b in order_less_imp_le)
 apply (rule oLimit_eqI)
  apply (rule_tac x="k + n" in exI)
  apply (erule order_trans[OF ordinal_plus_monoL])
  apply (simp add: ordinal_times_distrib[symmetric])
 apply (rule_tac x=n in exI, simp)
done

lemma additive_principal_oLimit:
"\<forall>n. additive_principal (f n) \<Longrightarrow> additive_principal (oLimit f)"
 apply (rule additive_principal.intro)
  apply (rule_tac n=0 in less_oLimitI)
  apply (simp add: additive_principal.not_0)
 apply simp
 apply (drule less_oLimitD, clarify, rename_tac k)
 apply (rule oLimit_eqI)
  apply (rule_tac x="f n" and y = "f k" in linorder_le_cases)
   apply (rule_tac x=k in exI)
   apply (rule_tac y="b + f k" in order_trans, simp)
   apply (simp add: additive_principal.sum_eq)
  apply (rule_tac x=n in exI)
  apply (drule order_less_le_trans, assumption)
  apply (simp add: additive_principal.sum_eq)
 apply (rule_tac x=n in exI, simp)
done

lemma additive_principal_omega_exp: "additive_principal (\<omega> ** x)"
 apply (rule_tac a=x in oLimit_induct)
   apply (simp add: additive_principal_1)
  apply (simp add: additive_principal_times_omega)
 apply (simp add: additive_principal_oLimit)
done

lemma (in additive_principal) omega_exp: "\<exists>x. a = \<omega> ** x"
 apply (subgoal_tac "\<exists>x. \<omega> ** x \<le> a \<and> a < \<omega> ** (oSuc x)")
  prefer 2
  apply (rule normal.oInv_ex)
   apply (rule normal_exp, simp)
  apply (simp add: oSuc_le_eq_less not_0)
 apply (auto simp add: order_le_less)
 apply (subgoal_tac "a < a", simp)
 apply (rule order_less_trans)
  apply (rule_tac y="\<omega> ** x" in ordinal_less_times_div_plus)
  apply simp
 apply (drule ordinal_div_less)
 apply (drule less_omegaD, clarify)
 apply (drule_tac n="Suc n" in times_nat_less)
 apply simp
done

lemma additive_principal_iff:
"additive_principal a = (\<exists>x. a = \<omega> ** x)"
by (auto intro: additive_principal_omega_exp
                additive_principal.omega_exp)

lemma absorb_omega_exp:
"x < \<omega> ** a \<Longrightarrow> x + \<omega> ** a = \<omega> ** a"
by (rule additive_principal.sum_eq[OF additive_principal_omega_exp])

lemma absorb_omega_exp2: "a < b \<Longrightarrow> \<omega> ** a + \<omega> ** b = \<omega> ** b"
by (rule absorb_omega_exp, simp add: ordinal_exp_strict_monoR)

subsection {* Cantor normal form *}

lemma cnf_lemma: "x > 0 \<Longrightarrow> x - \<omega> ** oLog \<omega> x < x"
  apply (subst ordinal_minus_less_eq)
   apply (erule ordinal_exp_oLog_le, simp)
  apply (rule ordinal_less_plusL)
  apply (rule ordinal_less_exp_oLog, simp)
  done

primrec from_cnf where
  "from_cnf []       = 0"
  | "from_cnf (x # xs) = \<omega> ** x + from_cnf xs"

function to_cnf where
 [simp del]: "to_cnf x = (if x = 0 then [] else
    oLog \<omega> x # to_cnf (x - \<omega> ** oLog \<omega> x))"
by pat_completeness auto

termination by (relation "{(x, y). x < y}")
  (simp_all add: wf cnf_lemma)

lemma to_cnf_0 [simp]: "to_cnf 0 = []"
by (simp add: to_cnf.simps)

lemma to_cnf_not_0:
"0 < x \<Longrightarrow> to_cnf x = oLog \<omega> x # to_cnf (x - \<omega> ** oLog \<omega> x)"
by (simp add: to_cnf.simps[of x])

lemma to_cnf_eq_Cons: "to_cnf x = a # list \<Longrightarrow> a = oLog \<omega> x"
by (case_tac "x = 0", simp, simp add: to_cnf_not_0)

lemma to_cnf_inverse: "from_cnf (to_cnf x) = x"
 apply (rule wf_induct[OF wf], simp)
 apply (case_tac "x = 0", simp_all)
 apply (simp add: to_cnf_not_0)
 apply (simp add: cnf_lemma)
 apply (rule ordinal_plus_minus2)
 apply (erule ordinal_exp_oLog_le, simp)
done

primrec normalize_cnf where
  normalize_cnf_Nil: "normalize_cnf [] = []"
  | normalize_cnf_Cons: "normalize_cnf (x # xs) =
      (case xs of [] \<Rightarrow> [x] | y # ys \<Rightarrow>
        (if x < y then [] else [x]) @ normalize_cnf xs)"

lemma from_cnf_normalize_cnf: "from_cnf (normalize_cnf xs) = from_cnf xs"
 apply (induct_tac xs, simp_all)
 apply (case_tac list, simp, clarsimp simp del: normalize_cnf_Cons)
 apply (simp add: ordinal_plus_assoc[symmetric] absorb_omega_exp2)
done

lemma normalize_cnf_to_cnf: "normalize_cnf (to_cnf x) = to_cnf x"
 apply (rule_tac a=x in wf_induct[OF wf], simp)
 apply (case_tac "x = 0", simp_all)
 apply (drule spec, drule mp, erule cnf_lemma)
 apply (simp add: to_cnf_not_0)
 apply (case_tac "to_cnf (x - \<omega> ** oLog \<omega> x)", simp_all)
 apply (drule to_cnf_eq_Cons, simp add: linorder_not_less)
 apply (rule ordinal_oLog_monoR)
 apply (rule order_less_imp_le)
 apply (erule cnf_lemma)
done

text "alternate form of CNF"

lemma cnf2_lemma:
"0 < x \<Longrightarrow> x mod \<omega> ** oLog \<omega> x < x"
 apply (rule order_less_le_trans)
  apply (rule ordinal_mod_less, simp)
 apply (erule ordinal_exp_oLog_le, simp)
done

primrec from_cnf2 where
  "from_cnf2 []       = 0"
  | "from_cnf2 (x # xs) = \<omega> ** fst x * ordinal_of_nat (snd x) + from_cnf2 xs"

function to_cnf2 where
  [simp del]: "to_cnf2 x = (if x = 0 then [] else
    (oLog \<omega> x, inv ordinal_of_nat (x div (\<omega> ** oLog \<omega> x)))
      # to_cnf2 (x mod (\<omega> ** oLog \<omega> x)))"
by pat_completeness auto

termination by (relation "{(x,y). x < y}")
  (simp_all add: wf cnf2_lemma)

lemma to_cnf2_0 [simp]: "to_cnf2 0 = []"
by (simp add: to_cnf2.simps)

lemma to_cnf2_not_0:
"0 < x \<Longrightarrow> to_cnf2 x =
  (oLog \<omega> x, inv ordinal_of_nat (x div (\<omega> ** oLog \<omega> x)))
     # to_cnf2 (x mod (\<omega> ** oLog \<omega> x))"
by (simp add: to_cnf2.simps[of x])

lemma to_cnf2_eq_Cons: "to_cnf2 x = (a,b) # list \<Longrightarrow> a = oLog \<omega> x"
by (case_tac "x = 0", simp, simp add: to_cnf2_not_0)

lemma ordinal_of_nat_of_ordinal:
"x < \<omega> \<Longrightarrow> ordinal_of_nat (inv ordinal_of_nat x) = x"
 apply (rule f_inv_into_f)
 apply (simp add: image_def)
 apply (erule less_omegaD)
done

lemma to_cnf2_inverse: "from_cnf2 (to_cnf2 x) = x"
 apply (rule wf_induct[OF wf], simp)
 apply (case_tac "x = 0", simp_all)
 apply (simp add: to_cnf2_not_0)
 apply (simp add: cnf2_lemma)
 apply (drule_tac x="x mod \<omega> ** oLog \<omega> x" in spec)
 apply (simp add: cnf2_lemma)
 apply (subst ordinal_of_nat_of_ordinal)
  apply (rule ordinal_div_less)
  apply (rule ordinal_less_exp_oLog, simp)
 apply (rule ordinal_div_plus_mod)
done

primrec is_normalized2 where
  is_normalized2_Nil: "is_normalized2 [] = True"
  | is_normalized2_Cons: "is_normalized2 (x # xs) =
      (case xs of [] \<Rightarrow> True | y # ys \<Rightarrow> fst y < fst x \<and> is_normalized2 xs)"

lemma is_normalized2_to_cnf2: "is_normalized2 (to_cnf2 x)"
 apply (rule_tac a=x in wf_induct[OF wf], simp)
 apply (case_tac "x = 0", simp_all)
 apply (drule spec, drule mp, erule cnf2_lemma)
 apply (simp add: to_cnf2_not_0)
 apply (case_tac "x mod \<omega> ** oLog \<omega> x = 0", simp_all)
 apply (case_tac "to_cnf2 (x mod \<omega> ** oLog \<omega> x)", simp_all)
 apply (case_tac a, simp)
 apply (drule to_cnf2_eq_Cons, simp)
 apply (erule ordinal_oLog_less, simp)
 apply (rule ordinal_mod_less, simp)
done

subsection {* Epsilon 0 *}

definition epsilon0 :: ordinal  ("\<epsilon>\<^sub>0") where
  "epsilon0 = oFix (op ** \<omega>) 0"

lemma less_omega_exp: "x < \<epsilon>\<^sub>0 \<Longrightarrow> x < \<omega> ** x"
 apply (unfold epsilon0_def)
 apply (erule less_oFix_0D)
 apply (rule continuous.mono)
 apply (rule continuous_exp)
 apply (rule zero_less_omega)
done

lemma omega_exp_epsilon0: "\<omega> ** \<epsilon>\<^sub>0 = \<epsilon>\<^sub>0"
 apply (unfold epsilon0_def)
 apply (rule oFix_fixed)
  apply (rule continuous_exp)
  apply (rule zero_less_omega)
 apply simp
done

lemma oLog_omega_less: "\<lbrakk>0 < x; x < \<epsilon>\<^sub>0\<rbrakk> \<Longrightarrow> oLog \<omega> x < x"
 apply (erule ordinal_oLog_less)
  apply simp
 apply (erule less_omega_exp)
done

end


(* Author: Florian Haftmann, TU Muenchen *)

section \<open>Comparing growth of functions on natural numbers by a preorder relation\<close>

theory Function_Growth
imports
  Main
  "HOL-Library.Preorder"
  "HOL-Library.Discrete"
begin

subsection \<open>Motivation\<close>

text \<open>
  When comparing growth of functions in computer science, it is common to adhere
  on Landau Symbols (``O-Notation'').  However these come at the cost of notational
  oddities, particularly writing \<open>f = O(g)\<close> for \<open>f \<in> O(g)\<close> etc.

  Here we suggest a different way, following Hardy (G.~H.~Hardy and J.~E.~Littlewood,
  Some problems of Diophantine approximation, Acta Mathematica 37 (1914), p.~225).
  We establish a quasi order relation \<open>\<lesssim>\<close> on functions such that
  \<open>f \<lesssim> g \<longleftrightarrow> f \<in> O(g)\<close>.  From a didactic point of view, this does not only
  avoid the notational oddities mentioned above but also emphasizes the key insight
  of a growth hierarchy of functions:
  \<open>(\<lambda>n. 0) \<lesssim> (\<lambda>n. k) \<lesssim> Discrete.log \<lesssim> Discrete.sqrt \<lesssim> id \<lesssim> \<dots>\<close>.
\<close>

subsection \<open>Model\<close>

text \<open>
  Our growth functions are of type \<open>\<nat> \<Rightarrow> \<nat>\<close>.  This is different
  to the usual conventions for Landau symbols for which \<open>\<real> \<Rightarrow> \<real>\<close>
  would be appropriate, but we argue that \<open>\<real> \<Rightarrow> \<real>\<close> is more
  appropriate for analysis, whereas our setting is discrete.

  Note that we also restrict the additional coefficients to \<open>\<nat>\<close>, something
  we discuss at the particular definitions.
\<close>

subsection \<open>The \<open>\<lesssim>\<close> relation\<close>

definition less_eq_fun :: "(nat \<Rightarrow> nat) \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> bool" (infix "\<lesssim>" 50)
where
  "f \<lesssim> g \<longleftrightarrow> (\<exists>c>0. \<exists>n. \<forall>m>n. f m \<le> c * g m)"

text \<open>
  This yields \<open>f \<lesssim> g \<longleftrightarrow> f \<in> O(g)\<close>.  Note that \<open>c\<close> is restricted to
  \<open>\<nat>\<close>.  This does not pose any problems since if \<open>f \<in> O(g)\<close> holds for
  a \<open>c \<in> \<real>\<close>, it also holds for \<open>\<lceil>c\<rceil> \<in> \<nat>\<close> by transitivity.
\<close>

lemma less_eq_funI [intro?]:
  assumes "\<exists>c>0. \<exists>n. \<forall>m>n. f m \<le> c * g m"
  shows "f \<lesssim> g"
  unfolding less_eq_fun_def by (rule assms)

lemma not_less_eq_funI:
  assumes "\<And>c n. c > 0 \<Longrightarrow> \<exists>m>n. c * g m < f m"
  shows "\<not> f \<lesssim> g"
  using assms unfolding less_eq_fun_def linorder_not_le [symmetric] by blast

lemma less_eq_funE [elim?]:
  assumes "f \<lesssim> g"
  obtains n c where "c > 0" and "\<And>m. m > n \<Longrightarrow> f m \<le> c * g m"
  using assms unfolding less_eq_fun_def by blast

lemma not_less_eq_funE:
  assumes "\<not> f \<lesssim> g" and "c > 0"
  obtains m where "m > n" and "c * g m < f m"
  using assms unfolding less_eq_fun_def linorder_not_le [symmetric] by blast

subsection \<open>The \<open>\<approx>\<close> relation, the equivalence relation induced by \<open>\<lesssim>\<close>\<close>

definition equiv_fun :: "(nat \<Rightarrow> nat) \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> bool" (infix "\<cong>" 50)
where
  "f \<cong> g \<longleftrightarrow>
    (\<exists>c\<^sub>1>0. \<exists>c\<^sub>2>0. \<exists>n. \<forall>m>n. f m \<le> c\<^sub>1 * g m \<and> g m \<le> c\<^sub>2 * f m)"

text \<open>
  This yields \<open>f \<cong> g \<longleftrightarrow> f \<in> \<Theta>(g)\<close>.  Concerning \<open>c\<^sub>1\<close> and \<open>c\<^sub>2\<close>
  restricted to \<^typ>\<open>nat\<close>, see note above on \<open>(\<lesssim>)\<close>.
\<close>

lemma equiv_funI:
  assumes "\<exists>c\<^sub>1>0. \<exists>c\<^sub>2>0. \<exists>n. \<forall>m>n. f m \<le> c\<^sub>1 * g m \<and> g m \<le> c\<^sub>2 * f m"
  shows "f \<cong> g"
  unfolding equiv_fun_def by (rule assms)

lemma not_equiv_funI:
  assumes "\<And>c\<^sub>1 c\<^sub>2 n. c\<^sub>1 > 0 \<Longrightarrow> c\<^sub>2 > 0 \<Longrightarrow>
    \<exists>m>n. c\<^sub>1 * f m < g m \<or> c\<^sub>2 * g m < f m"
  shows "\<not> f \<cong> g"
  using assms unfolding equiv_fun_def linorder_not_le [symmetric] by blast

lemma equiv_funE:
  assumes "f \<cong> g"
  obtains n c\<^sub>1 c\<^sub>2 where "c\<^sub>1 > 0" and "c\<^sub>2 > 0"
    and "\<And>m. m > n \<Longrightarrow> f m \<le> c\<^sub>1 * g m \<and> g m \<le> c\<^sub>2 * f m"
  using assms unfolding equiv_fun_def by blast

lemma not_equiv_funE:
  fixes n c\<^sub>1 c\<^sub>2
  assumes "\<not> f \<cong> g" and "c\<^sub>1 > 0" and "c\<^sub>2 > 0"
  obtains m where "m > n"
    and "c\<^sub>1 * f m < g m \<or> c\<^sub>2 * g m < f m"
  using assms unfolding equiv_fun_def linorder_not_le [symmetric] by blast

subsection \<open>The \<open>\<prec>\<close> relation, the strict part of \<open>\<lesssim>\<close>\<close>

definition less_fun :: "(nat \<Rightarrow> nat) \<Rightarrow> (nat \<Rightarrow> nat) \<Rightarrow> bool" (infix "\<prec>" 50)
where
  "f \<prec> g \<longleftrightarrow> f \<lesssim> g \<and> \<not> g \<lesssim> f"

lemma less_funI:
  assumes "\<exists>c>0. \<exists>n. \<forall>m>n. f m \<le> c * g m"
    and "\<And>c n. c > 0 \<Longrightarrow> \<exists>m>n. c * f m < g m"
  shows "f \<prec> g"
  using assms unfolding less_fun_def less_eq_fun_def linorder_not_less [symmetric] by blast

lemma not_less_funI:
  assumes "\<And>c n. c > 0 \<Longrightarrow> \<exists>m>n. c * g m < f m"
    and "\<exists>c>0. \<exists>n. \<forall>m>n. g m \<le> c * f m"
  shows "\<not> f \<prec> g"
  using assms unfolding less_fun_def less_eq_fun_def linorder_not_less [symmetric] by blast

lemma less_funE [elim?]:
  assumes "f \<prec> g"
  obtains n c where "c > 0" and "\<And>m. m > n \<Longrightarrow> f m \<le> c * g m"
    and "\<And>c n. c > 0 \<Longrightarrow> \<exists>m>n. c * f m < g m"
proof -
  from assms have "f \<lesssim> g" and "\<not> g \<lesssim> f" by (simp_all add: less_fun_def)
  from \<open>f \<lesssim> g\<close> obtain n c where *:"c > 0" "m > n \<Longrightarrow> f m \<le> c * g m" for m
    by (rule less_eq_funE) blast
  { fix c n :: nat
    assume "c > 0"
    with \<open>\<not> g \<lesssim> f\<close> obtain m where "m > n" "c * f m < g m"
      by (rule not_less_eq_funE) blast
    then have **: "\<exists>m>n. c * f m < g m" by blast
  } note ** = this
  from * ** show thesis by (rule that)
qed

lemma not_less_funE:
  assumes "\<not> f \<prec> g" and "c > 0"
  obtains m where "m > n" and "c * g m < f m"
    | d q where "\<And>m. d > 0 \<Longrightarrow> m > q \<Longrightarrow> g q \<le> d * f q"
  using assms unfolding less_fun_def linorder_not_less [symmetric] by blast

text \<open>
  I did not find a proof for \<open>f \<prec> g \<longleftrightarrow> f \<in> o(g)\<close>.  Maybe this only
  holds if \<open>f\<close> and/or \<open>g\<close> are of a certain class of functions.
  However \<open>f \<in> o(g) \<longrightarrow> f \<prec> g\<close> is provable, and this yields a
  handy introduction rule.

  Note that D. Knuth ignores \<open>o\<close> altogether.  So what \dots

  Something still has to be said about the coefficient \<open>c\<close> in
  the definition of \<open>(\<prec>)\<close>.  In the typical definition of \<open>o\<close>,
  it occurs on the \emph{right} hand side of the \<open>(>)\<close>.  The reason
  is that the situation is dual to the definition of \<open>O\<close>: the definition
  works since \<open>c\<close> may become arbitrary small.  Since this is not possible
  within \<^term>\<open>\<nat>\<close>, we push the coefficient to the left hand side instead such
  that it may become arbitrary big instead.
\<close>

lemma less_fun_strongI:
  assumes "\<And>c. c > 0 \<Longrightarrow> \<exists>n. \<forall>m>n. c * f m < g m"
  shows "f \<prec> g"
proof (rule less_funI)
  have "1 > (0::nat)" by simp
  with assms [OF this] obtain n where *: "m > n \<Longrightarrow> 1 * f m < g m" for m
    by blast
  have "\<forall>m>n. f m \<le> 1 * g m"
  proof (rule allI, rule impI)
    fix m
    assume "m > n"
    with * have "1 * f m < g m" by simp
    then show "f m \<le> 1 * g m" by simp
  qed
  with \<open>1 > 0\<close> show "\<exists>c>0. \<exists>n. \<forall>m>n. f m \<le> c * g m" by blast
  fix c n :: nat
  assume "c > 0"
  with assms obtain q where "m > q \<Longrightarrow> c * f m < g m" for m by blast
  then have "c * f (Suc (q + n)) < g (Suc (q + n))" by simp
  moreover have "Suc (q + n) > n" by simp
  ultimately show "\<exists>m>n. c * f m < g m" by blast
qed

subsection \<open>\<open>\<lesssim>\<close> is a preorder\<close>

text \<open>This yields all lemmas relating \<open>\<lesssim>\<close>, \<open>\<prec>\<close> and \<open>\<cong>\<close>.\<close>

interpretation fun_order: preorder_equiv less_eq_fun less_fun
  rewrites "fun_order.equiv = equiv_fun"
proof -
  interpret preorder: preorder_equiv less_eq_fun less_fun
  proof
    fix f g h
    show "f \<lesssim> f"
    proof
      have "\<exists>n. \<forall>m>n. f m \<le> 1 * f m" by auto
      then show "\<exists>c>0. \<exists>n. \<forall>m>n. f m \<le> c * f m" by blast
    qed
    show "f \<prec> g \<longleftrightarrow> f \<lesssim> g \<and> \<not> g \<lesssim> f"
      by (fact less_fun_def)
    assume "f \<lesssim> g" and "g \<lesssim> h"
    show "f \<lesssim> h"
    proof
      from \<open>f \<lesssim> g\<close> obtain n\<^sub>1 c\<^sub>1
        where "c\<^sub>1 > 0" and P\<^sub>1: "\<And>m. m > n\<^sub>1 \<Longrightarrow> f m \<le> c\<^sub>1 * g m"
        by rule blast
      from \<open>g \<lesssim> h\<close> obtain n\<^sub>2 c\<^sub>2
        where "c\<^sub>2 > 0" and P\<^sub>2: "\<And>m. m > n\<^sub>2 \<Longrightarrow> g m \<le> c\<^sub>2 * h m"
        by rule blast
      have "\<forall>m>max n\<^sub>1 n\<^sub>2. f m \<le> (c\<^sub>1 * c\<^sub>2) * h m"
      proof (rule allI, rule impI)
        fix m
        assume Q: "m > max n\<^sub>1 n\<^sub>2"
        from P\<^sub>1 Q have *: "f m \<le> c\<^sub>1 * g m" by simp
        from P\<^sub>2 Q have "g m \<le> c\<^sub>2 * h m" by simp
        with \<open>c\<^sub>1 > 0\<close> have "c\<^sub>1 * g m \<le> (c\<^sub>1 * c\<^sub>2) * h m" by simp
        with * show "f m \<le> (c\<^sub>1 * c\<^sub>2) * h m" by (rule order_trans)
      qed
      then have "\<exists>n. \<forall>m>n. f m \<le> (c\<^sub>1 * c\<^sub>2) * h m" by rule
      moreover from \<open>c\<^sub>1 > 0\<close> \<open>c\<^sub>2 > 0\<close> have "c\<^sub>1 * c\<^sub>2 > 0" by simp
      ultimately show "\<exists>c>0. \<exists>n. \<forall>m>n. f m \<le> c * h m" by blast
    qed
  qed
  from preorder.preorder_equiv_axioms show "class.preorder_equiv less_eq_fun less_fun" .
  show "preorder_equiv.equiv less_eq_fun = equiv_fun"
  proof (rule ext, rule ext, unfold preorder.equiv_def)
    fix f g
    show "f \<lesssim> g \<and> g \<lesssim> f \<longleftrightarrow> f \<cong> g"
    proof
      assume "f \<cong> g"
      then obtain n c\<^sub>1 c\<^sub>2 where "c\<^sub>1 > 0" and "c\<^sub>2 > 0"
        and *: "\<And>m. m > n \<Longrightarrow> f m \<le> c\<^sub>1 * g m \<and> g m \<le> c\<^sub>2 * f m"
        by (rule equiv_funE) blast
      have "\<forall>m>n. f m \<le> c\<^sub>1 * g m"
      proof (rule allI, rule impI)
        fix m
        assume "m > n"
        with * show "f m \<le> c\<^sub>1 * g m" by simp
      qed
      with \<open>c\<^sub>1 > 0\<close> have "\<exists>c>0. \<exists>n. \<forall>m>n. f m \<le> c * g m" by blast
      then have "f \<lesssim> g" ..
      have "\<forall>m>n. g m \<le> c\<^sub>2 * f m"
      proof (rule allI, rule impI)
        fix m
        assume "m > n"
        with * show "g m \<le> c\<^sub>2 * f m" by simp
      qed
      with \<open>c\<^sub>2 > 0\<close> have "\<exists>c>0. \<exists>n. \<forall>m>n. g m \<le> c * f m" by blast
      then have "g \<lesssim> f" ..
      from \<open>f \<lesssim> g\<close> and \<open>g \<lesssim> f\<close> show "f \<lesssim> g \<and> g \<lesssim> f" ..
    next
      assume "f \<lesssim> g \<and> g \<lesssim> f"
      then have "f \<lesssim> g" and "g \<lesssim> f" by auto
      from \<open>f \<lesssim> g\<close> obtain n\<^sub>1 c\<^sub>1 where "c\<^sub>1 > 0"
        and P\<^sub>1: "\<And>m. m > n\<^sub>1 \<Longrightarrow> f m \<le> c\<^sub>1 * g m" by rule blast
      from \<open>g \<lesssim> f\<close> obtain n\<^sub>2 c\<^sub>2 where "c\<^sub>2 > 0"
        and P\<^sub>2: "\<And>m. m > n\<^sub>2 \<Longrightarrow> g m \<le> c\<^sub>2 * f m" by rule blast
      have "\<forall>m>max n\<^sub>1 n\<^sub>2. f m \<le> c\<^sub>1 * g m \<and> g m \<le> c\<^sub>2 * f m"
      proof (rule allI, rule impI)
        fix m
        assume Q: "m > max n\<^sub>1 n\<^sub>2"
        from P\<^sub>1 Q have "f m \<le> c\<^sub>1 * g m" by simp
        moreover from P\<^sub>2 Q have "g m \<le> c\<^sub>2 * f m" by simp
        ultimately show "f m \<le> c\<^sub>1 * g m \<and> g m \<le> c\<^sub>2 * f m" ..
      qed
      with \<open>c\<^sub>1 > 0\<close> \<open>c\<^sub>2 > 0\<close> have "\<exists>c\<^sub>1>0. \<exists>c\<^sub>2>0. \<exists>n.
        \<forall>m>n. f m \<le> c\<^sub>1 * g m \<and> g m \<le> c\<^sub>2 * f m" by blast
      then show "f \<cong> g" by (rule equiv_funI)
    qed
  qed
qed

declare fun_order.equiv_antisym [intro?]

subsection \<open>Simple examples\<close>

text \<open>
  Most of these are left as constructive exercises for the reader.  Note that additional
  preconditions to the functions may be necessary.  The list here is by no means to be
  intended as complete construction set for typical functions, here surely something
  has to be added yet.
\<close>

text \<open>\<^prop>\<open>(\<lambda>n. f n + k) \<cong> f\<close>\<close>

lemma equiv_fun_mono_const:
  assumes "mono f" and "\<exists>n. f n > 0"
  shows "(\<lambda>n. f n + k) \<cong> f"
proof (cases "k = 0")
  case True then show ?thesis by simp
next
  case False
  show ?thesis
  proof
    show "(\<lambda>n. f n + k) \<lesssim> f"
    proof
      from \<open>\<exists>n. f n > 0\<close> obtain n where "f n > 0" ..
      have "\<forall>m>n. f m + k \<le> Suc k * f m"
      proof (rule allI, rule impI)
        fix m
        assume "n < m"
        with \<open>mono f\<close> have "f n \<le> f m"
          using less_imp_le_nat monoE by blast
        with  \<open>0 < f n\<close> have "0 < f m" by auto
        then obtain l where "f m = Suc l" by (cases "f m") simp_all
        then show "f m + k \<le> Suc k * f m" by simp
      qed
      then show "\<exists>c>0. \<exists>n. \<forall>m>n. f m + k \<le> c * f m" by blast
    qed
    show "f \<lesssim> (\<lambda>n. f n + k)"
    proof
      have "f m \<le> 1 * (f m + k)" for m by simp
      then show "\<exists>c>0. \<exists>n. \<forall>m>n. f m \<le> c * (f m + k)" by blast
    qed
  qed
qed

lemma
  assumes "strict_mono f"
  shows "(\<lambda>n. f n + k) \<cong> f"
proof (rule equiv_fun_mono_const)
  from assms show "mono f" by (rule strict_mono_mono)
  show "\<exists>n. 0 < f n"
  proof (rule ccontr)
    assume "\<not> (\<exists>n. 0 < f n)"
    then have "\<And>n. f n = 0" by simp
    then have "f 0 = f 1" by simp
    moreover from \<open>strict_mono f\<close> have "f 0 < f 1"
      by (simp add: strict_mono_def)
    ultimately show False by simp
  qed
qed

lemma
  "(\<lambda>n. Suc k * f n) \<cong> f"
proof
  show "(\<lambda>n. Suc k * f n) \<lesssim> f"
  proof
    have "Suc k * f m \<le> Suc k * f m" for m by simp
    then show "\<exists>c>0. \<exists>n. \<forall>m>n. Suc k * f m \<le> c * f m" by blast
  qed
  show "f \<lesssim> (\<lambda>n. Suc k * f n)"
  proof
    have "f m \<le> 1 * (Suc k * f m)" for m by simp
    then show "\<exists>c>0. \<exists>n. \<forall>m>n. f m \<le> c * (Suc k * f m)" by blast
  qed
qed

lemma
  "f \<lesssim> (\<lambda>n. f n + g n)"
  by rule auto

lemma
  "(\<lambda>_. 0) \<prec> (\<lambda>n. Suc k)"
  by (rule less_fun_strongI) auto

lemma
  "(\<lambda>_. k) \<prec> Discrete.log"
proof (rule less_fun_strongI)
  fix c :: nat
  have "\<forall>m>2 ^ (Suc (c * k)). c * k < Discrete.log m"
  proof (rule allI, rule impI)
    fix m :: nat
    assume "2 ^ Suc (c * k) < m"
    then have "2 ^ Suc (c * k) \<le> m" by simp
    with log_mono have "Discrete.log (2 ^ (Suc (c * k))) \<le> Discrete.log m"
      by (blast dest: monoD)
    moreover have "c * k < Discrete.log (2 ^ (Suc (c * k)))" by simp
    ultimately show "c * k < Discrete.log m" by auto
  qed
  then show "\<exists>n. \<forall>m>n. c * k < Discrete.log m" ..
qed

(*lemma
  "Discrete.log \<prec> Discrete.sqrt"
proof (rule less_fun_strongI)*)
text \<open>\<^prop>\<open>Discrete.log \<prec> Discrete.sqrt\<close>\<close>

lemma
  "Discrete.sqrt \<prec> id"
proof (rule less_fun_strongI)
  fix c :: nat
  assume "0 < c"
  have "\<forall>m>(Suc c)\<^sup>2. c * Discrete.sqrt m < id m"
  proof (rule allI, rule impI)
    fix m
    assume "(Suc c)\<^sup>2 < m"
    then have "(Suc c)\<^sup>2 \<le> m" by simp
    with mono_sqrt have "Discrete.sqrt ((Suc c)\<^sup>2) \<le> Discrete.sqrt m" by (rule monoE)
    then have "Suc c \<le> Discrete.sqrt m" by simp
    then have "c < Discrete.sqrt m" by simp
    moreover from \<open>(Suc c)\<^sup>2 < m\<close> have "Discrete.sqrt m > 0" by simp
    ultimately have "c * Discrete.sqrt m < Discrete.sqrt m * Discrete.sqrt m" by simp
    also have "\<dots> \<le> m" by (simp add: power2_eq_square [symmetric])
    finally show "c * Discrete.sqrt m < id m" by simp
  qed
  then show "\<exists>n. \<forall>m>n. c * Discrete.sqrt m < id m" ..
qed

lemma
  "id \<prec> (\<lambda>n. n\<^sup>2)"
  by (rule less_fun_strongI) (auto simp add: power2_eq_square)

lemma
  "(\<lambda>n. n ^ k) \<prec> (\<lambda>n. n ^ Suc k)"
  by (rule less_fun_strongI) auto

(*lemma
  "(\<lambda>n. n ^ k) \<prec> (\<lambda>n. 2 ^ n)"
proof (rule less_fun_strongI)*)
text \<open>\<^prop>\<open>(\<lambda>n. n ^ k) \<prec> (\<lambda>n. 2 ^ n)\<close>\<close>

end


(*  Title:      HOL/Library/Infinite_Set.thy
    Author:     Stephan Merz
*)

section {* Infinite Sets and Related Concepts *}

theory Infinite_Set
imports Main
begin

subsection "Infinite Sets"

text {*
  Some elementary facts about infinite sets, mostly by Stephan Merz.
  Beware! Because "infinite" merely abbreviates a negation, these
  lemmas may not work well with @{text "blast"}.
*}

abbreviation infinite :: "'a set \<Rightarrow> bool"
  where "infinite S \<equiv> \<not> finite S"

text {*
  Infinite sets are non-empty, and if we remove some elements from an
  infinite set, the result is still infinite.
*}

lemma infinite_imp_nonempty: "infinite S \<Longrightarrow> S \<noteq> {}"
  by auto

lemma infinite_remove: "infinite S \<Longrightarrow> infinite (S - {a})"
  by simp

lemma Diff_infinite_finite:
  assumes T: "finite T" and S: "infinite S"
  shows "infinite (S - T)"
  using T
proof induct
  from S
  show "infinite (S - {})" by auto
next
  fix T x
  assume ih: "infinite (S - T)"
  have "S - (insert x T) = (S - T) - {x}"
    by (rule Diff_insert)
  with ih
  show "infinite (S - (insert x T))"
    by (simp add: infinite_remove)
qed

lemma Un_infinite: "infinite S \<Longrightarrow> infinite (S \<union> T)"
  by simp

lemma infinite_Un: "infinite (S \<union> T) \<longleftrightarrow> infinite S \<or> infinite T"
  by simp

lemma infinite_super:
  assumes T: "S \<subseteq> T" and S: "infinite S"
  shows "infinite T"
proof
  assume "finite T"
  with T have "finite S" by (simp add: finite_subset)
  with S show False by simp
qed

text {*
  As a concrete example, we prove that the set of natural numbers is
  infinite.
*}

lemma finite_nat_bounded: assumes S: "finite (S::nat set)" shows "\<exists>k. S \<subseteq> {..<k}"
proof cases
  assume "S \<noteq> {}" with Max_less_iff[OF S this] show ?thesis
    by auto
qed simp

lemma finite_nat_iff_bounded: "finite (S::nat set) \<longleftrightarrow> (\<exists>k. S \<subseteq> {..<k})"
  by (auto intro: finite_nat_bounded dest: finite_subset)

lemma finite_nat_iff_bounded_le:
  "finite (S::nat set) \<longleftrightarrow> (\<exists>k. S \<subseteq> {..k})"  (is "?lhs \<longleftrightarrow> ?rhs")
proof
  assume ?lhs
  then obtain k where "S \<subseteq> {..<k}"
    by (blast dest: finite_nat_bounded)
  then have "S \<subseteq> {..k}" by auto
  then show ?rhs ..
next
  assume ?rhs
  then obtain k where "S \<subseteq> {..k}" ..
  then show "finite S"
    by (rule finite_subset) simp
qed

lemma infinite_nat_iff_unbounded: "infinite (S::nat set) \<longleftrightarrow> (\<forall>m. \<exists>n. m < n \<and> n \<in> S)"
  unfolding finite_nat_iff_bounded_le by (auto simp: subset_eq not_le)

lemma infinite_nat_iff_unbounded_le:
  "infinite (S::nat set) \<longleftrightarrow> (\<forall>m. \<exists>n. m \<le> n \<and> n \<in> S)"
  unfolding finite_nat_iff_bounded by (auto simp: subset_eq not_less)

text {*
  For a set of natural numbers to be infinite, it is enough to know
  that for any number larger than some @{text k}, there is some larger
  number that is an element of the set.
*}

lemma unbounded_k_infinite:
  assumes k: "\<forall>m. k < m \<longrightarrow> (\<exists>n. m < n \<and> n \<in> S)"
  shows "infinite (S::nat set)"
proof -
  {
    fix m have "\<exists>n. m < n \<and> n \<in> S"
    proof (cases "k < m")
      case True
      with k show ?thesis by blast
    next
      case False
      from k obtain n where "Suc k < n \<and> n \<in> S" by auto
      with False have "m < n \<and> n \<in> S" by auto
      then show ?thesis ..
    qed
  }
  then show ?thesis
    by (auto simp add: infinite_nat_iff_unbounded)
qed

lemma nat_not_finite: "finite (UNIV::nat set) \<Longrightarrow> R"
  by simp

lemma range_inj_infinite:
  "inj (f::nat \<Rightarrow> 'a) \<Longrightarrow> infinite (range f)"
proof
  assume "finite (range f)" and "inj f"
  then have "finite (UNIV::nat set)"
    by (rule finite_imageD)
  then show False by simp
qed

text {*
  For any function with infinite domain and finite range there is some
  element that is the image of infinitely many domain elements.  In
  particular, any infinite sequence of elements from a finite set
  contains some element that occurs infinitely often.
*}

lemma inf_img_fin_dom:
  assumes img: "finite (f`A)" and dom: "infinite A"
  shows "\<exists>y \<in> f`A. infinite (f -` {y})"
proof (rule ccontr)
  assume "\<not> ?thesis"
  with img have "finite (UN y:f`A. f -` {y})" by blast
  moreover have "A \<subseteq> (UN y:f`A. f -` {y})" by auto
  moreover note dom
  ultimately show False by (simp add: infinite_super)
qed

lemma inf_img_fin_domE:
  assumes "finite (f`A)" and "infinite A"
  obtains y where "y \<in> f`A" and "infinite (f -` {y})"
  using assms by (blast dest: inf_img_fin_dom)

subsection "Infinitely Many and Almost All"

text {*
  We often need to reason about the existence of infinitely many
  (resp., all but finitely many) objects satisfying some predicate, so
  we introduce corresponding binders and their proof rules.
*}

definition Inf_many :: "('a \<Rightarrow> bool) \<Rightarrow> bool"  (binder "INFM " 10)
  where "Inf_many P \<longleftrightarrow> infinite {x. P x}"

definition Alm_all :: "('a \<Rightarrow> bool) \<Rightarrow> bool"  (binder "MOST " 10)
  where "Alm_all P \<longleftrightarrow> \<not> (INFM x. \<not> P x)"

notation (xsymbols)
  Inf_many  (binder "\<exists>\<^sub>\<infinity>" 10) and
  Alm_all  (binder "\<forall>\<^sub>\<infinity>" 10)

notation (HTML output)
  Inf_many  (binder "\<exists>\<^sub>\<infinity>" 10) and
  Alm_all  (binder "\<forall>\<^sub>\<infinity>" 10)

lemma INFM_iff_infinite: "(INFM x. P x) \<longleftrightarrow> infinite {x. P x}"
  unfolding Inf_many_def ..

lemma MOST_iff_cofinite: "(MOST x. P x) \<longleftrightarrow> finite {x. \<not> P x}"
  unfolding Alm_all_def Inf_many_def by simp

(* legacy name *)
lemmas MOST_iff_finiteNeg = MOST_iff_cofinite

lemma not_INFM [simp]: "\<not> (INFM x. P x) \<longleftrightarrow> (MOST x. \<not> P x)"
  unfolding Alm_all_def not_not ..

lemma not_MOST [simp]: "\<not> (MOST x. P x) \<longleftrightarrow> (INFM x. \<not> P x)"
  unfolding Alm_all_def not_not ..

lemma INFM_const [simp]: "(INFM x::'a. P) \<longleftrightarrow> P \<and> infinite (UNIV::'a set)"
  unfolding Inf_many_def by simp

lemma MOST_const [simp]: "(MOST x::'a. P) \<longleftrightarrow> P \<or> finite (UNIV::'a set)"
  unfolding Alm_all_def by simp

lemma INFM_EX: "(\<exists>\<^sub>\<infinity>x. P x) \<Longrightarrow> (\<exists>x. P x)"
  apply (erule contrapos_pp)
  apply simp
  done

lemma ALL_MOST: "\<forall>x. P x \<Longrightarrow> \<forall>\<^sub>\<infinity>x. P x"
  by simp

lemma INFM_E:
  assumes "INFM x. P x"
  obtains x where "P x"
  using INFM_EX [OF assms] by (rule exE)

lemma MOST_I:
  assumes "\<And>x. P x"
  shows "MOST x. P x"
  using assms by simp

lemma INFM_mono:
  assumes inf: "\<exists>\<^sub>\<infinity>x. P x" and q: "\<And>x. P x \<Longrightarrow> Q x"
  shows "\<exists>\<^sub>\<infinity>x. Q x"
proof -
  from inf have "infinite {x. P x}" unfolding Inf_many_def .
  moreover from q have "{x. P x} \<subseteq> {x. Q x}" by auto
  ultimately show ?thesis
    by (simp add: Inf_many_def infinite_super)
qed

lemma MOST_mono: "\<forall>\<^sub>\<infinity>x. P x \<Longrightarrow> (\<And>x. P x \<Longrightarrow> Q x) \<Longrightarrow> \<forall>\<^sub>\<infinity>x. Q x"
  unfolding Alm_all_def by (blast intro: INFM_mono)

lemma INFM_disj_distrib:
  "(\<exists>\<^sub>\<infinity>x. P x \<or> Q x) \<longleftrightarrow> (\<exists>\<^sub>\<infinity>x. P x) \<or> (\<exists>\<^sub>\<infinity>x. Q x)"
  unfolding Inf_many_def by (simp add: Collect_disj_eq)

lemma INFM_imp_distrib:
  "(INFM x. P x \<longrightarrow> Q x) \<longleftrightarrow> ((MOST x. P x) \<longrightarrow> (INFM x. Q x))"
  by (simp only: imp_conv_disj INFM_disj_distrib not_MOST)

lemma MOST_conj_distrib:
  "(\<forall>\<^sub>\<infinity>x. P x \<and> Q x) \<longleftrightarrow> (\<forall>\<^sub>\<infinity>x. P x) \<and> (\<forall>\<^sub>\<infinity>x. Q x)"
  unfolding Alm_all_def by (simp add: INFM_disj_distrib del: disj_not1)

lemma MOST_conjI:
  "MOST x. P x \<Longrightarrow> MOST x. Q x \<Longrightarrow> MOST x. P x \<and> Q x"
  by (simp add: MOST_conj_distrib)

lemma INFM_conjI:
  "INFM x. P x \<Longrightarrow> MOST x. Q x \<Longrightarrow> INFM x. P x \<and> Q x"
  unfolding MOST_iff_cofinite INFM_iff_infinite
  apply (drule (1) Diff_infinite_finite)
  apply (simp add: Collect_conj_eq Collect_neg_eq)
  done

lemma MOST_rev_mp:
  assumes "\<forall>\<^sub>\<infinity>x. P x" and "\<forall>\<^sub>\<infinity>x. P x \<longrightarrow> Q x"
  shows "\<forall>\<^sub>\<infinity>x. Q x"
proof -
  have "\<forall>\<^sub>\<infinity>x. P x \<and> (P x \<longrightarrow> Q x)"
    using assms by (rule MOST_conjI)
  thus ?thesis by (rule MOST_mono) simp
qed

lemma MOST_imp_iff:
  assumes "MOST x. P x"
  shows "(MOST x. P x \<longrightarrow> Q x) \<longleftrightarrow> (MOST x. Q x)"
proof
  assume "MOST x. P x \<longrightarrow> Q x"
  with assms show "MOST x. Q x" by (rule MOST_rev_mp)
next
  assume "MOST x. Q x"
  then show "MOST x. P x \<longrightarrow> Q x" by (rule MOST_mono) simp
qed

lemma INFM_MOST_simps [simp]:
  "\<And>P Q. (INFM x. P x \<and> Q) \<longleftrightarrow> (INFM x. P x) \<and> Q"
  "\<And>P Q. (INFM x. P \<and> Q x) \<longleftrightarrow> P \<and> (INFM x. Q x)"
  "\<And>P Q. (MOST x. P x \<or> Q) \<longleftrightarrow> (MOST x. P x) \<or> Q"
  "\<And>P Q. (MOST x. P \<or> Q x) \<longleftrightarrow> P \<or> (MOST x. Q x)"
  "\<And>P Q. (MOST x. P x \<longrightarrow> Q) \<longleftrightarrow> ((INFM x. P x) \<longrightarrow> Q)"
  "\<And>P Q. (MOST x. P \<longrightarrow> Q x) \<longleftrightarrow> (P \<longrightarrow> (MOST x. Q x))"
  unfolding Alm_all_def Inf_many_def
  by (simp_all add: Collect_conj_eq)

text {* Properties of quantifiers with injective functions. *}

lemma INFM_inj: "INFM x. P (f x) \<Longrightarrow> inj f \<Longrightarrow> INFM x. P x"
  unfolding INFM_iff_infinite
  apply clarify
  apply (drule (1) finite_vimageI)
  apply simp
  done

lemma MOST_inj: "MOST x. P x \<Longrightarrow> inj f \<Longrightarrow> MOST x. P (f x)"
  unfolding MOST_iff_cofinite
  apply (drule (1) finite_vimageI)
  apply simp
  done

text {* Properties of quantifiers with singletons. *}

lemma not_INFM_eq [simp]:
  "\<not> (INFM x. x = a)"
  "\<not> (INFM x. a = x)"
  unfolding INFM_iff_infinite by simp_all

lemma MOST_neq [simp]:
  "MOST x. x \<noteq> a"
  "MOST x. a \<noteq> x"
  unfolding MOST_iff_cofinite by simp_all

lemma INFM_neq [simp]:
  "(INFM x::'a. x \<noteq> a) \<longleftrightarrow> infinite (UNIV::'a set)"
  "(INFM x::'a. a \<noteq> x) \<longleftrightarrow> infinite (UNIV::'a set)"
  unfolding INFM_iff_infinite by simp_all

lemma MOST_eq [simp]:
  "(MOST x::'a. x = a) \<longleftrightarrow> finite (UNIV::'a set)"
  "(MOST x::'a. a = x) \<longleftrightarrow> finite (UNIV::'a set)"
  unfolding MOST_iff_cofinite by simp_all

lemma MOST_eq_imp:
  "MOST x. x = a \<longrightarrow> P x"
  "MOST x. a = x \<longrightarrow> P x"
  unfolding MOST_iff_cofinite by simp_all

text {* Properties of quantifiers over the naturals. *}

lemma INFM_nat: "(\<exists>\<^sub>\<infinity>n. P (n::nat)) \<longleftrightarrow> (\<forall>m. \<exists>n. m < n \<and> P n)"
  by (simp add: Inf_many_def infinite_nat_iff_unbounded)

lemma INFM_nat_le: "(\<exists>\<^sub>\<infinity>n. P (n::nat)) \<longleftrightarrow> (\<forall>m. \<exists>n. m \<le> n \<and> P n)"
  by (simp add: Inf_many_def infinite_nat_iff_unbounded_le)

lemma MOST_nat: "(\<forall>\<^sub>\<infinity>n. P (n::nat)) \<longleftrightarrow> (\<exists>m. \<forall>n. m < n \<longrightarrow> P n)"
  by (simp add: Alm_all_def INFM_nat)

lemma MOST_nat_le: "(\<forall>\<^sub>\<infinity>n. P (n::nat)) \<longleftrightarrow> (\<exists>m. \<forall>n. m \<le> n \<longrightarrow> P n)"
  by (simp add: Alm_all_def INFM_nat_le)

subsection "Enumeration of an Infinite Set"

text {*
  The set's element type must be wellordered (e.g. the natural numbers).
*}

primrec (in wellorder) enumerate :: "'a set \<Rightarrow> nat \<Rightarrow> 'a"
where
  enumerate_0: "enumerate S 0 = (LEAST n. n \<in> S)"
| enumerate_Suc: "enumerate S (Suc n) = enumerate (S - {LEAST n. n \<in> S}) n"

lemma enumerate_Suc': "enumerate S (Suc n) = enumerate (S - {enumerate S 0}) n"
  by simp

lemma enumerate_in_set: "infinite S \<Longrightarrow> enumerate S n : S"
  apply (induct n arbitrary: S)
   apply (fastforce intro: LeastI dest!: infinite_imp_nonempty)
  apply simp
  apply (metis DiffE infinite_remove)
  done

declare enumerate_0 [simp del] enumerate_Suc [simp del]

lemma enumerate_step: "infinite S \<Longrightarrow> enumerate S n < enumerate S (Suc n)"
  apply (induct n arbitrary: S)
   apply (rule order_le_neq_trans)
    apply (simp add: enumerate_0 Least_le enumerate_in_set)
   apply (simp only: enumerate_Suc')
   apply (subgoal_tac "enumerate (S - {enumerate S 0}) 0 : S - {enumerate S 0}")
    apply (blast intro: sym)
   apply (simp add: enumerate_in_set del: Diff_iff)
  apply (simp add: enumerate_Suc')
  done

lemma enumerate_mono: "m<n \<Longrightarrow> infinite S \<Longrightarrow> enumerate S m < enumerate S n"
  apply (erule less_Suc_induct)
  apply (auto intro: enumerate_step)
  done

lemma le_enumerate:
  assumes S: "infinite S"
  shows "n \<le> enumerate S n"
  using S
proof (induct n)
  case 0
  then show ?case by simp
next
  case (Suc n)
  then have "n \<le> enumerate S n" by simp
  also note enumerate_mono[of n "Suc n", OF _ `infinite S`]
  finally show ?case by simp
qed

lemma enumerate_Suc'':
  fixes S :: "'a::wellorder set"
  assumes "infinite S"
  shows "enumerate S (Suc n) = (LEAST s. s \<in> S \<and> enumerate S n < s)"
  using assms
proof (induct n arbitrary: S)
  case 0
  then have "\<forall>s \<in> S. enumerate S 0 \<le> s"
    by (auto simp: enumerate.simps intro: Least_le)
  then show ?case
    unfolding enumerate_Suc' enumerate_0[of "S - {enumerate S 0}"]
    by (intro arg_cong[where f = Least] ext) auto
next
  case (Suc n S)
  show ?case
    using enumerate_mono[OF zero_less_Suc `infinite S`, of n] `infinite S`
    apply (subst (1 2) enumerate_Suc')
    apply (subst Suc)
    using `infinite S`
    apply simp
    apply (intro arg_cong[where f = Least] ext)
    apply (auto simp: enumerate_Suc'[symmetric])
    done
qed

lemma enumerate_Ex:
  assumes S: "infinite (S::nat set)"
  shows "s \<in> S \<Longrightarrow> \<exists>n. enumerate S n = s"
proof (induct s rule: less_induct)
  case (less s)
  show ?case
  proof cases
    let ?y = "Max {s'\<in>S. s' < s}"
    assume "\<exists>y\<in>S. y < s"
    then have y: "\<And>x. ?y < x \<longleftrightarrow> (\<forall>s'\<in>S. s' < s \<longrightarrow> s' < x)"
      by (subst Max_less_iff) auto
    then have y_in: "?y \<in> {s'\<in>S. s' < s}"
      by (intro Max_in) auto
    with less.hyps[of ?y] obtain n where "enumerate S n = ?y"
      by auto
    with S have "enumerate S (Suc n) = s"
      by (auto simp: y less enumerate_Suc'' intro!: Least_equality)
    then show ?case by auto
  next
    assume *: "\<not> (\<exists>y\<in>S. y < s)"
    then have "\<forall>t\<in>S. s \<le> t" by auto
    with `s \<in> S` show ?thesis
      by (auto intro!: exI[of _ 0] Least_equality simp: enumerate_0)
  qed
qed

lemma bij_enumerate:
  fixes S :: "nat set"
  assumes S: "infinite S"
  shows "bij_betw (enumerate S) UNIV S"
proof -
  have "\<And>n m. n \<noteq> m \<Longrightarrow> enumerate S n \<noteq> enumerate S m"
    using enumerate_mono[OF _ `infinite S`] by (auto simp: neq_iff)
  then have "inj (enumerate S)"
    by (auto simp: inj_on_def)
  moreover have "\<forall>s \<in> S. \<exists>i. enumerate S i = s"
    using enumerate_Ex[OF S] by auto
  moreover note `infinite S`
  ultimately show ?thesis
    unfolding bij_betw_def by (auto intro: enumerate_in_set)
qed

subsection "Miscellaneous"

text {*
  A few trivial lemmas about sets that contain at most one element.
  These simplify the reasoning about deterministic automata.
*}

definition atmost_one :: "'a set \<Rightarrow> bool"
  where "atmost_one S \<longleftrightarrow> (\<forall>x y. x\<in>S \<and> y\<in>S \<longrightarrow> x = y)"

lemma atmost_one_empty: "S = {} \<Longrightarrow> atmost_one S"
  by (simp add: atmost_one_def)

lemma atmost_one_singleton: "S = {x} \<Longrightarrow> atmost_one S"
  by (simp add: atmost_one_def)

lemma atmost_one_unique [elim]: "atmost_one S \<Longrightarrow> x \<in> S \<Longrightarrow> y \<in> S \<Longrightarrow> y = x"
  by (simp add: atmost_one_def)

end


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

text {* Define a datatype @{text"'a tree"} for binary trees. Both leaf and
internal nodes store information. *}

datatype 'a tree = Tip "'a" | Node "'a" "'a tree" "'a tree"

text {* Define the functions @{term preOrder}, @{term postOrder}, and @{term
inOrder} that traverse an @{text"'a tree"} in the respective order. *}

primrec preOrder :: "'a tree \<Rightarrow> 'a list" where
  "preOrder (Tip a)      = [a]"
| "preOrder (Node f x y) = f#((preOrder x)@(preOrder y))"

primrec postOrder :: "'a tree \<Rightarrow> 'a list" where
  "postOrder (Tip a)      = [a]"
| "postOrder (Node f x y) = (postOrder x)@(postOrder y)@[f]"

primrec inOrder :: "'a tree \<Rightarrow> 'a list" where
  "inOrder (Tip a)      = [a]"
| "inOrder (Node f x y) = (inOrder x)@[f]@(inOrder y)"

text {* Define a function @{term mirror} that returns the mirror image of an
@{text "'a tree"}. *}

fun
  mirror :: "'a tree \<Rightarrow> 'a tree" where
"mirror x = (case x of (Tip y) \<Rightarrow>(Tip y)|(Node a b c) \<Rightarrow> Node a (mirror c) (mirror b))"

text {* Suppose that @{term xOrder} and @{term yOrder} are tree traversal
functions chosen from @{term preOrder}, @{term postOrder}, and @{term inOrder}.
Formulate and prove all valid properties of the form \mbox{@{text "xOrder
(mirror xt) = rev (yOrder xt)"}}. *}
lemma "preOrder (mirror xt) = rev(postOrder xt)"
  apply(induct xt)
   apply auto
  done

lemma "postOrder (mirror xt) = rev(preOrder xt)"
  apply(induct xt)
   apply auto
  done

lemma "inOrder (mirror xt) = rev(inOrder xt)"
  apply(induct xt)
   apply auto
  done

text {* Define the functions @{term root}, @{term leftmost} and @{term
rightmost}, that return the root, leftmost, and rightmost element respectively.
*}

primrec root :: "'a tree \<Rightarrow> 'a" where
  "root (Tip a)      = a"
| "root (Node f x y) = f"

primrec leftmost :: "'a tree \<Rightarrow> 'a" where
  "leftmost (Tip a)      = a"
| "leftmost (Node f x y) = (leftmost x)"

primrec rightmost :: "'a tree \<Rightarrow> 'a" where
  "rightmost (Tip a)      = a"
| "rightmost (Node f x y) = (rightmost y)"

text {* Prove (or let Isabelle disprove) the theorems that follow.  You
may have to prove some lemmas first. *}

theorem "last (inOrder xt) = rightmost xt"
  apply (induct xt)
  apply auto
done

theorem "hd (inOrder xt) = leftmost xt"
  apply (induct xt)
  apply auto
done

theorem "hd (preOrder xt) = last (postOrder xt)"
  apply (induct xt)
  apply auto
done

theorem "hd (preOrder xt) = root xt"
  apply (induct xt)
  apply auto
done

theorem "hd (inOrder xt) = root xt"
  quickcheck oops

theorem "last (postOrder xt) = root xt"
  apply (induct xt)
  apply auto
done

(*<*) end (*>*)