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

section "Inductively defined sets and a graph example"


text{*
  In this section we will explore the use of inductively 
  defined sets by modeling some basic graph theory in Isabelle.
  We start by defining a type for directed graphs.
  *}

types 'vertex digraph = "'vertex set \<times> ('vertex \<times> 'vertex) set"

text{*
  To match the notation of the CLR~\cite{Cormen:2001uq}, 
  we provide the
  @{text "V[G]"} and @{text "E[G]"} syntax for the vertex 
  and edge sets of a graph.
  *}

syntax
  vertices_ :: "'v digraph \<Rightarrow> 'v set" ("V[_]" 100)
  edges_ :: "'v digraph \<Rightarrow> 'e set"    ("E[_]" 100)
translations
  "V[G]" \<rightleftharpoons> "fst G"
  "E[G]" \<rightleftharpoons> "snd G"

subsection "Inductive definition of a path through a graph"

text{*
  When recursion is required to define a set, use the
  \textbf{inductive}
  command. Here we define the set of all paths in a directed
  graph. The introduction rules define what one must show
  to prove a path is in @{text "paths G"}. The conclusion of 
  each introduction must be of the form @{text "x \<in> paths G"}.  
  *}

inductive_set
  paths :: "'v digraph \<Rightarrow> ('v \<times> 'v list \<times> 'v) set"
  for G :: "'v digraph"
