theory RelationsAndOrders_ExtBooleanAlgebra__U2E1
imports Main
begin

ML_file "$HETS_ISABELLE_LIB/prelude.ML"

setup "Header.initialize
       [\"compl_def_ExtBooleanAlgebra\",
        \"involution_compl_ExtBooleanAlgebra\", \"ga_idem___cup__\",
        \"ga_idem___cap__\", \"uniqueComplement_BooleanAlgebra\",
        \"ga_assoc___cap__\", \"ga_comm___cap__\",
        \"ga_right_unit___cap__\", \"ga_left_unit___cap__\",
        \"ga_left_comm___cap__\", \"ga_assoc___cup__\",
        \"ga_comm___cup__\", \"ga_right_unit___cup__\",
        \"ga_left_unit___cup__\", \"ga_left_comm___cup__\",
        \"absorption_def1\", \"absorption_def2\", \"zeroAndCap\",
        \"oneAndCup\", \"distr1_BooleanAlgebra\",
        \"distr2_BooleanAlgebra\", \"inverse_BooleanAlgebra\",
        \"de_Morgan1\", \"de_Morgan2\"]"

typedecl Elem

consts
X0 :: "Elem" ("0''")
X1 :: "Elem" ("1''")
X__cap__X :: "Elem => Elem => Elem" ("(_/ cap/ _)" [57,57] 56)
X__cup__X :: "Elem => Elem => Elem" ("(_/ cup/ _)" [55,55] 54)
compl__X :: "Elem => Elem" ("(compl/ _)" [62] 62)

axiomatization
where
compl_def_ExtBooleanAlgebra [rule_format] :
"ALL x. ALL y. compl x = y = (x cup y = 1' & x cap y = 0')"
and
involution_compl_ExtBooleanAlgebra [rule_format] :
"ALL x. compl compl x = x"
and
ga_idem___cup__ [rule_format] : "ALL x. x cup x = x"
and
ga_idem___cap__ [rule_format] : "ALL x. x cap x = x"
and
uniqueComplement_BooleanAlgebra [rule_format] :
"ALL x. EX! x'. x cup x' = 1' & x cap x' = 0'"
and
ga_assoc___cap__ :
"ALL x. ALL y. ALL z. (x cap y) cap z = x cap (y cap z)"
and
ga_comm___cap__ [rule_format] : "ALL x. ALL y. x cap y = y cap x"
and
ga_right_unit___cap__ [rule_format] : "ALL x. x cap 1' = x"
and
ga_left_unit___cap__ [rule_format] : "ALL x. 1' cap x = x"
and
ga_left_comm___cap__ [rule_format] :
"ALL x. ALL y. ALL z. x cap (y cap z) = y cap (x cap z)"
and
ga_assoc___cup__ :
"ALL x. ALL y. ALL z. (x cup y) cup z = x cup (y cup z)"
and
ga_comm___cup__ [rule_format] : "ALL x. ALL y. x cup y = y cup x"
and
ga_right_unit___cup__ [rule_format] : "ALL x. x cup 0' = x"
and
ga_left_unit___cup__ [rule_format] : "ALL x. 0' cup x = x"
and
ga_left_comm___cup__ [rule_format] :
"ALL x. ALL y. ALL z. x cup (y cup z) = y cup (x cup z)"
and
absorption_def1 [rule_format] : "ALL x. ALL y. x cap (x cup y) = x"
and
absorption_def2 [rule_format] : "ALL x. ALL y. x cup x cap y = x"
and
zeroAndCap [rule_format] : "ALL x. x cap 0' = 0'"
and
oneAndCup [rule_format] : "ALL x. x cup 1' = 1'"
and
distr1_BooleanAlgebra [rule_format] :
"ALL x. ALL y. ALL z. x cap (y cup z) = x cap y cup x cap z"
and
distr2_BooleanAlgebra [rule_format] :
"ALL x. ALL y. ALL z. x cup y cap z = (x cup y) cap (x cup z)"
and
inverse_BooleanAlgebra [rule_format] :
"ALL x. EX x'. x cup x' = 1' & x cap x' = 0'"

declare involution_compl_ExtBooleanAlgebra [simp]
declare ga_idem___cup__ [simp]
declare ga_idem___cap__ [simp]
declare ga_right_unit___cap__ [simp]
declare ga_left_unit___cap__ [simp]
declare ga_right_unit___cup__ [simp]
declare ga_left_unit___cup__ [simp]
declare absorption_def1 [simp]
declare absorption_def2 [simp]
declare zeroAndCap [simp]
declare oneAndCup [simp]

lemma compl_cap [simp] : "x cap (compl x) = 0'"
using compl_def_ExtBooleanAlgebra apply auto
done
lemma compl_cup [simp]: "x cup (compl x) = 1'"
using compl_def_ExtBooleanAlgebra apply auto
done

lemma compl_cap1 [simp]: "(compl x) cap x = 0'"
using compl_cap ga_comm___cap__ apply auto
done

lemma compl_cup1 [simp]: "(compl x) cup x = 1'"
using compl_cup ga_comm___cup__ apply auto
done

lemmas ga_assoc___cap__rev =
  ga_assoc___cap__[THEN spec, THEN spec, THEN spec, THEN sym]

lemmas ga_assoc___cup__rev =
  ga_assoc___cup__[THEN spec, THEN spec, THEN spec, THEN sym]

theorem de_Morgan1 :
"ALL x. ALL y. compl (x cap y) = compl x cup compl y"
apply(simp add: compl_def_ExtBooleanAlgebra)
apply((rule allI)+)
apply(rule conjI)
apply(subst ga_comm___cup__)
apply(simp add: distr2_BooleanAlgebra ga_assoc___cup__)
apply(simp add: ga_assoc___cup__rev)
apply(subst ga_comm___cup__)
apply(simp add: ga_assoc___cup__)

apply(simp add: distr1_BooleanAlgebra ga_assoc___cap__)
apply(simp add: ga_assoc___cap__rev)
apply(simp add: ga_comm___cap__)
apply(simp add: ga_assoc___cap__rev)
apply(simp add: ga_comm___cap__)
done

setup "Header.record \"de_Morgan1\""

theorem de_Morgan2 :
"ALL x. ALL y. compl (x cup y) = compl x cap compl y"
apply((rule allI)+)
apply (subst de_Morgan1[THEN spec,THEN spec, THEN sym,
  of "compl x", of "compl y", simplified])
by auto

setup "Header.record \"de_Morgan2\""

end


theory ExF008
  imports Main
begin

lemma "(\<not> (\<exists>x. \<forall>y. P x y)) \<longleftrightarrow> (\<forall>x. \<exists>y. \<not>P x y)"
proof-
  {
    assume a:"\<not> (\<exists>x. \<forall>y. P x y)"
    {
      assume b:"\<not>(\<forall>x. \<exists>y. \<not>P x y)"
      {
        fix aa
        {
          assume c:"\<not>(\<exists>y. \<not>P aa y)"
          {
            fix bb
            {
              assume "\<not>P aa bb"
              hence "\<exists>y. \<not>P aa y" by (rule exI)
              with c have False by contradiction
            }
            hence "\<not>\<not>P aa bb" by (rule notI)
            hence "P aa bb" by (rule notnotD)
          }
          hence "\<forall>y. P aa y" by (rule allI)
          hence "\<exists>x. \<forall>y. P x y" by (rule exI)
          with a have False by contradiction
        }
        hence "\<not>\<not>(\<exists>y. \<not>P aa y)" by (rule notI)
        hence "\<exists>y. \<not>P aa y" by (rule notnotD)
      }
      hence "\<forall>x. \<exists>y. \<not>P x y" by (rule allI)
      with b have False by contradiction
    }
    hence "\<not>\<not>(\<forall>x. \<exists>y. \<not>P x y)" by (rule notI)
    hence "\<forall>x. \<exists>y. \<not>P x y" by (rule notnotD)
  }
  moreover
  {
    assume a:"\<forall>x. \<exists>y. \<not>P x y"
    {
      assume b:"\<exists>x. \<forall>y. P x y"
      {
        fix aa
        assume c:"\<forall>y. P aa y"
        from a have d:"\<exists>y. \<not>P aa y" by (rule allE)
        {
          fix bb
          assume d:" \<not>P aa bb"
          from c have "P aa bb" by (rule allE)
          with d have False by contradiction
        }
        with d have False by (rule exE)
      }
      with b have False by (rule exE)
    }
    hence "\<not>(\<exists>x. \<forall>y. P x y)" by (rule notI)
  }
  ultimately show ?thesis by (rule iffI)
qed


(*
    Author:     Wenda Li <wl302@cam.ac.uk / liwenda1990@hotmail.com>
*)
theory Count_Circle imports
  Count_Half_Plane
begin

subsection \<open>Polynomial roots within a circle (open ball)\<close>

\<comment> \<open>Roots counted WITH multiplicity\<close>
definition proots_ball::"complex poly \<Rightarrow> complex \<Rightarrow> real \<Rightarrow> nat" where
  "proots_ball p z0 r = proots_count p (ball z0 r)"

\<comment> \<open>Roots counted WITHOUT multiplicity\<close>
definition proots_ball_card ::"complex poly \<Rightarrow> complex \<Rightarrow> real \<Rightarrow> nat" where
  "proots_ball_card p z0 r = card (proots_within p (ball z0 r))"

lemma proots_ball_code1[code]:
  "proots_ball p z0 r = ( if r \<le> 0 then
                              0
                          else if p\<noteq>0 then
                              proots_upper (fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:])
                          else
                              Code.abort (STR ''proots_ball fails when p=0.'')
                                (\<lambda>_. proots_ball p z0 r)
                        )"
proof (cases "p=0 \<or> r\<le>0")
  case False
  have "proots_ball p z0 r = proots_count (p \<circ>\<^sub>p [:z0, of_real r:]) (ball 0 1)"
    unfolding proots_ball_def
    apply (rule proots_uball_eq[THEN arg_cong])
    using False by auto
  also have "... = proots_upper (fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:])"
    unfolding proots_upper_def
    apply (rule proots_ball_plane_eq[THEN arg_cong])
    using False pcompose_eq_0[of p "[:z0, of_real r:]"]
    by (simp add: pcompose_eq_0)
  finally show ?thesis using False by auto
qed (auto simp:proots_ball_def ball_empty)

lemma proots_ball_card_code1[code]:
  "proots_ball_card p z0 r =
                ( if r \<le> 0 \<or> p=0 then
                      0
                 else
                    proots_upper_card (fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:])
                        )"
proof (cases "p=0 \<or> r\<le>0")
  case True
  moreover have ?thesis when "r\<le>0"
  proof -
    have "proots_within p (ball z0 r) = {}"
      by (simp add: ball_empty that)
    then show ?thesis unfolding proots_ball_card_def using that by auto
  qed
  moreover have ?thesis when "r>0" "p=0"
    unfolding proots_ball_card_def using that infinite_ball[of r z0]
    by auto
  ultimately show ?thesis by argo
next
  case False
  then have "p\<noteq>0" "r>0" by auto

  have "proots_ball_card p z0 r = card (proots_within (p \<circ>\<^sub>p [:z0, of_real r:]) (ball 0 1))"
    unfolding proots_ball_card_def
    by (rule proots_card_uball_eq[OF \<open>r>0\<close>, THEN arg_cong])
  also have "... = proots_upper_card (fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:])"
    unfolding proots_upper_card_def
    apply (rule proots_card_ball_plane_eq[THEN arg_cong])
    using False pcompose_eq_0[of p "[:z0, of_real r:]"] by (simp add: pcompose_eq_0)
  finally show ?thesis using False by auto
qed

subsection \<open>Polynomial roots on a circle (sphere)\<close>

\<comment> \<open>Roots counted WITH multiplicity\<close>
definition proots_sphere::"complex poly \<Rightarrow> complex \<Rightarrow> real \<Rightarrow> nat" where
  "proots_sphere p z0 r = proots_count p (sphere z0 r)"

\<comment> \<open>Roots counted WITHOUT multiplicity\<close>
definition proots_sphere_card ::"complex poly \<Rightarrow> complex \<Rightarrow> real \<Rightarrow> nat" where
  "proots_sphere_card p z0 r = card (proots_within p (sphere z0 r))"

lemma proots_sphere_card_code1[code]:
  "proots_sphere_card p z0 r =
                ( if r=0 then
                      (if poly p z0=0 then 1 else 0)
                  else if r < 0 \<or> p=0 then
                      0
                  else
                    (if poly p (z0-r) =0 then 1 else 0) +
                    proots_unbounded_line_card (fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:])
                      0 1
                )"
