theory Demo05
  imports Main
begin

text \<open>Many of the types and algorithms exist already in the
  standard Isabelle library. We hide all of this to develop
  everything from scratch.\<close>

hide_const plus times rev sort sorted If "and" insort Nil Cons
hide_fact sorted_insort sorted_sort

datatype Nat = Zero | Succ Nat
datatype List = Nil | Cons Nat List

fun plus :: "Nat \<Rightarrow> Nat \<Rightarrow> Nat" where
  "plus Zero y = y" 
| "plus (Succ x) y = Succ (plus x y)" 

fun times :: "Nat \<Rightarrow> Nat \<Rightarrow> Nat" where
  "times Zero y = Zero" 
| "times (Succ x) y = plus y (times x y)" 

thm Nat.simps(1-3)
thm List.simps(1-3)
thm refl

thm Nat.induct
thm List.induct
thm plus.simps
thm times.simps


text \<open>In Isabelle, equational reasoning is performed by @{method simp}.\<close>

lemma slide_30: "plus Zero Zero = times Zero x" 
  by simp

fun app :: "List \<Rightarrow> List \<Rightarrow> List" where
  "app Nil ys = ys" 
| "app (Cons x xs) ys = Cons x (app xs ys)" 

lemma slide_37_38: "app (app xs ys) zs = app xs (app ys zs)" 
proof (induction xs arbitrary: ys zs)
  case Nil
  show ?case by simp
next
  case (Cons x xs)
  show ?case 
    apply simp 
    oops (* oops aborts proof attempt *)

lemma app_assoc: "app (app xs ys) zs = app xs (app ys zs)" 
proof (induction xs arbitrary: ys zs)
  case Nil
  show ?case by simp
next
  case (Cons x xs)
  show ?case by (simp add: Cons.IH)
qed

lemma app_assoc_compressed: "app (app xs ys) zs = app xs (app ys zs)" 
  by (induction xs arbitrary: ys zs) simp_all

lemma app_assoc_verbose: "app (app xs ys) zs = app xs (app ys zs)" 
proof (induction xs arbitrary: ys zs)
  case Nil
  have "app (app Nil ys) zs = app Nil (app ys zs)
      \<longleftrightarrow> app ys zs = app Nil (app ys zs)" by simp
  also have "\<dots> \<longleftrightarrow> app ys zs = app ys zs" by simp
  also have "\<dots> \<longleftrightarrow> True" by simp
  finally show ?case by simp
next
  case (Cons x xs ys zs)
  have "app (app (Cons x xs) ys) zs = app (Cons x xs) (app ys zs)
     \<longleftrightarrow> app (Cons x (app xs ys)) zs = app (Cons x xs) (app ys zs)" by simp
  also have "\<dots> \<longleftrightarrow> Cons x (app (app xs ys) zs) = app (Cons x xs) (app ys zs)" by simp
  also have "\<dots> \<longleftrightarrow> Cons x (app (app xs ys) zs) = Cons x (app xs (app ys zs))" by simp
  also have "\<dots> \<longleftrightarrow> x = x \<and> app (app xs ys) zs = app xs (app ys zs)" by simp
  also have "\<dots> \<longleftrightarrow> True \<and> app (app xs ys) zs = app xs (app ys zs)" by simp  
  also have "\<dots> \<longleftrightarrow> app (app xs ys) zs = app xs (app ys zs)" by simp  
  also have "\<dots> \<longleftrightarrow> True" using Cons.IH by simp
  finally show ?case by simp
qed

lemma slide_46: "app (app xs ys) zs = app xs (app ys zs)" 
proof (induction ys arbitrary: xs zs)
  case Nil
  show ?case 
    apply simp 
    oops

lemma slide_47_fail: "plus x y = plus y x" 
proof (induction x arbitrary: y)
  case Zero
  show ?case 
    apply simp 
    oops

lemma Zero_right_neutral: "plus x Zero = x" 
  by (induction x) simp_all

text \<open>It follows a declaration to add some property as "axiom" that should
  always be considered by equational reasoning engine.\<close>
declare Zero_right_neutral[simp]

lemma slide_49_fail: "plus x y = plus y x" 
proof (induction x arbitrary: y)
  case Zero
  show ?case by simp
next
  case (Succ x y)
  show ?case 
    apply (simp add: Succ.IH) 
    oops

lemma plus_right_Succ: "plus x (Succ y) = Succ (plus x y)" 
  by (induction x arbitrary: y) simp_all

declare plus_right_Succ[simp]

lemma plus_comm: "plus x y = plus y x" 
  by (induction x arbitrary: y) simp_all


fun rev :: "List \<Rightarrow> List" where
  "rev (Cons x xs) = app (rev xs) (Cons x Nil)" 
| "rev Nil = Nil" 

fun r :: "List \<Rightarrow> List \<Rightarrow> List" where 
  "r (Cons x xs) ys = r xs (Cons x ys)" 
| "r Nil ys = ys" 

fun rev_fast :: "List \<Rightarrow> List" where
  "rev_fast xs = r xs Nil" 

lemma slide_50: "rev_fast xs = rev xs" 
  apply simp 
  oops