where
paths_basis: "u \<in> V[G] \<Longrightarrow> (u,[],u) \<in> paths G" |
paths_step: "\<lbrakk> (v,p,w) \<in> paths G; (u,v) \<in> E[G]; u \<in> V[G] \<rbrakk> 
  \<Longrightarrow> (u, v#p, w) \<in> paths G"

text{*
  Next we define nice syntax for writing path expressions.
*}
abbreviation
  paths2 :: "['v, 'v list, 'v, 'v digraph] \<Rightarrow> bool" ("_ \<hookrightarrow>\<^bsub>_\<^esub> _ in _" 100)
where
  "u \<hookrightarrow>\<^bsub>p\<^esub> v in G \<equiv> (u,p,v) \<in> paths G"

text{*
  Isabelle automatically creates a rule for performing
  inductive proofs over inductively defined sets. The
  generated rule \textit{paths.induct} is

\begin{equation}\notag
  @{thm [mode=Rule] paths.induct [no_vars]}
\end{equation}
  *}

text{* 
  Here is an example of performing induction on paths.
  Each inductive intro gives rise to a subgoal that must
  be proved. The parenthesis provide scoping for the
  \textbf{fix} and \textbf{assume} commands. 
  *}
lemma last_is_in_V: "u \<hookrightarrow>\<^bsub>p\<^esub> v in G \<Longrightarrow> v \<in> V[G]"
proof (induct rule: paths.induct)
  fix u assume "u \<in> V[G]" thus "u \<in> V[G]" by assumption
next
  fix p u v w assume IH: "w \<in> V[G]" 
  from IH show "w \<in> V[G]" by assumption
qed

text{*
  If you already know that a set is in paths G,
  then you know that the set must satisfy the conditions
  given by the intro rules. Isabelle will generate this 
  inverse rule for you automatically if you ask nicely 
  using the \textbf{inductive\_cases} command.
  *}

inductive_cases paths_inv:
  "(u,p,w) \<in> paths G"

text{* 
  The inverse rule is @{thm [display] paths_inv [no_vars]}
*}

lemma "(u,p,v) \<in> paths G \<Longrightarrow> u \<in> V[G]"
proof (erule paths_inv)
  assume "u \<in> V[G]" thus "u \<in> V[G]" by simp 
next
  assume "u \<in> V[G]" thus "u \<in> V[G]" by simp
qed 

subsection "The strongly connected relation is an equivalence"

text{*
  We are going to show that the strongly connected pairs 
  relation is an equivalence relation. A pair of vertices
  (u, v) are strongly connected if there is a path from 
  u to v and from v to u.
  *}
constdefs
  strongly_connected_pairs :: "'v digraph \<Rightarrow> ('v \<times> 'v) set"
  "strongly_connected_pairs G \<equiv> 
    {(u,v). \<exists>p q. (u \<hookrightarrow>\<^bsub>p\<^esub> v in G) \<and> (v \<hookrightarrow>\<^bsub>q\<^esub> u in G)}"

text{*
  The Isabelle Relation theory contains definitions for
  reflexive, symmetric, and transitive relations, which
  we use here to define an equivalence relation
  *}

constdefs
  equivalence_relation :: "['a set, ('a \<times> 'a) set] \<Rightarrow> bool"
  "equivalence_relation S R \<equiv> refl S R \<and> sym R \<and> trans R"

text{*
  To show the transitivity property
  we will need to be able to join two paths. The following
  lemma proves that the result of appending one path to
  another is a valid path. The way in which this lemma
  is stated is a bit strange so as to fit what the
  \textit{paths.induct} method is expecting.
  First, the only thing to the left of the @{text "\<Longrightarrow>"}
  is a \textit{paths} expression. Next, all other premises
  appear to the right of the @{text "\<Longrightarrow>"} but to the
  left of the @{text "\<longrightarrow>"}. The conclusion of the lemma
  appears to the right of the @{text "\<longrightarrow>"}. 
  Finally, note the use of @{text "\<forall>"}. The variables to
  the left of the @{text "\<Longrightarrow>"} are automatically
  universally quantified, but we need to make sure the
  rest of the variables are also universally quantified.
  The use of \textit{[rule-format]} tells Isabelle to
  transform the statement of the lemma (after it
  has been proved) into format that is easier to use.
  *}

lemma append_path [rule_format]:
  "a \<hookrightarrow>\<^bsub>p\<^esub> b in G \<Longrightarrow> (\<forall> q c. (b \<hookrightarrow>\<^bsub>q\<^esub> c in G) \<longrightarrow> (a \<hookrightarrow>\<^bsub>p@q\<^esub> c in G))"
proof (induct rule: paths.induct)
  fix u assume "u \<in> V[G]" 
  thus "\<forall>q c. u \<hookrightarrow>\<^bsub>q\<^esub> c in G \<longrightarrow> u \<hookrightarrow>\<^bsub>[]@q\<^esub> c in G" by simp
next
  fix p u v w
  assume vw: "v \<hookrightarrow>\<^bsub>p\<^esub> w in G" and uv_inE: "(u,v) \<in> E[G]" 
    and u_inV: "u \<in> V[G]"
    and IH: "\<forall>q c. w \<hookrightarrow>\<^bsub>q\<^esub> c in G \<longrightarrow> v \<hookrightarrow>\<^bsub>p@q\<^esub> c in G"
  show "\<forall>q c. w \<hookrightarrow>\<^bsub>q\<^esub> c in G \<longrightarrow> u \<hookrightarrow>\<^bsub>(v#p)@q\<^esub> c in G"
  proof clarify
      -- "clarify removed forall, changed single arrow to double"
    fix q r c assume wc: "w \<hookrightarrow>\<^bsub>q\<^esub> c in G"
    from wc IH have vc: "v \<hookrightarrow>\<^bsub>p@q\<^esub> c in G" by simp
    from vc uv_inE u_inV have "u \<hookrightarrow>\<^bsub>v#(p@q)\<^esub> c in G"
      by (rule paths_step)
    thus "u \<hookrightarrow>\<^bsub>(v#p)@q\<^esub> c in G" by simp
  qed
qed


text{* 
  The resulting lemma \textit{append-path} is the
  following: @{thm [display] append_path [no_vars]}
  *}

lemma strongly_connected_is_an_equivalence_relation:
  "equivalence_relation (V[G]) (strongly_connected_pairs G)"
  -- "Going into the proof, we apply the def. of equivalence"
  -- "relation and then the perform induction on the path"
proof (simp add: equivalence_relation_def, auto)
  show "refl (V[G]) (strongly_connected_pairs G)"
  proof (simp add: refl_def strongly_connected_pairs_def, auto,
    erule paths.induct) 
    fix u assume "u \<in> V[G]" thus "u \<in> V[G]" .
  next -- "next clears out any fixed variables or assumptions"
    fix u assume "u \<in> V[G]" thus "u \<in> V[G]" .
  next
    fix a p b assume "(a, p, b) \<in> paths G"
    thus "b \<in> V[G]" by (rule last_is_in_V)
  next
    fix x assume "x \<in> V[G]"
    from prems have "x \<hookrightarrow>\<^bsub>[]\<^esub> x in G" by (simp add: paths_basis)
    thus "\<exists> p. x \<hookrightarrow>\<^bsub>p\<^esub> x in G" by auto
  qed
next
  show "sym (strongly_connected_pairs G)"
  proof (simp only: sym_def strongly_connected_pairs_def, clarify)
    fix x y p q assume "x \<hookrightarrow>\<^bsub>p\<^esub> y in G" and "y \<hookrightarrow>\<^bsub>q\<^esub> x in G"
    thus "\<exists>p q. y \<hookrightarrow>\<^bsub>p\<^esub> x in G \<and> x \<hookrightarrow>\<^bsub>q\<^esub> y in G" by auto
  qed
next
  show "trans (strongly_connected_pairs G)"
  proof (simp only: trans_def strongly_connected_pairs_def, clarify, rename_tac r s)
    fix x y z p q r s
    assume xy: "x \<hookrightarrow>\<^bsub>p\<^esub> y in G" and yx: "y \<hookrightarrow>\<^bsub>q\<^esub> x in G"
      and yz: "y \<hookrightarrow>\<^bsub>r\<^esub> z in G" and zy: "z \<hookrightarrow>\<^bsub>s\<^esub> y in G"
    from xy and yz have xz: "x \<hookrightarrow>\<^bsub>p@r\<^esub> z in G" by (rule append_path)
    from zy and yx have zx: "z \<hookrightarrow>\<^bsub>s@q\<^esub> x in G" by (rule append_path)
    from xz and zx show "\<exists>p q. x \<hookrightarrow>\<^bsub>p\<^esub> z in G \<and> z \<hookrightarrow>\<^bsub>q\<^esub> x in G" by auto
  qed
qed

(*<*)
end
(*>*)