proof -
  have ?thesis when "r=0"
  proof -
    have "proots_within p {z0} = (if poly p z0 = 0 then {z0} else {})"
      by auto
    then show ?thesis unfolding proots_sphere_card_def using that by simp
  qed
  moreover have ?thesis when "r\<noteq>0" "r < 0 \<or> p=0"
  proof -
    have ?thesis when "r<0"
    proof -
      have "proots_within p (sphere z0 r) = {}"
        by (auto simp add: ball_empty that)
      then show ?thesis unfolding proots_sphere_card_def using that by auto
    qed
    moreover have ?thesis when "r>0" "p=0"
      unfolding proots_sphere_card_def using that infinite_sphere[of r z0]
      by auto
    ultimately show ?thesis using that by argo
  qed
  moreover have ?thesis when "r>0" "p\<noteq>0"
  proof -
    define pp where "pp = p \<circ>\<^sub>p [:z0, of_real r:]"
    define ppp where "ppp=fcompose pp [:\<i>, - 1:] [:\<i>, 1:]"

    have "pp\<noteq>0" unfolding pp_def using that pcompose_eq_0
      by force

    have "proots_sphere_card p z0 r = card (proots_within pp (sphere 0 1))"
      unfolding proots_sphere_card_def pp_def
      by (rule proots_card_usphere_eq[OF \<open>r>0\<close>, THEN arg_cong])
    also have "... = card (proots_within pp {-1} \<union> proots_within pp (sphere 0 1 - {-1}))"
      by (simp add: insert_absorb proots_within_union)
    also have "... = card (proots_within pp {-1}) + card (proots_within pp (sphere 0 1 - {-1}))"
      apply (rule card_Un_disjoint)
      using \<open>pp\<noteq>0\<close> by auto
    also have "... = card (proots_within pp {-1}) + card (proots_within ppp {x. 0 = Im x})"
      using proots_card_sphere_axis_eq[OF \<open>pp\<noteq>0\<close>,folded ppp_def] by simp
    also have "... = (if poly p (z0-r) =0 then 1 else 0) + proots_unbounded_line_card ppp 0 1"
    proof -
      have "proots_within pp {-1} = (if poly p (z0-r) =0 then {-1} else {})"
        unfolding pp_def by (auto simp:poly_pcompose)
      then have "card (proots_within pp {-1}) = (if poly p (z0-r) =0 then 1 else 0)"
        by auto
      moreover have "{x. Im x = 0} = unbounded_line 0 1"
        unfolding unbounded_line_def
        apply auto
        by (metis complex_is_Real_iff of_real_Re of_real_def)
      then have "card (proots_within ppp {x. 0 = Im x})
                        = proots_unbounded_line_card ppp 0 1"
        unfolding proots_unbounded_line_card_def by simp
      ultimately show ?thesis by auto
    qed
    finally show ?thesis
      apply (fold pp_def,fold ppp_def)
      using that by auto
  qed
  ultimately show ?thesis by auto
qed

subsection \<open>Polynomial roots on a closed ball\<close>

\<comment> \<open>Roots counted WITH multiplicity\<close>
definition proots_cball::"complex poly \<Rightarrow> complex \<Rightarrow> real \<Rightarrow> nat" where
  "proots_cball p z0 r = proots_count p (cball z0 r)"

\<comment> \<open>Roots counted WITHOUT multiplicity\<close>
definition proots_cball_card ::"complex poly \<Rightarrow> complex \<Rightarrow> real \<Rightarrow> nat" where
  "proots_cball_card p z0 r = card (proots_within p (cball z0 r))"

(*FIXME: this surely can be optimised/refined.*)
lemma proots_cball_card_code1[code]:
  "proots_cball_card p z0 r =
                ( if r=0 then
                      (if poly p z0=0 then 1 else 0)
                  else if r < 0 \<or> p=0 then
                      0
                  else
                    ( let pp=fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:]
                      in
                        (if poly p (z0-r) =0 then 1 else 0)
                        + proots_unbounded_line_card pp 0 1
                        + proots_upper_card pp
                    )
                )"
proof -
  have ?thesis when "r=0"
  proof -
    have "proots_within p {z0} = (if poly p z0 = 0 then {z0} else {})"
      by auto
    then show ?thesis unfolding proots_cball_card_def using that by simp
  qed
  moreover have ?thesis when "r\<noteq>0" "r < 0 \<or> p=0"
  proof -
    have ?thesis when "r<0"
    proof -
      have "proots_within p (cball z0 r) = {}"
        by (auto simp add: ball_empty that)
      then show ?thesis unfolding proots_cball_card_def using that by auto
    qed
    moreover have ?thesis when "r>0" "p=0"
      unfolding proots_cball_card_def using that infinite_cball[of r z0]
      by auto
    ultimately show ?thesis using that by argo
  qed
  moreover have ?thesis when "p\<noteq>0" "r>0"
  proof -
    define pp where "pp=fcompose (p \<circ>\<^sub>p [:z0, of_real r:]) [:\<i>,-1:] [:\<i>,1:]"

    have "proots_cball_card p z0 r = card (proots_within p (sphere z0 r)
                                        \<union> proots_within p (ball z0 r))"
      unfolding proots_cball_card_def
      apply (simp add:proots_within_union)
      by (metis Diff_partition cball_diff_sphere sphere_cball)
    also have "... = card (proots_within p (sphere z0 r)) + card (proots_within p (ball z0 r))"
      apply (rule card_Un_disjoint)
      using \<open>p\<noteq>0\<close> by auto
    also have "... = (if poly p (z0-r) =0 then 1 else 0) + proots_unbounded_line_card pp 0 1
                        + proots_upper_card pp"
      using proots_sphere_card_code1[of p z0 r,folded pp_def,unfolded proots_sphere_card_def]
        proots_ball_card_code1[of p z0 r,folded pp_def,unfolded proots_ball_card_def]
        that
      by simp
    finally show ?thesis
      apply (fold pp_def)
      using that by auto
  qed
  ultimately show ?thesis by auto
qed

end


(*<*)
theory Logic
imports LaTeXsugar
begin
(*>*)
text\<open>
\vspace{-5ex}
\section{Formulas}

The core syntax of formulas (\textit{form} below)
provides the standard logical constructs, in decreasing order of precedence:
\[
\begin{array}{rcl}

\mathit{form} & ::= &
  \<open>(form)\<close> ~\mid~
  \<^const>\<open>True\<close> ~\mid~
  \<^const>\<open>False\<close> ~\mid~
  \<^prop>\<open>term = term\<close>\\
 &\mid& \<^prop>\<open>\<not> form\<close>\index{$HOL4@\isasymnot} ~\mid~
  \<^prop>\<open>form \<and> form\<close>\index{$HOL0@\isasymand} ~\mid~
  \<^prop>\<open>form \<or> form\<close>\index{$HOL1@\isasymor} ~\mid~
  \<^prop>\<open>form \<longrightarrow> form\<close>\index{$HOL2@\isasymlongrightarrow}\\
 &\mid& \<^prop>\<open>\<forall>x. form\<close>\index{$HOL6@\isasymforall} ~\mid~  \<^prop>\<open>\<exists>x. form\<close>\index{$HOL7@\isasymexists}
\end{array}
\]
Terms are the ones we have seen all along, built from constants, variables,
function application and \<open>\<lambda>\<close>-abstraction, including all the syntactic
sugar like infix symbols, \<open>if\<close>, \<open>case\<close>, etc.
\begin{warn}
Remember that formulas are simply terms of type \<open>bool\<close>. Hence
\<open>=\<close> also works for formulas. Beware that \<open>=\<close> has a higher
precedence than the other logical operators. Hence \<^prop>\<open>s = t \<and> A\<close> means
\<open>(s = t) \<and> A\<close>, and \<^prop>\<open>A\<and>B = B\<and>A\<close> means \<open>A \<and> (B = B) \<and> A\<close>.
Logical equivalence can also be written with
\<open>\<longleftrightarrow>\<close> instead of \<open>=\<close>, where \<open>\<longleftrightarrow>\<close> has the same low
precedence as \<open>\<longrightarrow>\<close>. Hence \<open>A \<and> B \<longleftrightarrow> B \<and> A\<close> really means
\<open>(A \<and> B) \<longleftrightarrow> (B \<and> A)\<close>.
\end{warn}
\begin{warn}
Quantifiers need to be enclosed in parentheses if they are nested within
other constructs (just like \<open>if\<close>, \<open>case\<close> and \<open>let\<close>).
\end{warn}
The most frequent logical symbols and their ASCII representations are shown
in Fig.~\ref{fig:log-symbols}.
\begin{figure}
\begin{center}
\begin{tabular}{l@ {\qquad}l@ {\qquad}l}
\<open>\<forall>\<close> & \xsymbol{forall} & \texttt{ALL}\\
\<open>\<exists>\<close> & \xsymbol{exists} & \texttt{EX}\\
\<open>\<lambda>\<close> & \xsymbol{lambda} & \texttt{\%}\\
\<open>\<longrightarrow>\<close> & \texttt{-{\kern0pt}->}\\
\<open>\<longleftrightarrow>\<close> & \texttt{<->}\\
\<open>\<and>\<close> & \texttt{/\char`\\} & \texttt{\&}\\
\<open>\<or>\<close> & \texttt{\char`\\/} & \texttt{|}\\
\<open>\<not>\<close> & \xsymbol{not} & \texttt{\char`~}\\
\<open>\<noteq>\<close> & \xsymbol{noteq} & \texttt{\char`~=}
\end{tabular}
\end{center}
\caption{Logical symbols and their ASCII forms}
\label{fig:log-symbols}
\end{figure}
The first column shows the symbols, the other columns ASCII representations.
The \texttt{\char`\\}\texttt{<...>} form is always converted into the symbolic form
by the Isabelle interfaces, the treatment of the other ASCII forms
depends on the interface. The ASCII forms \texttt{/\char`\\} and
\texttt{\char`\\/}
are special in that they are merely keyboard shortcuts for the interface and
not logical symbols by themselves.
\begin{warn}
The implication \<open>\<Longrightarrow>\<close> is part of the Isabelle framework. It structures
theorems and proof states, separating assumptions from conclusions.
The implication \<open>\<longrightarrow>\<close> is part of the logic HOL and can occur inside the
formulas that make up the assumptions and conclusion.
Theorems should be of the form \<open>\<lbrakk> A\<^sub>1; \<dots>; A\<^sub>n \<rbrakk> \<Longrightarrow> A\<close>,
not \<open>A\<^sub>1 \<and> \<dots> \<and> A\<^sub>n \<longrightarrow> A\<close>. Both are logically equivalent
but the first one works better when using the theorem in further proofs.

The ASCII representation of \<open>\<lbrakk>\<close> and \<open>\<rbrakk>\<close> is \texttt{[|} and \texttt{|]}.
\end{warn}

\section{Sets}
\label{sec:Sets}

Sets of elements of type \<^typ>\<open>'a\<close> have type \<^typ>\<open>'a set\<close>\index{set@\<open>set\<close>}.
They can be finite or infinite. Sets come with the usual notation:
\begin{itemize}
\item \indexed{\<^term>\<open>{}\<close>}{$IMP042},\quad \<open>{e\<^sub>1,\<dots>,e\<^sub>n}\<close>
\item \<^prop>\<open>e \<in> A\<close>\index{$HOLSet0@\isasymin},\quad \<^prop>\<open>A \<subseteq> B\<close>\index{$HOLSet2@\isasymsubseteq}
\item \<^term>\<open>A \<union> B\<close>\index{$HOLSet4@\isasymunion},\quad \<^term>\<open>A \<inter> B\<close>\index{$HOLSet5@\isasyminter},\quad \<^term>\<open>A - B\<close>,\quad \<^term>\<open>-A\<close>
\end{itemize}
(where \<^term>\<open>A-B\<close> and \<open>-A\<close> are set difference and complement)
and much more. \<^const>\<open>UNIV\<close> is the set of all elements of some type.
Set comprehension\index{set comprehension} is written
\<^term>\<open>{x. P}\<close>\index{$IMP042@\<^term>\<open>{x. P}\<close>} rather than \<open>{x | P}\<close>.
\begin{warn}
In \<^term>\<open>{x. P}\<close> the \<open>x\<close> must be a variable. Set comprehension
involving a proper term \<open>t\<close> must be written
\noquotes{@{term[source] "{t | x y. P}"}}\index{$IMP042@\<open>{t |x. P}\<close>},
where \<open>x y\<close> are those free variables in \<open>t\<close>
that occur in \<open>P\<close>.
This is just a shorthand for \<^term>\<open>{v. \<exists>x y. v = t \<and> P}\<close>, where
\<open>v\<close> is a new variable. For example, \<^term>\<open>{x+y|x. x \<in> A}\<close>
is short for \noquotes{@{term[source]"{v. \<exists>x. v = x+y \<and> x \<in> A}"}}.
\end{warn}

Here are the ASCII representations of the mathematical symbols:
\begin{center}
\begin{tabular}{l@ {\quad}l@ {\quad}l}
\<open>\<in>\<close> & \texttt{\char`\\\char`\<in>} & \texttt{:}\\
\<open>\<subseteq>\<close> & \texttt{\char`\\\char`\<subseteq>} & \texttt{<=}\\
\<open>\<union>\<close> & \texttt{\char`\\\char`\<union>} & \texttt{Un}\\
\<open>\<inter>\<close> & \texttt{\char`\\\char`\<inter>} & \texttt{Int}
\end{tabular}
\end{center}
Sets also allow bounded quantifications \<^prop>\<open>\<forall>x \<in> A. P\<close> and
\<^prop>\<open>\<exists>x \<in> A. P\<close>.

For the more ambitious, there are also \<open>\<Union>\<close>\index{$HOLSet6@\isasymUnion}
and \<open>\<Inter>\<close>\index{$HOLSet7@\isasymInter}:
\begin{center}
@{thm Union_eq} \qquad @{thm Inter_eq}
\end{center}
The ASCII forms of \<open>\<Union>\<close> are \texttt{\char`\\\char`\<Union>} and \texttt{Union},
those of \<open>\<Inter>\<close> are \texttt{\char`\\\char`\<Inter>} and \texttt{Inter}.
There are also indexed unions and intersections:
\begin{center}
@{thm[eta_contract=false] UNION_eq} \\ @{thm[eta_contract=false] INTER_eq}
\end{center}
The ASCII forms are \ \texttt{UN x:A.~B} \ and \ \texttt{INT x:A. B} \
where \texttt{x} may occur in \texttt{B}.
If \texttt{A} is \texttt{UNIV} you can write \ \texttt{UN x.~B} \ and \ \texttt{INT x. B}.

Some other frequently useful functions on sets are the following:
\begin{center}
\begin{tabular}{l@ {\quad}l}
@{const_typ set}\index{set@\<^const>\<open>set\<close>} & converts a list to the set of its elements\\
@{const_typ finite}\index{finite@\<^const>\<open>finite\<close>} & is true iff its argument is finite\\
\noquotes{@{term[source] "card :: 'a set \<Rightarrow> nat"}}\index{card@\<^const>\<open>card\<close>} & is the cardinality of a finite set\\
 & and is \<open>0\<close> for all infinite sets\\
@{thm image_def}\index{$IMP042@\<^term>\<open>f ` A\<close>} & is the image of a function over a set
\end{tabular}
\end{center}
See \<^cite>\<open>"Nipkow-Main"\<close> for the wealth of further predefined functions in theory
\<^theory>\<open>Main\<close>.

