(*<*)
theory Lecture5
imports Main LaTeXsugar OptionalSugar
begin
(*>*)

section "Sets"

text{*

  One of the nice aspects of Isabelle is that it provides
  good support for reasoning with sets. For reference,
  see section 2.3 in  ``Isabelle's Logics: HOL''.

*}

constdefs Evens :: "nat set"
  "Evens \<equiv> { n. \<exists> m. n = 2*m }"
declare Evens_def[simp]

lemma "2 \<in> Evens" by (simp add: Evens_def)
lemma "34 \<in> Evens" by (simp add: Evens_def)

constdefs Odds :: "nat set"
  "Odds \<equiv> { n. \<exists> m. n = 2*m + 1 }"

text{*

  In the following proof we use the rules for
  intersection introduction and elimination and the 
  mem\_Collect\_eq rule that can be used to introduce
  and eliminate membership in a set that is formed
  by comprehension.

*}

lemma "x \<notin> (Evens \<inter> Odds)"
proof (induct x)
  show "0 \<notin> (Evens \<inter> Odds)" by (simp add: Odds_def)
next
  fix x assume xneo: "x \<notin> (Evens \<inter> Odds)"
  show "Suc x \<notin> (Evens \<inter> Odds)"
  proof
    assume towards_contra: "Suc x \<in> (Evens \<inter> Odds)"

    from towards_contra 
    have sxo: "Suc x \<in> Odds" by (rule IntD2)
    from sxo have xm: "\<exists> m. Suc x = 2 * m + 1" 
      by (simp only: Odds_def mem_Collect_eq)
    from xm obtain m where M: "Suc x = 2*m + 1"
      apply (rule exE) by assumption 
    from M have "x = 2 * m" by simp
    hence "\<exists> m'. x = 2 * m'" by (rule exI)
    hence xe: "x \<in> Evens" 
      by (simp only: Evens_def mem_Collect_eq) 

    from towards_contra 
    have sxe: "Suc x \<in> Evens" by (rule IntD1)
    from sxe obtain n where M: "Suc x = 2*n"
      apply (simp only: Evens_def mem_Collect_eq) by blast
    from M have "x = 2 * (n - 1) + 1" by arith
    hence xo: "x \<in> Odds" by (simp add: Odds_def)

    from xe xo have "x \<in> (Evens \<inter> Odds)" by (rule IntI)
    with xneo show "False" by simp
  qed
qed

text{* 

  Note how the rules for intersection are similar to the
  rules for conjunction. That is because the two notions are 
  equivalent in the following sense.

*}

lemma "(x \<in> A \<and> x \<in> B) = (x \<in> A \<inter> B)" by simp

text{* 
  Union is equivalent to disjunction and
  has similar introduction and elimination rules. 
*}

lemma "(x \<in> A \<or> x \<in> B) = (x \<in> A \<union> B)" by simp


text{*
  Subset is equivalent to implication.
*}

lemma "(\<forall> x. x \<in> A \<longrightarrow> x \<in> B) = (A \<subseteq> B)" by auto

text{*
  Complement is equivalent to not.
*}

lemma "(x \<in> -A) = (x \<notin> A)" by simp


section "Finite sets"

text{*

  Finite sets can be formed using insert and
  also set notation.

*}

lemma "insert 1 {0} = {0,1}" by auto

text{*

  The size of a finite set, its cardinality,
  is given by the \textit{card} function.

*}

lemma "card {} = 0" by simp
lemma "card {4::nat,4::nat} = 1" by simp
lemma "card {4::nat} = 1" by simp
lemma "card {4::nat,1} = 2" by simp
lemma "x \<noteq> y \<Longrightarrow> card {x,y} = 2" by simp

text{*

  You can define functions over finite sets using
  the 'fold' function.

*}

constdefs setsum :: "nat set \<Rightarrow> nat"
  "setsum S \<equiv> fold (\<lambda> x y. x + y) (\<lambda> x. x) 0 S"
declare setsum_def[simp]

lemma "setsum {1,2,3} = 6" by simp

text{*
  
  You can perform induction on finite sets.

  (This is also the first example of proof by case analysis.
   Perhaps we should introduce proof by cases earlier.)

*}

lemma setsum_ge: "finite S \<Longrightarrow> \<forall> x \<in> S. x \<le> setsum S"
proof (induct rule: finite_induct)
  show "\<forall>x\<in>{}. x \<le> setsum {}" by simp