lemma slide_51: "r xs Nil = rev xs" 
proof (induction xs)
  case (Cons x xs)
  show ?case 
    apply simp 
    using Cons.IH 
    oops

lemma r_app_rev: "r xs ys = app (rev xs) ys" 
proof (induction xs arbitrary: ys)
  case (Cons x xs ys)
  show ?case by (simp add: app_assoc Cons.IH)
qed simp

lemma slide_53_fail: "rev_fast xs = rev xs" 
  apply (simp add: r_app_rev) 
  oops

lemma app_right_Nil: "app xs Nil = xs" 
  by (induction xs) simp_all

declare app_right_Nil[simp]

lemma rev_fast_is_rev: "rev_fast xs = rev xs" 
  by (simp add: r_app_rev)


fun half :: "Nat \<Rightarrow> Nat" where
  "half Zero = Zero" 
| "half (Succ Zero) = Zero" 
| "half (Succ (Succ x)) = Succ (half x)" 

fun le :: "Nat \<Rightarrow> Nat \<Rightarrow> bool" where
  "le Zero y = True" 
| "le (Succ x) Zero = False" 
| "le (Succ x) (Succ y) = le x y" 

lemma slide_54: "le (half x) x" 
proof (induction x)
  case (Succ x)
  show ?case 
    apply simp?
    oops

lemma slide_58: "le (half x) x" 
proof (induction x rule: half.induct)
  case 1
  show ?case by simp
next
  case 2
  show ?case by simp
next
  case (3 x)
  show ?case 
    apply simp
    using "3.IH" oops

lemma le_incr_right: "le x y \<Longrightarrow> le x (Succ y)" 
proof (induction x y rule: le.induct)
  case (1 y)
  then show ?case by simp
next 
  case (2 x)
  then show ?case by simp
next
  case (3 x y)
  then show ?case by simp
qed

lemma le_half: "le (half x) x" 
proof (induction x rule: half.induct)
  case (3 x)
  show ?case using "3.IH" le_incr_right by simp
qed simp_all

text \<open>Note that normally one would use a predefined if-then-else\<close>
fun If :: "bool \<Rightarrow> List \<Rightarrow> List \<Rightarrow> List" where
  "If True xs ys = xs" 
| "If False xs ys = ys" 

fun insort :: "Nat \<Rightarrow> List \<Rightarrow> List" where
  "insort x Nil = Cons x Nil" 
| "insort x (Cons y ys) = If (le x y) 
     (Cons x (Cons y ys)) 
     (Cons y (insort x ys))" 

fun sort :: "List \<Rightarrow> List" where
  "sort Nil = Nil" 
| "sort (Cons x xs) = insort x (sort xs)" 

text \<open>One would also use a predefined conjunction operator\<close>

fun "and" :: "bool \<Rightarrow> bool \<Rightarrow> bool" where
  "and True b = b" 
| "and False b = False" 

fun all_le :: "Nat \<Rightarrow> List \<Rightarrow> bool" where
  "all_le x Nil = True" 
| "all_le x (Cons y ys) = and (le x y) (all_le x ys)" 
 
fun sorted :: "List \<Rightarrow> bool" where
  "sorted Nil = True" 
| "sorted (Cons x xs) = and (all_le x xs) (sorted xs)" 

context
  assumes sorted_insort: "\<forall> x xs. sorted (insort x xs) = sorted xs" 
begin

lemma conditional_sorted_sort: "sorted (sort xs)" 
  by (induction xs) (simp_all add: sorted_insort)

end

thm conditional_sorted_sort

lemma le_trans: "le x y \<Longrightarrow> le y z \<Longrightarrow> le x z" 
proof (induction x y arbitrary: z rule: le.induct)
  case (3 x y z)
  then show ?case by (cases z) simp_all
qed simp_all

text \<open>switch to logical conjunction\<close>
lemma and_is_conj[simp]: "and b1 b2 = (b1 \<and> b2)" 
  by (induction b1, simp_all)

lemma sorted_insort: "sorted (insort x xs) = sorted xs" 
proof (induction xs)
  case (Cons y ys)
  show ?case
  proof (cases "le x y")
    case True

    have aux: "le x y \<Longrightarrow> sorted (Cons y ys) \<Longrightarrow> all_le x (Cons y ys)"
      by (induction ys arbitrary: x y, insert le_trans, simp_all)

    show ?thesis using True 
      apply (simp del: sorted.simps add: sorted.simps(2)[of x])
      (* deactivate expansion of "sorted (Cons y ys)" *)
      using aux True
      by auto (* auto includes simp, and also does propositional reasoning *)
  next
    case False

    have aux1: "all_le y (insort x ys) = all_le y (Cons x ys)" 
    proof (induction ys)
      case (Cons z zs)
      thus ?case by (cases "le x z") auto
    qed simp

    have aux2: "\<not> le x y \<Longrightarrow> le y x" 
      by (induct x y rule: le.induct) simp_all

    show ?thesis using False
      apply (simp add: Cons.IH)
      apply (simp add: aux1)
      using aux2 False by simp
  qed
qed simp

lemma sorted_sort: "sorted (sort xs)" 
  using conditional_sorted_sort sorted_insort by simp

end