\subsection*{Exercises}

\exercise
Start from the data type of binary trees defined earlier:
\<close>

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

text\<open>
Define a function \<open>set ::\<close> \<^typ>\<open>'a tree \<Rightarrow> 'a set\<close>
that returns the elements in a tree and a function
\<open>ord ::\<close> \<^typ>\<open>int tree \<Rightarrow> bool\<close>
that tests if an \<^typ>\<open>int tree\<close> is ordered.

Define a function \<open>ins\<close> that inserts an element into an ordered \<^typ>\<open>int tree\<close>
while maintaining the order of the tree. If the element is already in the tree, the
same tree should be returned. Prove correctness of \<open>ins\<close>:
\<^prop>\<open>set(ins x t) = {x} \<union> set t\<close> and \<^prop>\<open>ord t \<Longrightarrow> ord(ins i t)\<close>.
\endexercise

\section{Proof Automation}

So far we have only seen \<open>simp\<close> and \indexed{\<open>auto\<close>}{auto}: Both perform
rewriting, both can also prove linear arithmetic facts (no multiplication),
and \<open>auto\<close> is also able to prove simple logical or set-theoretic goals:
\<close>

lemma "\<forall>x. \<exists>y. x = y"
by auto

lemma "A \<subseteq> B \<inter> C \<Longrightarrow> A \<subseteq> B \<union> C"
by auto

text\<open>where
\begin{quote}
\isacom{by} \textit{proof-method}
\end{quote}
is short for
\begin{quote}
\isacom{apply} \textit{proof-method}\\
\isacom{done}
\end{quote}
The key characteristics of both \<open>simp\<close> and \<open>auto\<close> are
\begin{itemize}
\item They show you where they got stuck, giving you an idea how to continue.
\item They perform the obvious steps but are highly incomplete.
\end{itemize}
A proof method is \conceptnoidx{complete} if it can prove all true formulas.
There is no complete proof method for HOL, not even in theory.
Hence all our proof methods only differ in how incomplete they are.

A proof method that is still incomplete but tries harder than \<open>auto\<close> is
\indexed{\<open>fastforce\<close>}{fastforce}.  It either succeeds or fails, it acts on the first
subgoal only, and it can be modified like \<open>auto\<close>, e.g.,
with \<open>simp add\<close>. Here is a typical example of what \<open>fastforce\<close>
can do:
\<close>

lemma "\<lbrakk> \<forall>xs \<in> A. \<exists>ys. xs = ys @ ys;  us \<in> A \<rbrakk>
   \<Longrightarrow> \<exists>n. length us = n+n"
by fastforce

text\<open>This lemma is out of reach for \<open>auto\<close> because of the
quantifiers.  Even \<open>fastforce\<close> fails when the quantifier structure
becomes more complicated. In a few cases, its slow version \<open>force\<close>
succeeds where \<open>fastforce\<close> fails.

The method of choice for complex logical goals is \indexed{\<open>blast\<close>}{blast}. In the
following example, \<open>T\<close> and \<open>A\<close> are two binary predicates. It
is shown that if \<open>T\<close> is total, \<open>A\<close> is antisymmetric and \<open>T\<close> is
a subset of \<open>A\<close>, then \<open>A\<close> is a subset of \<open>T\<close>:
\<close>

lemma
  "\<lbrakk> \<forall>x y. T x y \<or> T y x;
     \<forall>x y. A x y \<and> A y x \<longrightarrow> x = y;
     \<forall>x y. T x y \<longrightarrow> A x y \<rbrakk>
   \<Longrightarrow> \<forall>x y. A x y \<longrightarrow> T x y"
by blast

text\<open>
We leave it to the reader to figure out why this lemma is true.
Method \<open>blast\<close>
\begin{itemize}
\item is (in principle) a complete proof procedure for first-order formulas,
  a fragment of HOL. In practice there is a search bound.
\item does no rewriting and knows very little about equality.
\item covers logic, sets and relations.
\item either succeeds or fails.
\end{itemize}
Because of its strength in logic and sets and its weakness in equality reasoning, it complements the earlier proof methods.

\subsection{\concept{Sledgehammer}}

Command \isacom{sledgehammer} calls a number of external automatic
theorem provers (ATPs) that run for up to 30 seconds searching for a
proof. Some of these ATPs are part of the Isabelle installation, others are
queried over the internet. If successful, a proof command is generated and can
be inserted into your proof.  The biggest win of \isacom{sledgehammer} is
that it will take into account the whole lemma library and you do not need to
feed in any lemma explicitly. For example,\<close>

lemma "\<lbrakk> xs @ ys = ys @ xs;  length xs = length ys \<rbrakk> \<Longrightarrow> xs = ys"

txt\<open>cannot be solved by any of the standard proof methods, but
\isacom{sledgehammer} finds the following proof:\<close>

by (metis append_eq_conv_conj)