next
  fix x and F::"nat set"
  assume fF: "finite F" and xF: "x \<notin> F" 
    and IH: "\<forall> x\<in>F. x \<le> setsum F"
  show "\<forall>y\<in>insert x F. y \<le> setsum (insert x F)"
  proof 
    fix y assume yxF: "y \<in> insert x F"
    from fF xF have 
      mc: "setsum (insert x F) = x + (setsum F)" by auto
    show "y \<le> setsum (insert x F)"
    proof (case_tac "y \<in> {x}")
      assume "y \<in> {x}"
      hence yx: "y = x" by simp
      from mc yx show "y \<le> setsum (insert x F)" by simp
    next
      assume "y \<notin> {x}"
      with yxF have yF: "y \<in> F" by auto
      with IH have ysF: "y \<le> setsum F" by blast
      from mc ysF show "y \<le> setsum (insert x F)" by auto
    qed
  qed
qed

section "Case study: automata and the Pumping Lemma"

text{*

  In this section we model deterministic finite automata (DFA)
  and prove the Pumping Lemma.

  We define a \textit{DFA} in Isabelle to be a record consisting of
  the set of states, the starting state, the set of final states,
  and the transition function $\delta$. The transition function
  says which state the DFA goes to given an input character
  (we're using natural numbers for characters here)
  and the current state.

*}

types state = nat

record DFA =
  DFA_states :: "state set" ("Q")
  DFA_start :: state ("q\<^sub>0")
  DFA_finals :: "state set" ("F")
  DFA_delta :: "nat \<Rightarrow> state \<Rightarrow> state" ("\<delta>")

text{*

  A DFA can be used to define a regular language: if the
  DFA accepts a string, then it is in the language, 
  otherwise the string is not in the language.
  A DFA accepts a string if feeding the string into the DFA
  causes the DFA to transition to a final (i.e. accepting) state.

*}

types 
  string = "nat list"
  lang = "string set"

text{*

  The set consisting of the natural numbers up to n,
  called \textit{iota}, will be used in several places in the definitions
  and proofs. We collect some useful properties of \textit{iota} here.

*}

constdefs iota :: "nat \<Rightarrow> nat set"
  "iota n \<equiv> { i. i \<le> n }"

lemma iota_z: "iota 0 = {0}" by (simp add: iota_def)
lemma iota_s: "iota (Suc n) = insert (Suc n) (iota n)" 
  apply (simp add: iota_def) by auto
lemma not_in_iota: "Suc n \<notin> iota n" 
  apply (induct n) by (auto simp add: iota_def)
lemma iota_finite: "finite (iota n)"
  apply (induct n) by (auto simp add: iota_z iota_s)
lemma card_iota: "card (iota n) = n + 1"
  apply (induct n) using not_in_iota iota_finite
  by (auto simp add: iota_z iota_s)

text{*

  We define the predicate \textit{good-DFA} to make
  explicit some assumptions about DFAs. For example,
  we assume that the range of the transition function
  is a subset of the states of the DFA. Also, we
  assume that the states are numbered $0\ldots n-1$.

*}


constdefs good_DFA :: "DFA \<Rightarrow> bool"
  "good_DFA M \<equiv> finite (Q M) \<and> (Q M) = iota (card (Q M) - 1)
        \<and> (q\<^sub>0 M \<in> Q M) \<and> (F M \<subseteq> Q M)
        \<and> (\<forall> a. \<forall> q \<in> Q M. \<delta> M a q \<in> Q M)"

text{*

  We use semicolons for function composition, and read the
  composition from left to right (instead of the usual right to left).

*}

syntax comp_fwd :: "('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> 'c) \<Rightarrow> ('a \<Rightarrow> 'c) " (infixl ";" 70)
translations "f;g" == "g \<circ> f"

text{*

  The $\Delta$ function is the extension of the transition
  function $\delta$ to strings. This define what it means to
  feed a string into a DFA.

*}

consts ext_delta :: "DFA \<Rightarrow> string \<Rightarrow> state \<Rightarrow> state" ("\<Delta>")
primrec
  "\<Delta> M [] = id" 
  "\<Delta> M (a#w) = \<delta> M a; \<Delta> M w"

text{*

  We can now formally define the language of a DFA as the set of strings that
  take the DFA to a final state via the extended transition function.

*}

constdefs lang_of :: "DFA \<Rightarrow> lang"
  "lang_of M \<equiv> { w. \<Delta> M w (q\<^sub>0 M) \<in> F M }"

consts strpow :: "string \<Rightarrow> nat \<Rightarrow> string" ("_\<^bsup>_\<^esup>" [80,80] 80)
primrec
  "w\<^bsup>0\<^esup> = w"
  "w\<^bsup>Suc n\<^esup> = w @ w\<^bsup>n\<^esup>"

subsection "Properties of the extended transition function"

lemma ext_delta_append:
  "\<Delta> M (x@y) = \<Delta> M x; \<Delta> M y" by (induct x, auto)

lemma ext_delta_idempotent: 
  "\<forall> M p. good_DFA M \<and> p \<in> Q M \<and> p = \<Delta> M y p \<longrightarrow> p = \<Delta> M (y\<^bsup>k\<^esup>) p"
  apply (induct k) using ext_delta_append by auto
  
lemma ext_delta_good: 
  "\<forall> M q. good_DFA M \<and> q \<in> Q M \<longrightarrow> \<Delta> M w q \<in> Q M"
  apply (induct w) by (auto simp add: good_DFA_def)


subsection "Some properties of the take and drop string functions"


lemma take_eq_take_app_drop_take: assumes ilj: "i < j" 
  shows "take j w = (take i w) @ (drop i (take j w))"
proof -
  from ilj have B: "take i (take j w) = take i w" 
    by (simp add: min_def)
  have C: "(take i (take j w)) @ (drop i (take j w)) = take j w" 
    by (simp only: append_take_drop_id)
  from B C show "take j w = take i w @ drop i (take j w)" by simp
qed

lemma w_equals_xyz: assumes ij: "i < j" and jw: "j \<le> length w"
  shows "w = (take i w) @ (drop i (take j w)) @ (drop j w)"
proof -
  have A: "(take j w) @ (drop j w) = w" by simp
  obtain t where T: "t = take j w" by simp
  from A T have X: "t @ drop j w = w" by simp
  from ij have D: "take j w = take i w @ drop i (take j w)" 
    by (rule take_eq_take_app_drop_take) 
  from D T have D2: "t = take i w @ drop i (take j w)" by simp
  from X D2 show ?thesis by simp
qed


subsection "The Pumping Lemma"

text{*

  The pumping lemma relies on the pigeonhole principle
  which is a direct consequence of a lemma concerning
  injective functions and cardinality of sets from
  Isabelle's theory of finite sets.

*}

lemma pigeonhole: 
  assumes fA: "finite A" and fB: "finite B"
  and cB: "card B < card A" and dr: "(\<forall> x \<in> A. f x \<in> B)"
  shows "\<exists> x y. x \<noteq> y \<and> x \<in> A \<and> y \<in> A \<and> f x = f y"
proof -
  from dr have iAB: "f`A \<subseteq> B" by auto
  from fB iAB have "card (f`A) \<le> card B" by (rule card_mono)
  with cB have "card (f`A) \<noteq> card A" by simp
  with fA have "\<not> inj_on f A" using inj_on_iff_eq_card by blast
  thus ?thesis by (simp add: inj_on_def, blast)
qed

constdefs steps :: "DFA \<Rightarrow> string \<Rightarrow> nat \<Rightarrow> state"
  "steps M w n \<equiv> \<Delta> M (take n w) (q\<^sub>0 M)"

text{*

  The Pumping Lemma is best described by the diagram in Figure~\ref{fig:pumping}.
  Given a string $w$ that is longer than the number of states in the DFA,
  at some point the DFA must loop back on itself and revisit 
  some state $p$ (this is by the pigeonhole principle).
  Let $x$ be the first portion of $w$ that gets
  the DFA to $p$, $y$ the next portion that gets $w$ back to $p$,
  and let $z$ be the remainder of $w$. If $w$ is in the language
  of the DFA (takes it to a final state), then so is $x y^k z$, because
  the DFA can take the $y$ loop any number of times and then proceed
  via $z$ to a final state.

\begin{figure}[htbp]
\centering
\includegraphics[height=1in]{pumping}
\caption{The Pumping Lemma}
\label{fig:pumping}
\end{figure}

*}

lemma pumping_regular: assumes g: "good_DFA M"
  shows "\<exists> n. \<forall> w. w \<in> lang_of M \<and> n \<le> length w \<longrightarrow>
         (\<exists> x y z. w = x@y@z \<and> y \<noteq> [] \<and> length (x@y) \<le> n
          \<and> (\<forall> k. x@y\<^bsup>k\<^esup>@z \<in> lang_of M))"
proof -
  let ?n = "(card (Q M))" -- "Choosing n is an important decision!"
  { fix w assume wl: "w \<in> lang_of M" and nw: "?n \<le> length w"
    from wl have wd: "\<Delta> M w (q\<^sub>0 M) \<in> F M" 
      by (simp add: lang_of_def)
    -- "Setting up to use the Pigeonhole Principle"
    let ?A = "iota (card (Q M))" 
      and ?B = "iota (card (Q M) - 1)"
    have F: "\<forall> x \<in> ?A. (steps M w) x \<in> ?B"
      using g ext_delta_good steps_def good_DFA_def by auto
    from g have C: "card ?B < card ?A" 
      using good_DFA_def card_iota by auto
    have fA: "finite ?A" using iota_finite by simp
    have fB: "finite ?B" using iota_finite by simp
    from fA fB C F obtain i j where ij: "i \<noteq> j" and iA: "i \<in> ?A" 
      and jA: "j \<in> ?A"
      and sab: "steps M w i = steps M w j" 
      using pigeonhole by blast
    -- "without loss of generality, assume i < j" 
    { fix i j assume ilj: "i < j" and iA: "i \<in> ?A" 
      and jA: "j \<in> ?A"
      and sab: "steps M w i = steps M w j" 
      obtain x y z where x: "x = take i w" 
	and y: "y = drop i (take j w)" 
	and z: "z = drop j w" by simp
      from jA nw have jlw: "j \<le> length w" 
	by (simp add: iota_def)
      from ilj jlw have w: "w = x@y@z" 
	using x y z w_equals_xyz by blast
      from jlw ilj y have ly: "length y = j - i" 
	by (simp add: min_def)
      with ilj have ynil: "y \<noteq> []" by auto
      from iA jA nw x ilj ly
      have lxyn: "length (x@y) \<le> ?n" 
	by (simp add: iota_def min_def) 
      have "\<forall> k. x@y\<^bsup>k\<^esup>@z \<in> lang_of M"
      proof
	fix k let ?p = "steps M w i"
	from g have pq: "?p \<in> Q M" 
	  using ext_delta_good steps_def good_DFA_def by simp
	from ilj x have zyp: "?p = \<Delta> M x (q\<^sub>0 M)" 
	  by (simp add: steps_def)
	from x y ilj have "take j w = x @ y" 
	  apply simp by (rule take_eq_take_app_drop_take) 
	with sab zyp have pyp: "?p = \<Delta> M y ?p" 
	  by (simp add: steps_def ext_delta_append)
	from g pq pyp have pykp: "?p = \<Delta> M (y\<^bsup>k\<^esup>) ?p" 
	  using ext_delta_idempotent by blast
	from w zyp pyp pykp
	have "\<Delta> M w (q\<^sub>0 M) = \<Delta> M (x@y\<^bsup>k\<^esup>@z) (q\<^sub>0 M)" 
	  by (simp add: ext_delta_append o_assoc) 
	with wl show "x@y\<^bsup>k\<^esup>@z \<in> lang_of M" 
	  by (simp add: lang_of_def)
      qed
      with w ynil lxyn 
      have "\<exists> x y z. w = x@y@z \<and> y \<noteq> [] 
           \<and> length (x@y) \<le> ?n \<and> (\<forall> k. x@y\<^bsup>k\<^esup>@z \<in> lang_of M)"
	by blast
    } with ij iA jA sab 
    have "\<exists> x y z. w = x@y@z \<and> y \<noteq> []
           \<and> length (x@y) \<le> ?n \<and> (\<forall> k. x@y\<^bsup>k\<^esup>@z \<in> lang_of M)"
      apply (case_tac "i < j") apply force 
      apply (case_tac "j < i") by auto
  } thus ?thesis by blast
qed

(*<*)
end
(*>*)
(*  LocalWords:  LaTeXsugar OptionalSugar Isabelle's textbf recdef primrec nat
 *)
(*  LocalWords:  consts Suc simp bool xs Õy ys Isabelle notag thm vars Un le IH
 *)
(*  LocalWords:  linorder trans msort div datatype expr Var Lam App maxv isub
 *)
(*  LocalWords:  constdefs subst fst svar sapp textit riptsize lhs simps rhs Õm
 *)
(*  LocalWords:  aka Õx allI impI se EP def AP qed tc lam typedecl adj es snd
 *)
(*  LocalWords:  adjs dfs rel inv psubset wf mem isatext isastyle iff texttt vn
 *)
(*  LocalWords:  HOL Nishihara
 *)