text\<open>We do not explain how the proof was found but what this command
means. For a start, Isabelle does not trust external tools (and in particular
not the translations from Isabelle's logic to those tools!)
and insists on a proof that it can check. This is what \indexed{\<open>metis\<close>}{metis} does.
It is given a list of lemmas and tries to find a proof using just those lemmas
(and pure logic). In contrast to using \<open>simp\<close> and friends who know a lot of
lemmas already, using \<open>metis\<close> manually is tedious because one has
to find all the relevant lemmas first. But that is precisely what
\isacom{sledgehammer} does for us.
In this case lemma @{thm[source]append_eq_conv_conj} alone suffices:
@{thm[display] append_eq_conv_conj}
We leave it to the reader to figure out why this lemma suffices to prove
the above lemma, even without any knowledge of what the functions \<^const>\<open>take\<close>
and \<^const>\<open>drop\<close> do. Keep in mind that the variables in the two lemmas
are independent of each other, despite the same names, and that you can
substitute arbitrary values for the free variables in a lemma.

Just as for the other proof methods we have seen, there is no guarantee that
\isacom{sledgehammer} will find a proof if it exists. Nor is
\isacom{sledgehammer} superior to the other proof methods.  They are
incomparable. Therefore it is recommended to apply \<open>simp\<close> or \<open>auto\<close> before invoking \isacom{sledgehammer} on what is left.

\subsection{Arithmetic}

By arithmetic formulas we mean formulas involving variables, numbers, \<open>+\<close>, \<open>-\<close>, \<open>=\<close>, \<open><\<close>, \<open>\<le>\<close> and the usual logical
connectives \<open>\<not>\<close>, \<open>\<and>\<close>, \<open>\<or>\<close>, \<open>\<longrightarrow>\<close>,
\<open>\<longleftrightarrow>\<close>. Strictly speaking, this is known as \concept{linear arithmetic}
because it does not involve multiplication, although multiplication with
numbers, e.g., \<open>2*n\<close>, is allowed. Such formulas can be proved by
\indexed{\<open>arith\<close>}{arith}:
\<close>

lemma "\<lbrakk> (a::nat) \<le> x + b; 2*x < c \<rbrakk> \<Longrightarrow> 2*a + 1 \<le> 2*b + c"
by arith

text\<open>In fact, \<open>auto\<close> and \<open>simp\<close> can prove many linear
arithmetic formulas already, like the one above, by calling a weak but fast
version of \<open>arith\<close>. Hence it is usually not necessary to invoke
\<open>arith\<close> explicitly.

The above example involves natural numbers, but integers (type \<^typ>\<open>int\<close>)
and real numbers (type \<open>real\<close>) are supported as well. As are a number
of further operators like \<^const>\<open>min\<close> and \<^const>\<open>max\<close>. On \<^typ>\<open>nat\<close> and
\<^typ>\<open>int\<close>, \<open>arith\<close> can even prove theorems with quantifiers in them,
but we will not enlarge on that here.

\subsection{Trying Them All}

If you want to try all of the above automatic proof methods you simply type
\begin{isabelle}
\isacom{try}
\end{isabelle}
There is also a lightweight variant \isacom{try0} that does not call
sledgehammer. If desired, specific simplification and introduction rules
can be added:
\begin{isabelle}
\isacom{try0} \<open>simp: \<dots> intro: \<dots>\<close>
\end{isabelle}

\section{Single Step Proofs}

Although automation is nice, it often fails, at least initially, and you need
to find out why. When \<open>fastforce\<close> or \<open>blast\<close> simply fail, you have
no clue why. At this point, the stepwise
application of proof rules may be necessary. For example, if \<open>blast\<close>
fails on \<^prop>\<open>A \<and> B\<close>, you want to attack the two
conjuncts \<open>A\<close> and \<open>B\<close> separately. This can
be achieved by applying \emph{conjunction introduction}
\[ @{thm[mode=Rule,show_question_marks]conjI}\ \<open>conjI\<close>
\]
to the proof state. We will now examine the details of this process.

\subsection{Instantiating Unknowns}

We had briefly mentioned earlier that after proving some theorem,
Isabelle replaces all free variables \<open>x\<close> by so called \conceptidx{unknowns}{unknown}
\<open>?x\<close>. We can see this clearly in rule @{thm[source] conjI}.
These unknowns can later be instantiated explicitly or implicitly:
\begin{itemize}
\item By hand, using \indexed{\<open>of\<close>}{of}.
The expression \<open>conjI[of "a=b" "False"]\<close>
instantiates the unknowns in @{thm[source] conjI} from left to right with the
two formulas \<open>a=b\<close> and \<open>False\<close>, yielding the rule
@{thm[display,mode=Rule,margin=100]conjI[of "a=b" False]}

In general, \<open>th[of string\<^sub>1 \<dots> string\<^sub>n]\<close> instantiates
the unknowns in the theorem \<open>th\<close> from left to right with the terms
\<open>string\<^sub>1\<close> to \<open>string\<^sub>n\<close>.

\item By unification. \conceptidx{Unification}{unification} is the process of making two
terms syntactically equal by suitable instantiations of unknowns. For example,
unifying \<open>?P \<and> ?Q\<close> with \mbox{\<^prop>\<open>a=b \<and> False\<close>} instantiates
\<open>?P\<close> with \<^prop>\<open>a=b\<close> and \<open>?Q\<close> with \<^prop>\<open>False\<close>.
\end{itemize}
We need not instantiate all unknowns. If we want to skip a particular one we
can write \<open>_\<close> instead, for example \<open>conjI[of _ "False"]\<close>.
Unknowns can also be instantiated by name using \indexed{\<open>where\<close>}{where}, for example
\<open>conjI[where ?P = "a=b"\<close> \isacom{and} \<open>?Q = "False"]\<close>.

\subsection{Rule Application}

\conceptidx{Rule application}{rule application} means applying a rule backwards to a proof state.
For example, applying rule @{thm[source]conjI} to a proof state
\begin{quote}
\<open>1.  \<dots>  \<Longrightarrow> A \<and> B\<close>
\end{quote}
results in two subgoals, one for each premise of @{thm[source]conjI}:
\begin{quote}
\<open>1.  \<dots>  \<Longrightarrow> A\<close>\\
\<open>2.  \<dots>  \<Longrightarrow> B\<close>
\end{quote}
In general, the application of a rule \<open>\<lbrakk> A\<^sub>1; \<dots>; A\<^sub>n \<rbrakk> \<Longrightarrow> A\<close>
to a subgoal \mbox{\<open>\<dots> \<Longrightarrow> C\<close>} proceeds in two steps:
\begin{enumerate}
\item
Unify \<open>A\<close> and \<open>C\<close>, thus instantiating the unknowns in the rule.
\item
Replace the subgoal \<open>C\<close> with \<open>n\<close> new subgoals \<open>A\<^sub>1\<close> to \<open>A\<^sub>n\<close>.
\end{enumerate}
This is the command to apply rule \<open>xyz\<close>:
\begin{quote}
\isacom{apply}\<open>(rule xyz)\<close>\index{rule@\<open>rule\<close>}
\end{quote}
This is also called \concept{backchaining} with rule \<open>xyz\<close>.

\subsection{Introduction Rules}

Conjunction introduction (@{thm[source] conjI}) is one example of a whole
class of rules known as \conceptidx{introduction rules}{introduction rule}. They explain under which
premises some logical construct can be introduced. Here are some further
useful introduction rules:
\[
\inferrule*[right=\mbox{\<open>impI\<close>}]{\mbox{\<open>?P \<Longrightarrow> ?Q\<close>}}{\mbox{\<open>?P \<longrightarrow> ?Q\<close>}}
\qquad
\inferrule*[right=\mbox{\<open>allI\<close>}]{\mbox{\<open>\<And>x. ?P x\<close>}}{\mbox{\<open>\<forall>x. ?P x\<close>}}
\]
\[
\inferrule*[right=\mbox{\<open>iffI\<close>}]{\mbox{\<open>?P \<Longrightarrow> ?Q\<close>} \\ \mbox{\<open>?Q \<Longrightarrow> ?P\<close>}}
  {\mbox{\<open>?P = ?Q\<close>}}
\]
These rules are part of the logical system of \concept{natural deduction}
(e.g., \<^cite>\<open>HuthRyan\<close>). Although we intentionally de-emphasize the basic rules
of logic in favour of automatic proof methods that allow you to take bigger
steps, these rules are helpful in locating where and why automation fails.
When applied backwards, these rules decompose the goal:
\begin{itemize}
\item @{thm[source] conjI} and @{thm[source]iffI} split the goal into two subgoals,
\item @{thm[source] impI} moves the left-hand side of a HOL implication into the list of assumptions,
\item and @{thm[source] allI} removes a \<open>\<forall>\<close> by turning the quantified variable into a fixed local variable of the subgoal.
\end{itemize}
Isabelle knows about these and a number of other introduction rules.
The command
\begin{quote}
\isacom{apply} \<open>rule\<close>\index{rule@\<open>rule\<close>}
\end{quote}
automatically selects the appropriate rule for the current subgoal.

You can also turn your own theorems into introduction rules by giving them
the \indexed{\<open>intro\<close>}{intro} attribute, analogous to the \<open>simp\<close> attribute.  In
that case \<open>blast\<close>, \<open>fastforce\<close> and (to a limited extent) \<open>auto\<close> will automatically backchain with those theorems. The \<open>intro\<close>
attribute should be used with care because it increases the search space and
can lead to nontermination.  Sometimes it is better to use it only in
specific calls of \<open>blast\<close> and friends. For example,
@{thm[source] le_trans}, transitivity of \<open>\<le>\<close> on type \<^typ>\<open>nat\<close>,
is not an introduction rule by default because of the disastrous effect
on the search space, but can be useful in specific situations:
\<close>

lemma "\<lbrakk> (a::nat) \<le> b; b \<le> c; c \<le> d; d \<le> e \<rbrakk> \<Longrightarrow> a \<le> e"
by(blast intro: le_trans)

text\<open>
Of course this is just an example and could be proved by \<open>arith\<close>, too.

\subsection{Forward Proof}
\label{sec:forward-proof}

Forward proof means deriving new theorems from old theorems. We have already
seen a very simple form of forward proof: the \<open>of\<close> operator for
instantiating unknowns in a theorem. The big brother of \<open>of\<close> is
\indexed{\<open>OF\<close>}{OF} for applying one theorem to others. Given a theorem \<^prop>\<open>A \<Longrightarrow> B\<close> called
\<open>r\<close> and a theorem \<open>A'\<close> called \<open>r'\<close>, the theorem \<open>r[OF r']\<close> is the result of applying \<open>r\<close> to \<open>r'\<close>, where \<open>r\<close> should be viewed as a function taking a theorem \<open>A\<close> and returning
\<open>B\<close>.  More precisely, \<open>A\<close> and \<open>A'\<close> are unified, thus
instantiating the unknowns in \<open>B\<close>, and the result is the instantiated
\<open>B\<close>. Of course, unification may also fail.
\begin{warn}
Application of rules to other rules operates in the forward direction: from
the premises to the conclusion of the rule; application of rules to proof
states operates in the backward direction, from the conclusion to the
premises.
\end{warn}

In general \<open>r\<close> can be of the form \<open>\<lbrakk> A\<^sub>1; \<dots>; A\<^sub>n \<rbrakk> \<Longrightarrow> A\<close>
and there can be multiple argument theorems \<open>r\<^sub>1\<close> to \<open>r\<^sub>m\<close>
(with \<open>m \<le> n\<close>), in which case \<open>r[OF r\<^sub>1 \<dots> r\<^sub>m]\<close> is obtained
by unifying and thus proving \<open>A\<^sub>i\<close> with \<open>r\<^sub>i\<close>, \<open>i = 1\<dots>m\<close>.
Here is an example, where @{thm[source]refl} is the theorem
@{thm[show_question_marks] refl}:
\<close>

thm conjI[OF refl[of "a"] refl[of "b"]]

text\<open>yields the theorem @{thm conjI[OF refl[of "a"] refl[of "b"]]}.
The command \isacom{thm} merely displays the result.

Forward reasoning also makes sense in connection with proof states.
Therefore \<open>blast\<close>, \<open>fastforce\<close> and \<open>auto\<close> support a modifier
\<open>dest\<close> which instructs the proof method to use certain rules in a
forward fashion. If \<open>r\<close> is of the form \mbox{\<open>A \<Longrightarrow> B\<close>}, the modifier
\mbox{\<open>dest: r\<close>}\index{dest@\<open>dest:\<close>}
allows proof search to reason forward with \<open>r\<close>, i.e.,
to replace an assumption \<open>A'\<close>, where \<open>A'\<close> unifies with \<open>A\<close>,
with the correspondingly instantiated \<open>B\<close>. For example, @{thm[source,show_question_marks] Suc_leD} is the theorem \mbox{@{thm Suc_leD}}, which works well for forward reasoning:
\<close>

lemma "Suc(Suc(Suc a)) \<le> b \<Longrightarrow> a \<le> b"
by(blast dest: Suc_leD)

text\<open>In this particular example we could have backchained with
@{thm[source] Suc_leD}, too, but because the premise is more complicated than the conclusion this can easily lead to nontermination.

%\subsection{Finding Theorems}
%
%Command \isacom{find{\isacharunderscorekeyword}theorems} searches for specific theorems in the current
%theory. Search criteria include pattern matching on terms and on names.
%For details see the Isabelle/Isar Reference Manual~\<^cite>\<open>IsarRef\<close>.
%\bigskip

\begin{warn}
To ease readability we will drop the question marks
in front of unknowns from now on.
\end{warn}

\section{Inductive Definitions}
\label{sec:inductive-defs}\index{inductive definition|(}

Inductive definitions are the third important definition facility, after
datatypes and recursive function.
\ifsem
In fact, they are the key construct in the
definition of operational semantics in the second part of the book.
\fi

\subsection{An Example: Even Numbers}
\label{sec:Logic:even}

Here is a simple example of an inductively defined predicate:
\begin{itemize}
\item 0 is even
\item If $n$ is even, so is $n+2$.
\end{itemize}
The operative word ``inductive'' means that these are the only even numbers.
In Isabelle we give the two rules the names \<open>ev0\<close> and \<open>evSS\<close>
and write
\<close>

inductive ev :: "nat \<Rightarrow> bool" where
ev0:    "ev 0" |
evSS:  (*<*)"ev n \<Longrightarrow> ev (Suc(Suc n))"(*>*)
text_raw\<open>@{prop[source]"ev n \<Longrightarrow> ev (n + 2)"}\<close>

text\<open>To get used to inductive definitions, we will first prove a few
properties of \<^const>\<open>ev\<close> informally before we descend to the Isabelle level.

How do we prove that some number is even, e.g., \<^prop>\<open>ev 4\<close>? Simply by combining the defining rules for \<^const>\<open>ev\<close>:
\begin{quote}
\<open>ev 0 \<Longrightarrow> ev (0 + 2) \<Longrightarrow> ev((0 + 2) + 2) = ev 4\<close>
\end{quote}

\subsubsection{Rule Induction}\index{rule induction|(}

Showing that all even numbers have some property is more complicated.  For
example, let us prove that the inductive definition of even numbers agrees
with the following recursive one:\<close>

fun evn :: "nat \<Rightarrow> bool" where
"evn 0 = True" |
"evn (Suc 0) = False" |
"evn (Suc(Suc n)) = evn n"

text\<open>We prove \<^prop>\<open>ev m \<Longrightarrow> evn m\<close>.  That is, we
assume \<^prop>\<open>ev m\<close> and by induction on the form of its derivation
prove \<^prop>\<open>evn m\<close>. There are two cases corresponding to the two rules
for \<^const>\<open>ev\<close>:
\begin{description}
\item[Case @{thm[source]ev0}:]
 \<^prop>\<open>ev m\<close> was derived by rule \<^prop>\<open>ev 0\<close>: \\
 \<open>\<Longrightarrow>\<close> \<^prop>\<open>m=(0::nat)\<close> \<open>\<Longrightarrow>\<close> \<open>evn m = evn 0 = True\<close>
\item[Case @{thm[source]evSS}:]
 \<^prop>\<open>ev m\<close> was derived by rule \<^prop>\<open>ev n \<Longrightarrow> ev(n+2)\<close>: \\
\<open>\<Longrightarrow>\<close> \<^prop>\<open>m=n+(2::nat)\<close> and by induction hypothesis \<^prop>\<open>evn n\<close>\\
\<open>\<Longrightarrow>\<close> \<open>evn m = evn(n + 2) = evn n = True\<close>
\end{description}

What we have just seen is a special case of \concept{rule induction}.
Rule induction applies to propositions of this form
\begin{quote}
\<^prop>\<open>ev n \<Longrightarrow> P n\<close>
\end{quote}
That is, we want to prove a property \<^prop>\<open>P n\<close>
for all even \<open>n\<close>. But if we assume \<^prop>\<open>ev n\<close>, then there must be
some derivation of this assumption using the two defining rules for
\<^const>\<open>ev\<close>. That is, we must prove
\begin{description}
\item[Case @{thm[source]ev0}:] \<^prop>\<open>P(0::nat)\<close>
\item[Case @{thm[source]evSS}:] \<^prop>\<open>\<lbrakk> ev n; P n \<rbrakk> \<Longrightarrow> P(n + 2::nat)\<close>
\end{description}
The corresponding rule is called @{thm[source] ev.induct} and looks like this:
\[
\inferrule{
\mbox{@{thm (prem 1) ev.induct[of "n"]}}\\
\mbox{@{thm (prem 2) ev.induct}}\\
\mbox{\<^prop>\<open>!!n. \<lbrakk> ev n; P n \<rbrakk> \<Longrightarrow> P(n+2)\<close>}}
{\mbox{@{thm (concl) ev.induct[of "n"]}}}
\]
The first premise \<^prop>\<open>ev n\<close> enforces that this rule can only be applied
in situations where we know that \<open>n\<close> is even.

Note that in the induction step we may not just assume \<^prop>\<open>P n\<close> but also
\mbox{\<^prop>\<open>ev n\<close>}, which is simply the premise of rule @{thm[source]
evSS}.  Here is an example where the local assumption \<^prop>\<open>ev n\<close> comes in
handy: we prove \<^prop>\<open>ev m \<Longrightarrow> ev(m - 2)\<close> by induction on \<^prop>\<open>ev m\<close>.
Case @{thm[source]ev0} requires us to prove \<^prop>\<open>ev(0 - 2)\<close>, which follows
from \<^prop>\<open>ev 0\<close> because \<^prop>\<open>0 - 2 = (0::nat)\<close> on type \<^typ>\<open>nat\<close>. In
case @{thm[source]evSS} we have \mbox{\<^prop>\<open>m = n+(2::nat)\<close>} and may assume
\<^prop>\<open>ev n\<close>, which implies \<^prop>\<open>ev (m - 2)\<close> because \<open>m - 2 = (n +
2) - 2 = n\<close>. We did not need the induction hypothesis at all for this proof (it
is just a case analysis of which rule was used) but having \<^prop>\<open>ev n\<close>
at our disposal in case @{thm[source]evSS} was essential.
This case analysis of rules is also called ``rule inversion''
and is discussed in more detail in \autoref{ch:Isar}.

\subsubsection{In Isabelle}

Let us now recast the above informal proofs in Isabelle. For a start,
we use \<^const>\<open>Suc\<close> terms instead of numerals in rule @{thm[source]evSS}:
@{thm[display] evSS}
This avoids the difficulty of unifying \<open>n+2\<close> with some numeral,
which is not automatic.

The simplest way to prove \<^prop>\<open>ev(Suc(Suc(Suc(Suc 0))))\<close> is in a forward
direction: \<open>evSS[OF evSS[OF ev0]]\<close> yields the theorem @{thm evSS[OF
evSS[OF ev0]]}. Alternatively, you can also prove it as a lemma in backwards
fashion. Although this is more verbose, it allows us to demonstrate how each
rule application changes the proof state:\<close>

lemma "ev(Suc(Suc(Suc(Suc 0))))"
txt\<open>
@{subgoals[display,indent=0,goals_limit=1]}
\<close>
apply(rule evSS)
txt\<open>
@{subgoals[display,indent=0,goals_limit=1]}
\<close>
apply(rule evSS)
txt\<open>
@{subgoals[display,indent=0,goals_limit=1]}
\<close>
apply(rule ev0)
done

text\<open>\indent
Rule induction is applied by giving the induction rule explicitly via the
\<open>rule:\<close> modifier:\index{inductionrule@\<open>induction ... rule:\<close>}\<close>

lemma "ev m \<Longrightarrow> evn m"
apply(induction rule: ev.induct)
by(simp_all)

text\<open>Both cases are automatic. Note that if there are multiple assumptions
of the form \<^prop>\<open>ev t\<close>, method \<open>induction\<close> will induct on the leftmost
one.

As a bonus, we also prove the remaining direction of the equivalence of
\<^const>\<open>ev\<close> and \<^const>\<open>evn\<close>:
\<close>

lemma "evn n \<Longrightarrow> ev n"
apply(induction n rule: evn.induct)

txt\<open>This is a proof by computation induction on \<open>n\<close> (see
\autoref{sec:recursive-funs}) that sets up three subgoals corresponding to
the three equations for \<^const>\<open>evn\<close>:
@{subgoals[display,indent=0]}
The first and third subgoals follow with @{thm[source]ev0} and @{thm[source]evSS}, and the second subgoal is trivially true because \<^prop>\<open>evn(Suc 0)\<close> is \<^const>\<open>False\<close>:
\<close>

by (simp_all add: ev0 evSS)

text\<open>The rules for \<^const>\<open>ev\<close> make perfect simplification and introduction
rules because their premises are always smaller than the conclusion. It
makes sense to turn them into simplification and introduction rules
permanently, to enhance proof automation. They are named @{thm[source] ev.intros}
\index{intros@\<open>.intros\<close>} by Isabelle:\<close>

declare ev.intros[simp,intro]

text\<open>The rules of an inductive definition are not simplification rules by
default because, in contrast to recursive functions, there is no termination
requirement for inductive definitions.

\subsubsection{Inductive Versus Recursive}

We have seen two definitions of the notion of evenness, an inductive and a
recursive one. Which one is better? Much of the time, the recursive one is
more convenient: it allows us to do rewriting in the middle of terms, and it
expresses both the positive information (which numbers are even) and the
negative information (which numbers are not even) directly. An inductive
definition only expresses the positive information directly. The negative
information, for example, that \<open>1\<close> is not even, has to be proved from
it (by induction or rule inversion). On the other hand, rule induction is
tailor-made for proving \mbox{\<^prop>\<open>ev n \<Longrightarrow> P n\<close>} because it only asks you
to prove the positive cases. In the proof of \<^prop>\<open>evn n \<Longrightarrow> P n\<close> by
computation induction via @{thm[source]evn.induct}, we are also presented
with the trivial negative cases. If you want the convenience of both
rewriting and rule induction, you can make two definitions and show their
equivalence (as above) or make one definition and prove additional properties
from it, for example rule induction from computation induction.

But many concepts do not admit a recursive definition at all because there is
no datatype for the recursion (for example, the transitive closure of a
relation), or the recursion would not terminate (for example,
an interpreter for a programming language). Even if there is a recursive
definition, if we are only interested in the positive information, the
inductive definition may be much simpler.

\subsection{The Reflexive Transitive Closure}
\label{sec:star}

Evenness is really more conveniently expressed recursively than inductively.
As a second and very typical example of an inductive definition we define the
reflexive transitive closure.
\ifsem
It will also be an important building block for
some of the semantics considered in the second part of the book.
\fi

The reflexive transitive closure, called \<open>star\<close> below, is a function
that maps a binary predicate to another binary predicate: if \<open>r\<close> is of
type \<open>\<tau> \<Rightarrow> \<tau> \<Rightarrow> bool\<close> then \<^term>\<open>star r\<close> is again of type \<open>\<tau> \<Rightarrow>
\<tau> \<Rightarrow> bool\<close>, and \<^prop>\<open>star r x y\<close> means that \<open>x\<close> and \<open>y\<close> are in
the relation \<^term>\<open>star r\<close>. Think \<^term>\<open>r\<^sup>*\<close> when you see \<^term>\<open>star
r\<close>, because \<open>star r\<close> is meant to be the reflexive transitive closure.
That is, \<^prop>\<open>star r x y\<close> is meant to be true if from \<open>x\<close> we can
reach \<open>y\<close> in finitely many \<open>r\<close> steps. This concept is naturally
defined inductively:\<close>

inductive star :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"  for r where
refl:  "star r x x" |
step:  "r x y \<Longrightarrow> star r y z \<Longrightarrow> star r x z"

text\<open>The base case @{thm[source] refl} is reflexivity: \<^term>\<open>x=y\<close>. The
step case @{thm[source]step} combines an \<open>r\<close> step (from \<open>x\<close> to
\<open>y\<close>) and a \<^term>\<open>star r\<close> step (from \<open>y\<close> to \<open>z\<close>) into a
\<^term>\<open>star r\<close> step (from \<open>x\<close> to \<open>z\<close>).
The ``\isacom{for}~\<open>r\<close>'' in the header is merely a hint to Isabelle
that \<open>r\<close> is a fixed parameter of \<^const>\<open>star\<close>, in contrast to the
further parameters of \<^const>\<open>star\<close>, which change. As a result, Isabelle
generates a simpler induction rule.

By definition \<^term>\<open>star r\<close> is reflexive. It is also transitive, but we
need rule induction to prove that:\<close>

lemma star_trans: "star r x y \<Longrightarrow> star r y z \<Longrightarrow> star r x z"
apply(induction rule: star.induct)
(*<*)
defer
apply(rename_tac u x y)
defer
(*>*)
txt\<open>The induction is over \<^prop>\<open>star r x y\<close> (the first matching assumption)
and we try to prove \mbox{\<^prop>\<open>star r y z \<Longrightarrow> star r x z\<close>},
which we abbreviate by \<^prop>\<open>P x y\<close>. These are our two subgoals:
@{subgoals[display,indent=0]}
The first one is \<^prop>\<open>P x x\<close>, the result of case @{thm[source]refl},
and it is trivial:\index{assumption@\<open>assumption\<close>}
\<close>
apply(assumption)
txt\<open>Let us examine subgoal \<open>2\<close>, case @{thm[source] step}.
Assumptions \<^prop>\<open>r u x\<close> and \mbox{\<^prop>\<open>star r x y\<close>}
are the premises of rule @{thm[source]step}.
Assumption \<^prop>\<open>star r y z \<Longrightarrow> star r x z\<close> is \mbox{\<^prop>\<open>P x y\<close>},
the IH coming from \<^prop>\<open>star r x y\<close>. We have to prove \<^prop>\<open>P u y\<close>,
which we do by assuming \<^prop>\<open>star r y z\<close> and proving \<^prop>\<open>star r u z\<close>.
The proof itself is straightforward: from \mbox{\<^prop>\<open>star r y z\<close>} the IH
leads to \<^prop>\<open>star r x z\<close> which, together with \<^prop>\<open>r u x\<close>,
leads to \mbox{\<^prop>\<open>star r u z\<close>} via rule @{thm[source]step}:
\<close>
apply(metis step)
done

text\<open>\index{rule induction|)}

\subsection{The General Case}

Inductive definitions have approximately the following general form:
\begin{quote}
\isacom{inductive} \<open>I :: "\<tau> \<Rightarrow> bool"\<close> \isacom{where}
\end{quote}
followed by a sequence of (possibly named) rules of the form
\begin{quote}
\<open>\<lbrakk> I a\<^sub>1; \<dots>; I a\<^sub>n \<rbrakk> \<Longrightarrow> I a\<close>
\end{quote}
separated by \<open>|\<close>. As usual, \<open>n\<close> can be 0.
The corresponding rule induction principle
\<open>I.induct\<close> applies to propositions of the form
\begin{quote}
\<^prop>\<open>I x \<Longrightarrow> P x\<close>
\end{quote}
where \<open>P\<close> may itself be a chain of implications.
\begin{warn}
Rule induction is always on the leftmost premise of the goal.
Hence \<open>I x\<close> must be the first premise.
\end{warn}
Proving \<^prop>\<open>I x \<Longrightarrow> P x\<close> by rule induction means proving
for every rule of \<open>I\<close> that \<open>P\<close> is invariant:
\begin{quote}
\<open>\<lbrakk> I a\<^sub>1; P a\<^sub>1; \<dots>; I a\<^sub>n; P a\<^sub>n \<rbrakk> \<Longrightarrow> P a\<close>
\end{quote}

The above format for inductive definitions is simplified in a number of
respects. \<open>I\<close> can have any number of arguments and each rule can have
additional premises not involving \<open>I\<close>, so-called \conceptidx{side
conditions}{side condition}. In rule inductions, these side conditions appear as additional
assumptions. The \isacom{for} clause seen in the definition of the reflexive
transitive closure simplifies the induction rule.
\index{inductive definition|)}

\subsection*{Exercises}

\begin{exercise}
Formalize the following definition of palindromes
\begin{itemize}
\item The empty list and a singleton list are palindromes.
\item If \<open>xs\<close> is a palindrome, so is \<^term>\<open>a # xs @ [a]\<close>.
\end{itemize}
as an inductive predicate \<open>palindrome ::\<close> \<^typ>\<open>'a list \<Rightarrow> bool\<close>
and prove that \<^prop>\<open>rev xs = xs\<close> if \<open>xs\<close> is a palindrome.
\end{exercise}

\exercise
We could also have defined \<^const>\<open>star\<close> as follows:
\<close>

inductive star' :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool" for r where
refl': "star' r x x" |
step': "star' r x y \<Longrightarrow> r y z \<Longrightarrow> star' r x z"

text\<open>
The single \<open>r\<close> step is performed after rather than before the \<open>star'\<close>
steps. Prove \<^prop>\<open>star' r x y \<Longrightarrow> star r x y\<close> and
\<^prop>\<open>star r x y \<Longrightarrow> star' r x y\<close>. You may need lemmas.
Note that rule induction fails
if the assumption about the inductive predicate is not the first assumption.
\endexercise

\begin{exercise}\label{exe:iter}
Analogous to \<^const>\<open>star\<close>, give an inductive definition of the \<open>n\<close>-fold iteration
of a relation \<open>r\<close>: \<^term>\<open>iter r n x y\<close> should hold if there are \<open>x\<^sub>0\<close>, \dots, \<open>x\<^sub>n\<close>
such that \<^prop>\<open>x = x\<^sub>0\<close>, \<^prop>\<open>x\<^sub>n = y\<close> and \<open>r x\<^bsub>i\<^esub> x\<^bsub>i+1\<^esub>\<close> for
all \<^prop>\<open>i < n\<close>. Correct and prove the following claim:
\<^prop>\<open>star r x y \<Longrightarrow> iter r n x y\<close>.
\end{exercise}

\begin{exercise}\label{exe:cfg}
A context-free grammar can be seen as an inductive definition where each
nonterminal $A$ is an inductively defined predicate on lists of terminal
symbols: $A(w)$ means that $w$ is in the language generated by $A$.
For example, the production $S \to a S b$ can be viewed as the implication
\<^prop>\<open>S w \<Longrightarrow> S (a # w @ [b])\<close> where \<open>a\<close> and \<open>b\<close> are terminal symbols,
i.e., elements of some alphabet. The alphabet can be defined like this:
\isacom{datatype} \<open>alpha = a | b | \<dots>\<close>

Define the two grammars (where $\varepsilon$ is the empty word)
\[
\begin{array}{r@ {\quad}c@ {\quad}l}
S &\to& \varepsilon \quad\mid\quad aSb \quad\mid\quad SS \\
T &\to& \varepsilon \quad\mid\quad TaTb
\end{array}
\]
as two inductive predicates.
If you think of \<open>a\<close> and \<open>b\<close> as ``\<open>(\<close>'' and  ``\<open>)\<close>'',
the grammar defines strings of balanced parentheses.
Prove \<^prop>\<open>T w \<Longrightarrow> S w\<close> and \mbox{\<^prop>\<open>S w \<Longrightarrow> T w\<close>} separately and conclude
\<^prop>\<open>S w = T w\<close>.
\end{exercise}

\ifsem
\begin{exercise}
In \autoref{sec:AExp} we defined a recursive evaluation function
\<open>aval :: aexp \<Rightarrow> state \<Rightarrow> val\<close>.
Define an inductive evaluation predicate
\<open>aval_rel :: aexp \<Rightarrow> state \<Rightarrow> val \<Rightarrow> bool\<close>
and prove that it agrees with the recursive function:
\<^prop>\<open>aval_rel a s v \<Longrightarrow> aval a s = v\<close>,
\<^prop>\<open>aval a s = v \<Longrightarrow> aval_rel a s v\<close> and thus
\noquotes{@{prop [source] "aval_rel a s v \<longleftrightarrow> aval a s = v"}}.
\end{exercise}

\begin{exercise}
Consider the stack machine from Chapter~3
and recall the concept of \concept{stack underflow}
from Exercise~\ref{exe:stack-underflow}.
Define an inductive predicate
\<open>ok :: nat \<Rightarrow> instr list \<Rightarrow> nat \<Rightarrow> bool\<close>
such that \<open>ok n is n'\<close> means that with any initial stack of length
\<open>n\<close> the instructions \<open>is\<close> can be executed
without stack underflow and that the final stack has length \<open>n'\<close>.
Prove that \<open>ok\<close> correctly computes the final stack size
@{prop[display] "\<lbrakk>ok n is n'; length stk = n\<rbrakk> \<Longrightarrow> length (exec is s stk) = n'"}
and that instruction sequences generated by \<open>comp\<close>
cannot cause stack underflow: \ \<open>ok n (comp a) ?\<close> \ for
some suitable value of \<open>?\<close>.
\end{exercise}
\fi
\<close>
(*<*)
end
(*>*)


theory RegEx
  imports Regular
begin

section "Regular Expressions"

datatype 'a::linorder regex = None  | Const "'a word"
  | Union "'a regex" "'a regex" (infixr "\<squnion>" 65)
  | Concat "'a regex" "'a regex"  (infixr "\<odot>" 65)
  | Star "'a regex"  ("_\<^sup>\<star>")
  | Inter "'a regex" "'a regex" (infixr "\<sqinter>" 65)
  | Any ("?")
  | Comp "'a regex" ("\<inverse>")
  | Diff "'a regex" "'a regex" ("\\")
  | Range "'a" "'a" ("[__]")

primrec lang:: "'a::linorder regex \<Rightarrow> 'a word set"  where
  "lang None = {}"|
  "lang Any = {w. (length w) = 1}" |
  "lang (Const w) = {w}" |
  "lang (Union r1 r2) = (lang r1) Un (lang r2)" |
  "lang (Concat r1 r2) = concat (lang r1) (lang r2)"|
  "lang (Star r) = star (lang r)" |
  "lang (Range l u) = {(v#\<epsilon>)|v. l \<le> v \<and> v \<le> u}"|
  "lang (Inter r1 r2) = (lang r1) \<inter> (lang r2)"|
  "lang (Comp r) = -(lang r)"|
  "lang (Diff r1 r2) = (lang r1) - (lang r2)"

lemma star_any_is_univ: "w \<in> lang (Star Any)"
  by (metis lang.simps(2) lang.simps(6) singleton_set star_of_singletons_is_univ)

section "Construction functions that perform simple normalisation"

fun re_union::"'a::linorder regex \<Rightarrow> 'a regex \<Rightarrow> 'a regex" where
  "re_union r None = r"|
  "re_union None r = r"|
  "re_union (Const a) (Const b) = (if a = b then (Const a) else (Union (Const a) (Const b)))"|
  "re_union r e = Union r e"

lemma re_union_correct:"(lang (re_union r e)) = (lang (Union r e))"
  by (cases \<open>(r, e)\<close> rule: re_union.cases) auto

fun re_concat:: "'a::linorder regex \<Rightarrow> 'a regex \<Rightarrow> 'a regex" where
  "re_concat r (Const \<epsilon>) = r"|
  "re_concat (Const \<epsilon>) r = r"|
  "re_concat None r = None"|
  "re_concat r None = None"|
  "re_concat r e = Concat r e"

lemma re_concat_correct:"(lang (re_concat r e)) = (lang (Concat r e))"
  by (cases \<open>(r, e)\<close> rule: re_concat.cases) (auto simp add: concat_def)

fun re_star:: "'a::linorder regex \<Rightarrow> 'a regex" where
  "re_star (Const \<epsilon>) = (Const \<epsilon>)"|
  "re_star None = (Const \<epsilon>)"|
  "re_star r = Star r"

lemma re_star_correct:"(lang (re_star r)) = (lang (Star r))"
  by (cases r rule: re_star.cases) (auto simp add: star_of_epsilon star_of_empty)

fun re_plus::"'a::linorder regex \<Rightarrow> 'a regex" where
  "re_plus r = re_concat r (re_star r)"

fun re_inter:: "'a::linorder regex \<Rightarrow> 'a::linorder regex \<Rightarrow> 'a regex" where
  "re_inter None r = None"|
  "re_inter r None = None"|
  "re_inter (Const a) (Const b) = (if a = b then (Const a) else None)"|
  "re_inter r e = Inter r e"

lemma re_inter_correct: "lang (re_inter r1 r2) = lang (Inter r1 r2)"
  by (cases \<open>(r1, r2)\<close> rule: re_inter.cases) auto

fun re_range::  "'a::linorder \<Rightarrow> 'a::linorder \<Rightarrow> 'a regex" where
  "re_range l u = (if (l < u) then (Range l u) else (if l = u then (Const (l#\<epsilon>)) else None))"

lemma re_range_correct: "lang (re_range l u) = (lang (Range l u))"
  by auto

fun re_comp:: "'a::linorder regex \<Rightarrow> 'a regex" where
  "re_comp None = Star Any"|
  "re_comp r = Comp r"

lemma re_comp_correct: "lang (re_comp r) = (lang (Comp r))"
  using star_any_is_univ by (cases r) auto

fun re_diff:: "'a::linorder regex \<Rightarrow> 'a regex \<Rightarrow> 'a regex" where
  "re_diff None _ = None"|
  "re_diff r None = r"|
  "re_diff r1 r2  = Diff r1 r2"

lemma re_diff_correct: "lang (re_diff r1 r2) = lang (Diff r1 r2)"
  by (cases \<open>(r1, r2)\<close> rule: re_diff.cases) auto

primrec re_pow::"'a::linorder regex \<Rightarrow> nat \<Rightarrow> 'a regex" where
  "re_pow r 0 = (Const \<epsilon>)"|
  "re_pow r (Suc n) = re_concat r (re_pow r n)"

fun re_loop::"'a::linorder regex \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> 'a regex" where
  "re_loop r (Suc a) 0 = None"|
  "re_loop r 0 0 = Const \<epsilon>"|
  "re_loop r a (Suc n) = (if a \<le> (Suc n) then re_union (re_pow r (Suc n)) (re_loop r a n) else None)"

lemma re_loop_iff1:
  assumes "a \<le> b"
  shows "w \<in> lang (re_loop r a b) \<longleftrightarrow> (\<exists>x. a \<le> x \<and> x \<le> b \<and> w \<in> lang (re_pow r x))"
  using assms
  apply (induct b)
  apply (auto simp add: UnE le_SucI not0_implies_Suc not_less_eq_eq re_union_correct)
  apply (metis empty_iff lang.simps(1) le_Suc_eq re_loop.elims)
  using antisym not_less_eq_eq by fastforce

lemma re_loop_None_if:"a > b \<Longrightarrow> re_loop r a b = None"
  by (cases \<open>(r, a, b)\<close> rule: re_loop.cases) auto

(* A language is nullable if it accepts the empty word*)
primrec nullable:: "'a::linorder regex \<Rightarrow> bool"
  where
    "nullable None = False" |
    "nullable Any = False" |
    "nullable (Const w) = (w = \<epsilon>)" |
    "nullable (Union r1 r2) = ((nullable r1) \<or> (nullable r2))" |
    "nullable (Inter r1 r2) = ((nullable r1) \<and> (nullable r2))"|
    "nullable (Concat r1 r2) = ((nullable r1) \<and> (nullable r2))" |
    "nullable (Star r) = True"|
    "nullable (Range _ _) = False"|
    "nullable (Comp r) = (\<not> nullable r)"|
    "nullable (Diff r1 r2) = ((nullable r1) \<and> (\<not> nullable r2))"

lemma nullability: "nullable r \<longleftrightarrow> \<epsilon> \<in> (lang r)"
  by (induct r) (auto simp add: concat_def)

(* abbreviation vu:: "'a regex \<Rightarrow> 'a regex" where "vu r \<equiv> (if (nullable r) then (Const \<epsilon>) else None)" *)

primrec vu:: "'a::linorder regex \<Rightarrow> 'a regex" where
  "vu (Const w) = (if w = \<epsilon> then (Const w) else None)" |
  "vu None = None" |
  "vu (Union r1 r2) = re_union (vu r1) (vu r2)" |
  "vu (Inter r1 r2) = re_inter (vu r1) (vu r2)" |
  "vu (Concat r1 r2) = re_concat (vu r1) (vu r2)" |
  "vu (Star r) = (Const \<epsilon>)" |
  "vu Any = None"|
  "vu (Range _ _) = None"|
  "vu (Comp r) = (if (nullable r) then None else (Const \<epsilon>))"|
  "vu (Diff r1 r2) = (if (nullable r1 \<and> \<not> nullable r2) then (Const \<epsilon>) else None)"

(* Derivatives of regular languages *)

fun rderiv :: "'a::linorder \<Rightarrow> 'a::linorder regex \<Rightarrow> 'a::linorder regex" where
  "rderiv c None = None" |
  "rderiv c Any = (Const \<epsilon>)"|
  "rderiv c (Const (a#w)) = (if a = c then (Const w) else None)" |
  "rderiv c (Const \<epsilon>) = None"|
  "rderiv c (Union r1 r2) = re_union (rderiv c r1) (rderiv c r2)" |
  "rderiv c (Inter r1 r2) = re_inter (rderiv c r1) (rderiv c r2)"|
  "rderiv c (Concat r1 r2) = (re_union (re_concat (rderiv c r1) r2)  (re_concat (vu r1) (rderiv c r2)))" |
  "rderiv c (Star r) = re_concat (rderiv c r) (re_star r)"|
  "rderiv c (Range l u) = (if (l\<le>c \<and> c \<le> u) then (Const \<epsilon>) else None)"|
  "rderiv c (Comp r) = re_comp (rderiv c r)"|
  "rderiv c (Diff r1 r2) = re_diff (rderiv c r1) (rderiv c r2)"

lemma "c > u \<Longrightarrow> rderiv c (Range l u) = None"
  by auto

lemma [simp]: "l \<le> c \<Longrightarrow> c \<le> u \<Longrightarrow> rderiv c (Range l u) = (Const \<epsilon>)"
  by auto

lemma vu_null_iff: "lang (vu r) = null (lang r)"
  unfolding Regular.null_def
  by (induct r) (simp_all add: re_union_correct re_concat_correct re_inter_correct re_star_correct
      concat_def re_diff_correct  nullability)

lemma rderiv_correct: "lang (rderiv a r) = deriv a (lang r)"
proof(induction r arbitrary: a)
  case None
  then show ?case
    by (simp add: deriv_empty)
next
  case (Const x)
  then show ?case
  proof(cases x)
    case Nil
    then show ?thesis
      by (simp add: deriv_def)
  next
    case (Cons a list)
    then show ?thesis
      by (simp add: deriv_const)
  qed
next
  case (Union r1 r2)
  then show ?case
    by (simp add: deriv_union re_union_correct)
next
  case (Concat r1 r2)
  then show ?case
    by (simp add: deriv_concat vu_null_iff re_concat_correct re_union_correct)
next
  case (Inter r1 r2)
  then show ?case
    by (auto simp add: deriv_inter re_inter_correct)
next
  case (Star r)
  then show ?case
    by (simp add: deriv_star re_star_correct re_union_correct re_concat_correct)
next
  case Any
  then show ?case
    by (auto simp add: deriv_def)
next
  case (Range l u)
  then show ?case
    by(auto simp add: deriv_def)
next
  case (Comp r)
  then show ?case
    by (auto simp add: deriv_def re_comp_correct)
next
  case (Diff r1 r2)
  then show ?case
    by (auto simp add: deriv_def re_diff_correct)
qed

primrec rderivw:: "'a::linorder word \<Rightarrow> 'a regex \<Rightarrow> 'a regex" where
  "rderivw \<epsilon> r = r" |
  "rderivw (a#u) r = rderivw u (rderiv a r)"

lemma derivw_nullable_contains:
  assumes "nullable (rderivw w r)"
  shows "w \<in> (lang r)"
  using assms
proof (induct w arbitrary: r)
  case Nil
  then show ?case
    by (auto simp add: nullability)
next
  case (Cons a w)
  then have "\<epsilon> \<in> lang (rderivw w (rderiv a r))"
    by (auto simp add: nullability)
  then have "nullable (rderivw w (rderiv a r))"
    by (simp add: nullability)
  then have "a # w \<in> lang r"
    using Cons(1) by (metis deriv_correct rderiv_correct)
  then show ?case
    by auto
qed

lemma contains_derivw_nullable:
  assumes "w \<in> (lang r)"
  shows "nullable (rderivw w r)"
  using assms
proof (induct w arbitrary: r)
  case Nil
  then show ?case
    by (auto simp add: nullability)
next
  case (Cons a w)
  have "a # w \<in> lang r"
    using Cons by (auto simp add: nullability)
  then have "\<epsilon> \<in> lang (rderivw w (rderiv a r))"
    using Cons(1) by (auto simp add: nullability deriv_correct rderiv_correct)
  then show ?case
    by (auto simp add: nullability)
qed

theorem derivative_correctness: "w \<in> (lang r) \<longleftrightarrow> nullable (rderivw w r)"
  by (auto simp add: contains_derivw_nullable derivw_nullable_contains)

end


theory Exe3p1
  imports Main
begin

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

fun set :: "'a tree \<Rightarrow> 'a set" where
"set Tip = {}" |
"set (Node l n r) = {n} \<union> set l \<union> set r"

fun ord :: "int tree \<Rightarrow> bool" where
"ord Tip = True" |
"ord (Node l n r) = (\<not>(\<exists>x. x \<in> set l \<and> x > n) \<and> \<not>(\<exists>x. x \<in> set r \<and> x < n))"

fun ins :: "int \<Rightarrow> int tree \<Rightarrow> int tree" where
"ins x Tip = Node Tip x Tip" |
"ins x (Node l n r) = (
  if x = n then (Node l n r)
           else (if x < n then (Node (ins x l) n r)
                          else (Node l n (ins x r))))"

lemma ins_correctness_1 [simp]: "set (ins x t) = {x} \<union> set t"
  apply(induction t)
   apply(auto)
  done

lemma ins_correctness_2: "ord t \<Longrightarrow> ord (ins i t)"
  apply(induction t)
   apply(auto)
  done

thm conjI

thm conjI[of "a=b" "False"]

thm conjI[OF refl[of "a"] refl[of "b"]]


section \<open>Basic automata\<close>

theory Automata
imports Main
begin

text \<open>We consider automata defined by a type @{text "'state"} (corresponding to a non-empty set)
of states, a type @{text "'act"} of actions, a type @{text "'out"} of outputs, a starting state
@{text s0}, a step function @{text step}, and an output function @{text out}.\footnote{The
Isabelle command @{text locale} opens a new context where we can fix variables and/or define
assumptions. We can use these variables and assumptions inside the context, and we can reuse
and extend the context later by referring to its name (in this case @{text "Automaton"}).
We can also @{emph \<open>instantiate\<close>} a context (using the command @{text \<open>interpretation\<close>},
or @{emph \<open>sublocale\<close>} if we are inside another context): We then have to prove that the
assumptions hold, and afterwards, we are allowed to use the definitions and theorems from
inside the context.}\<close>

locale Automaton =
  fixes s0 :: "'state"
    and step :: "'state \<Rightarrow> 'act \<Rightarrow> 'state"
    and out :: "'state \<Rightarrow> 'act \<Rightarrow> 'out"
begin

text \<open>We define @{text "run s \<alpha>"} so that it returns the state we reach when performing the
action sequence @{text \<alpha>}, beginning in the state @{text s}.\<close>

text \<open>The function @{text run} is defined recursively. In Isabelle, the empty list is denoted
as @{text "[]"}, the addition of an @{emph \<open>element\<close>} @{text a} at the beginning of a list
@{text \<alpha>} is denoted as @{text "a # \<alpha>"}, and the concatenation of two @{emph \<open>lists\<close>}
@{text \<alpha>} and @{text \<beta>} is denoted as @{text "\<alpha> @ \<beta>"}.\<close>

fun run :: "'state \<Rightarrow> 'act list \<Rightarrow> 'state" where
  "run s [] = s"
| "run s (a # \<alpha>) = run (step s a) \<alpha>"

text \<open>After writing down definitions, Isabelle allows us to prove properties of them. For example,
we can (almost\footnote{We tell Isabelle to perform induction over @{text \<alpha>}. Moreover, we
tell Isabelle to generalize the induction hypothesis to arbitrary states @{text s}, because
we need to apply the induction hypothesis not for the original @{text s}, but for the successor
state reached after performing the first action of the trace.}) automatically prove that running
the concatenation of two action sequences \<open>\<alpha>\<close> and \<open>\<beta>\<close> corresponds to running \<open>\<alpha>\<close> from the initial
state, and then running \<open>\<beta>\<close> from the final state of \<open>\<alpha>\<close>.\<close>

lemma run_append: "run s (\<alpha> @ \<beta>) = run (run s \<alpha>) \<beta>"
by (induction \<alpha> arbitrary: s) auto

text \<open>Note that free variables in lemmas are implicitly universally quantified, i.e.\ this lemma
holds @{emph \<open>for all\<close>} \<open>s\<close>, \<open>\<alpha>\<close>, and \<open>\<beta>\<close>.\<close>

end

end


(*  Title:      HOL/Cardinals/Fun_More.thy
    Author:     Andrei Popescu, TU Muenchen
    Copyright   2012

More on injections, bijections and inverses.
*)

section \<open>More on Injections, Bijections and Inverses\<close>

theory Fun_More
imports Main
begin

subsection \<open>Purely functional properties\<close>

(* unused *)
(*1*)lemma notIn_Un_bij_betw2:
assumes NIN: "b \<notin> A" and NIN': "b' \<notin> A'" and
        BIJ: "bij_betw f A A'"
shows "bij_betw f (A \<union> {b}) (A' \<union> {b'}) = (f b = b')"
proof
  assume "f b = b'"
  thus "bij_betw f (A \<union> {b}) (A' \<union> {b'})"
  using assms notIn_Un_bij_betw[of b A f A'] by auto
next
  assume *: "bij_betw f (A \<union> {b}) (A' \<union> {b'})"
  hence "f b \<in> A' \<union> {b'}"
  unfolding bij_betw_def by auto
  moreover
  {assume "f b \<in> A'"
   then obtain b1 where 1: "b1 \<in> A" and 2: "f b1 = f b" using BIJ
   by (auto simp add: bij_betw_def)
   hence "b = b1" using *
   by (auto simp add: bij_betw_def inj_on_def)
   with 1 NIN have False by auto
  }
  ultimately show "f b = b'" by blast
qed

(* unused *)
(*1*)lemma bij_betw_ball:
assumes BIJ: "bij_betw f A B"
shows "(\<forall>b \<in> B. phi b) = (\<forall>a \<in> A. phi(f a))"
using assms unfolding bij_betw_def inj_on_def by blast

(* unused *)
(*1*)lemma bij_betw_diff_singl:
assumes BIJ: "bij_betw f A A'" and IN: "a \<in> A"
shows "bij_betw f (A - {a}) (A' - {f a})"
proof-
  let ?B = "A - {a}"   let ?B' = "A' - {f a}"
  have "f a \<in> A'" using IN BIJ unfolding bij_betw_def by blast
  hence "a \<notin> ?B \<and> f a \<notin> ?B' \<and> A = ?B \<union> {a} \<and> A' = ?B' \<union> {f a}"
  using IN by blast
  thus ?thesis using notIn_Un_bij_betw3[of a ?B f ?B'] BIJ by simp
qed

subsection \<open>Properties involving finite and infinite sets\<close>

(* unused *)
(*1*)lemma bij_betw_inv_into_RIGHT:
assumes BIJ: "bij_betw f A A'" and SUB: "B' \<le> A'"
shows "f `((inv_into A f)`B') = B'"
using assms
proof(auto simp add: bij_betw_inv_into_right)
  let ?f' = "(inv_into A f)"
  fix a' assume *: "a' \<in> B'"
  hence "a' \<in> A'" using SUB by auto
  hence "a' = f (?f' a')"
  using BIJ by (auto simp add: bij_betw_inv_into_right)
  thus "a' \<in> f ` (?f' ` B')" using * by blast
qed

(* unused *)
(*1*)lemma bij_betw_inv_into_RIGHT_LEFT:
assumes BIJ: "bij_betw f A A'" and SUB: "B' \<le> A'" and
        IM: "(inv_into A f) ` B' = B"
shows "f ` B = B'"
proof-
  have "f`((inv_into A f)` B') = B'"
  using assms bij_betw_inv_into_RIGHT[of f A A' B'] by auto
  thus ?thesis using IM by auto
qed

(* unused *)
(*2*)lemma bij_betw_inv_into_twice:
assumes "bij_betw f A A'"
shows "\<forall>a \<in> A. inv_into A' (inv_into A f) a = f a"
proof
  let ?f' = "inv_into A f"   let ?f'' = "inv_into A' ?f'"
  have 1: "bij_betw ?f' A' A" using assms
  by (auto simp add: bij_betw_inv_into)
  fix a assume *: "a \<in> A"
  then obtain a' where 2: "a' \<in> A'" and 3: "?f' a' = a"
  using 1 unfolding bij_betw_def by force
  hence "?f'' a = a'"
  using * 1 3 by (auto simp add: bij_betw_inv_into_left)
  moreover have "f a = a'" using assms 2 3
  by (auto simp add: bij_betw_inv_into_right)
  ultimately show "?f'' a = f a" by simp
qed

subsection \<open>Properties involving Hilbert choice\<close>

(*1*)lemma bij_betw_inv_into_LEFT:
assumes BIJ: "bij_betw f A A'" and SUB: "B \<le> A"
shows "(inv_into A f)`(f ` B) = B"
using assms unfolding bij_betw_def using inv_into_image_cancel by force

(*1*)lemma bij_betw_inv_into_LEFT_RIGHT:
assumes BIJ: "bij_betw f A A'" and SUB: "B \<le> A" and
        IM: "f ` B = B'"
shows "(inv_into A f) ` B' = B"
using assms bij_betw_inv_into_LEFT[of f A A' B] by fast

subsection \<open>Other facts\<close>

(*3*)lemma atLeastLessThan_injective:
assumes "{0 ..< m::nat} = {0 ..< n}"
shows "m = n"
proof-
  {assume "m < n"
   hence "m \<in> {0 ..< n}" by auto
   hence "{0 ..< m} < {0 ..< n}" by auto
   hence False using assms by blast
  }
  moreover
  {assume "n < m"
   hence "n \<in> {0 ..< m}" by auto
   hence "{0 ..< n} < {0 ..< m}" by auto
   hence False using assms by blast
  }
  ultimately show ?thesis by force
qed

(*2*)lemma atLeastLessThan_injective2:
"bij_betw f {0 ..< m::nat} {0 ..< n} \<Longrightarrow> m = n"
using finite_atLeastLessThan[of m] finite_atLeastLessThan[of n]
      card_atLeastLessThan[of m] card_atLeastLessThan[of n]
      bij_betw_iff_card[of "{0 ..< m}" "{0 ..< n}"] by auto

(*2*)lemma atLeastLessThan_less_eq:
"({0..<m} \<le> {0..<n}) = ((m::nat) \<le> n)"
unfolding ivl_subset by arith

(*2*)lemma atLeastLessThan_less_eq2:
assumes "inj_on f {0..<(m::nat)} \<and> f ` {0..<m} \<le> {0..<n}"
shows "m \<le> n"
using assms
using finite_atLeastLessThan[of m] finite_atLeastLessThan[of n]
      card_atLeastLessThan[of m] card_atLeastLessThan[of n]
      card_inj_on_le[of f "{0 ..< m}" "{0 ..< n}"] by fastforce

(* unused *)
(*2*)lemma atLeastLessThan_less_eq3:
"(\<exists>f. inj_on f {0..<(m::nat)} \<and> f ` {0..<m} \<le> {0..<n}) = (m \<le> n)"
using atLeastLessThan_less_eq2
proof(auto)
  assume "m \<le> n"
  hence "inj_on id {0..<m} \<and> id ` {0..<m} \<subseteq> {0..<n}" unfolding inj_on_def by force
  thus "\<exists>f. inj_on f {0..<m} \<and> f ` {0..<m} \<subseteq> {0..<n}" by blast
qed

(* unused *)
(*3*)lemma atLeastLessThan_less:
"({0..<m} < {0..<n}) = ((m::nat) < n)"
proof-
  have "({0..<m} < {0..<n}) = ({0..<m} \<le> {0..<n} \<and> {0..<m} ~= {0..<n})"
  using subset_iff_psubset_eq by blast
  also have "\<dots> = (m \<le> n \<and> m ~= n)"
  using atLeastLessThan_less_eq atLeastLessThan_injective by blast
  also have "\<dots> = (m < n)" by auto
  finally show ?thesis .
qed

end


(*  Title:      HOL/Examples/Cantor.thy
    Author:     Makarius
*)

section \<open>Cantor's Theorem\<close>

theory Cantor
  imports MainRLT
begin

subsection \<open>Mathematical statement and proof\<close>

text \<open>
  Cantor's Theorem states that there is no surjection from
  a set to its powerset.  The proof works by diagonalization.  E.g.\ see
  \<^item> \<^url>\<open>http://mathworld.wolfram.com/CantorDiagonalMethod.html\<close>
  \<^item> \<^url>\<open>https://en.wikipedia.org/wiki/Cantor's_diagonal_argument\<close>
\<close>

theorem Cantor: "\<nexists>f :: 'a \<Rightarrow> 'a set. \<forall>A. \<exists>x. A = f x"
proof
  assume "\<exists>f :: 'a \<Rightarrow> 'a set. \<forall>A. \<exists>x. A = f x"
  then obtain f :: "'a \<Rightarrow> 'a set" where *: "\<forall>A. \<exists>x. A = f x" ..
  let ?D = "{x. x \<notin> f x}"
  from * obtain a where "?D = f a" by blast
  moreover have "a \<in> ?D \<longleftrightarrow> a \<notin> f a" by blast
  ultimately show False by blast
qed

subsection \<open>Automated proofs\<close>

text \<open>
  These automated proofs are much shorter, but lack information why and how it
  works.
\<close>

theorem "\<nexists>f :: 'a \<Rightarrow> 'a set. \<forall>A. \<exists>x. f x = A"
  by best

theorem "\<nexists>f :: 'a \<Rightarrow> 'a set. \<forall>A. \<exists>x. f x = A"
  by force

subsection \<open>Elementary version in higher-order predicate logic\<close>

text \<open>
  The subsequent formulation bypasses set notation of HOL; it uses elementary
  \<open>\<lambda>\<close>-calculus and predicate logic, with standard introduction and elimination
  rules. This also shows that the proof does not require classical reasoning.
\<close>

lemma iff_contradiction:
  assumes *: "\<not> A \<longleftrightarrow> A"
  shows False
proof (rule notE)
  show "\<not> A"
  proof
    assume A
    with * have "\<not> A" ..
    from this and \<open>A\<close> show False ..
  qed
  with * show A ..
qed

theorem Cantor': "\<nexists>f :: 'a \<Rightarrow> 'a \<Rightarrow> bool. \<forall>A. \<exists>x. A = f x"
proof
  assume "\<exists>f :: 'a \<Rightarrow> 'a \<Rightarrow> bool. \<forall>A. \<exists>x. A = f x"
  then obtain f :: "'a \<Rightarrow> 'a \<Rightarrow> bool" where *: "\<forall>A. \<exists>x. A = f x" ..
  let ?D = "\<lambda>x. \<not> f x x"
  from * have "\<exists>x. ?D = f x" ..
  then obtain a where "?D = f a" ..
  then have "?D a \<longleftrightarrow> f a a" by (rule arg_cong)
  then have "\<not> f a a \<longleftrightarrow> f a a" .
  then show False by (rule iff_contradiction)
qed

subsection \<open>Classic Isabelle/HOL example\<close>

text \<open>
  The following treatment of Cantor's Theorem follows the classic example from
  the early 1990s, e.g.\ see the file \<^verbatim>\<open>92/HOL/ex/set.ML\<close> in
  Isabelle92 or @{cite \<open>\S18.7\<close> "paulson-isa-book"}. The old tactic scripts
  synthesize key information of the proof by refinement of schematic goal
  states. In contrast, the Isar proof needs to say explicitly what is proven.

  \<^bigskip>
  Cantor's Theorem states that every set has more subsets than it has
  elements. It has become a favourite basic example in pure higher-order logic
  since it is so easily expressed:

  @{text [display]
  \<open>\<forall>f::\<alpha> \<Rightarrow> \<alpha> \<Rightarrow> bool. \<exists>S::\<alpha> \<Rightarrow> bool. \<forall>x::\<alpha>. f x \<noteq> S\<close>}

  Viewing types as sets, \<open>\<alpha> \<Rightarrow> bool\<close> represents the powerset of \<open>\<alpha>\<close>. This
  version of the theorem states that for every function from \<open>\<alpha>\<close> to its
  powerset, some subset is outside its range. The Isabelle/Isar proofs below
  uses HOL's set theory, with the type \<open>\<alpha> set\<close> and the operator \<open>range :: (\<alpha> \<Rightarrow>
  \<beta>) \<Rightarrow> \<beta> set\<close>.
\<close>

theorem "\<exists>S. S \<notin> range (f :: 'a \<Rightarrow> 'a set)"
proof
  let ?S = "{x. x \<notin> f x}"
  show "?S \<notin> range f"
  proof
    assume "?S \<in> range f"
    then obtain y where "?S = f y" ..
    then show False
    proof (rule equalityCE)
      assume "y \<in> f y"
      assume "y \<in> ?S"
      then have "y \<notin> f y" ..
      with \<open>y \<in> f y\<close> show ?thesis by contradiction
    next
      assume "y \<notin> ?S"
      assume "y \<notin> f y"
      then have "y \<in> ?S" ..
      with \<open>y \<notin> ?S\<close> show ?thesis by contradiction
    qed
  qed
qed

text \<open>
  How much creativity is required? As it happens, Isabelle can prove this
  theorem automatically using best-first search. Depth-first search would
  diverge, but best-first search successfully navigates through the large
  search space. The context of Isabelle's classical prover contains rules for
  the relevant constructs of HOL's set theory.
\<close>

theorem "\<exists>S. S \<notin> range (f :: 'a \<Rightarrow> 'a set)"
  by best

end


theory unique
  imports Main
  "~~/src/HOL/Library/Code_Target_Nat"
  (* "~~/src/HOL/Library/Fset" *)
  "~~/src/HOL/Library/Finite_Set"
begin

section \<open>define unique\<close>

(* unique. Takes a sequence of integers, returns the unique elements of that
list. There is no requirement on the ordering of the returned values.

inspired by https://www.hillelwayne.com/post/theorem-prover-showdown/ *)

fun uniqueAccum :: "nat list \<Rightarrow> nat list \<Rightarrow> nat list" where
  "uniqueAccum [] accum = accum" |
  "uniqueAccum (x # xs) accum = uniqueAccum xs (List.insert x accum)"
(* note that List.insert uses set *)

fun unique :: "nat list => nat list" where
  "unique xs = uniqueAccum xs []"

(* Prove:

All elements of the original list are in the output

Every element of the output is distinct

Note from webpage author:

I specified that all elements of the original list are in the output, but not
that all elements of the output were in the original list. If the method took
in [1, 2, 2] and returned [1, 2, 99], it would still pass the partial
specification. I really dropped the ball on this one. *)

section \<open>Proofs\<close>

subsection \<open>All elements of the original list are elements of the output\<close>

(* lemma uniqueAccum_order_invariant:
  shows "a \<in> set (uniqueAccum xs ys) \<Longrightarrow> a \<in> set (uniqueAccum ys xs)"
  apply(induction xs arbitrary: ys)
   apply(induction ys)
    apply auto *)

proof(induction xs arbitrary: ys)
  case Nil
(*   hence "a \<in> set ys"
    by simp *)
  then show ?case
  proof(induction ys)
    case Nil
    then show ?case
      by simp
  next
    case (Cons y ys\<^sub>p)
    then show ?case
      apply auto
      sorry
  qed
next
  case (Cons a xs)
  then show ?case
    try
    sorry
(* qed *)  oops

lemma uniqueAccum_keeps_elements:
  shows "x \<in> set (uniqueAccum ys [])
      \<Longrightarrow> x \<in> set (uniqueAccum ys [a])"
proof(induction ys)
  case Nil
  then show ?case
    by simp
next
  case (Cons y ys\<^sub>p)

(* goal (1 subgoal):
 1. x \<in> set (uniqueAccum (y # ys\<^sub>p) [a]) *)

  (* "uniqueAccum (x # xs) accum = uniqueAccum xs (List.insert x accum)" *)
(* "insert x xs = (if x \<in> set xs then xs else x # xs)" *)

  then show ?case
    apply simp
  proof(cases "y = a")
    case True
    hence ya:"List.insert y [a] = [y]"
      by simp
    hence "x \<in> set (uniqueAccum ys\<^sub>p [y])"
      using Cons.prems by auto
    then show "x \<in> set (uniqueAccum ys\<^sub>p (List.insert y [a]))"
      by (simp add: ya)
  next
    case False
    hence "List.insert y [a] = [y, a]"
      by simp
    hence "uniqueAccum ys\<^sub>p (List.insert y [a]) = uniqueAccum ys\<^sub>p [y, a]"
      by simp
    (* have "set (uniqueAccum ys\<^sub>p [y, a]) = set ys\<^sub>p \<union> {y, a}" *)
    then show ?thesis sorry
  qed

(*   proof(cases "x = y")
    case True
    then show ?thesis sorry
  next
    case False
    hence "x \<in> ys"
      sorry
    then show ?thesis sorry
  qed *)
qed
  oops

(*     assume "x \<in> set ys"
    then show "x \<in> set (uniqueAccum ys [y])" *)

(* https://isabelle.in.tum.de/community/FAQ#There_are_lots_of_arrows_in_Isabelle.2FHOL._What.27s_the_difference_between_-.3E.2C_.3D.3E.2C_--.3E.2C_and_.3D.3D.3E_.3F *)

lemma all_elements_present:
  fixes xs :: "nat list"
  assumes "x \<in> set xs"
  shows "x \<in> set xs \<Longrightarrow> x \<in> set (unique xs)"
proof(induction xs)
  case Nil
  then show ?case
    by simp
next
  case (Cons y ys)
  then show ?case
    (* apply simp_all  *)
    apply auto
  proof -
    assume "x = y"
    then show "y \<in> set (uniqueAccum ys [y])"
      (* try *)
      sorry
  next
    assume "x \<in> set ys"
    then show "x \<in> set (uniqueAccum ys [y])"
      sorry
  qed
  oops
(*   proof(cases "x = y")
    case True

    then have "y \<in> set (uniqueAccum ys [y])"
      try
(*     then show ?thesis
      apply simp_all *)
      (* try *)
      sorry
  next
    case False
    then have "x \<in> set ys"
      using Cons.prems by auto
    then show ?thesis
      apply simp_all
      (* try *)
      sorry
  qed
  oops *)

lemma all_elements_present1:
  fixes xs :: "nat list"
  assumes "x \<in> set xs"
  shows "\<forall> x. x \<in> set xs \<Longrightarrow> x \<in> set (unique xs)"
proof(induction xs)
  case Nil
  then show ?case
    by simp
next
  case (Cons y ys)
  then show ?case
    apply simp_all
    oops

(* I think this is wrong. prog-prove.pdf says:
"The implication =\<Rightarrow> is part of the Isabelle framework..."
*)
lemma all_elements_present2:
  fixes xs :: "nat list"
  assumes "x \<in> set xs"
  shows "\<forall> x. x \<in> set xs \<longrightarrow> x \<in> set (unique xs)"
proof(induction xs)
  case Nil
  then show ?case
    by simp
next
  case (Cons y ys)
  then show ?case
   apply simp_all
    oops