chapter \<open>Inductive inference of recursive functions\label{c:iirf}\<close>

theory Inductive_Inference_Basics
  imports Standard_Results
begin

text \<open>Inductive inference originates from work by
Solomonoff~\<^cite>\<open>"s-ftiip1-64" and "s-ftiip2-64"\<close> and Gold~\<^cite>\<open>"g-lil-67" and "g-lr-65"\<close>
and comes in many variations. The common theme is to infer additional
information about objects, such as formal languages or functions, from incomplete
data, such as finitely many words contained in the language or argument-value
pairs of the function. Oftentimes ``additional information'' means complete
information, such that the task becomes identification of the object.

The basic setting in inductive inference of recursive functions is as follows.
Let us denote, for a total function $f$, by $f^n$ the code of the list
$[f(0), ..., f(n)]$. Let $U$ be a set (called \emph{class}) of total
recursive functions, and $\psi$ a binary partial recursive function
(called \emph{hypothesis space}).
A partial recursive function $S$ (called \emph{strategy})
is said to \emph{learn $U$ in the limit with respect to $\psi$} if
for all $f \in U$,
\begin{itemize}
  \item the value $S(f^n)$ is defined for all $n\in\mathbb{N}$,
  \item the sequence $S(f^0), S(f^1), \ldots$ converges to an
    $i\in\mathbb{N}$ with $\psi_i = f$.
\end{itemize}

Both the output $S(f^n)$ of the strategy and its interpretation
as a function $\psi_{S(f^n)}$ are called \emph{hypothesis}. The set
of all classes learnable in the limit by $S$ with respect to $\psi$ is
denoted by $\mathrm{LIM}_\psi(S)$. Moreover we set $\mathrm{LIM}_\psi =
\bigcup_{S\in\mathcal{P}} \mathrm{LIM}_\psi(S)$ and $\mathrm{LIM} =
\bigcup_{\psi\in\mathcal{P}^2} \mathrm{LIM}_\psi$. We call the latter set the
\emph{inference type} $\mathrm{LIM}$.

Many aspects of this setting can be varied. We shall consider:
\begin{itemize}
  \item Intermediate hypotheses: $\psi_{S(f^n)}$ can be required to be total or
    to be in the class $U$, or to coincide with $f$ on arguments up to $n$, or
    a myriad of other conditions or combinations thereof.
  \item Convergence of hypotheses:
  \begin{itemize}
    \item The strategy can be required to output not a sequence but a single
      hypothesis, which must be correct.
    \item The strategy can be required to converge to a \emph{function} rather
      than an index.
  \end{itemize}
\end{itemize}

We formalize five kinds of results (\<open>\<I>\<close> and \<open>\<I>'\<close> stand for
inference types):
\begin{itemize}
  \item Comparison of learning power: results of the form @{prop "\<I>
    \<subset> \<I>'"}, in particular showing that the inclusion is proper
    (Sections~\ref{s:fin_cp}, \ref{s:num_fin}, \ref{s:num_cp},
    \ref{s:num_total}, \ref{s:cons_lim}, \ref{s:lim_bc}, \ref{s:total_cons},
    \ref{s:r1_bc}).
  \item Whether \<open>\<I>\<close> is closed under the subset relation: @{prop "U
    \<in> \<I> \<and> V \<subseteq> U \<Longrightarrow> V \<in> \<I>"}.
  \item Whether \<open>\<I>\<close> is closed under union: @{prop "U \<in> \<I> \<and>
    V \<in> \<I> \<Longrightarrow> U \<union> V \<in> \<I>"} (Section~\ref{s:union}).
  \item Whether every class in \<open>\<I>\<close> can be learned with respect to a
    Gödel numbering as hypothesis space (Section~\ref{s:inference_types}).
  \item Whether every class in \<open>\<I>\<close> can be learned by a \emph{total}
    recursive strategy (Section~\ref{s:lemma_r}).
\end{itemize}

The bulk of this chapter is devoted to the first category of results. Most
results that we are going to formalize have been called ``classical'' by
Jantke and Beick~\<^cite>\<open>"jb-cpnii-81"\<close>, who compare a large number of inference
types. Another comparison is by Case and Smith~\<^cite>\<open>"cs-cicmii-83"\<close>. Angluin
and Smith~\<^cite>\<open>"as-ii-87"\<close> give an overview of various forms of inductive
inference.

All (interesting) proofs herein are based on my lecture notes of the
\emph{Induktive Inferenz} lectures by Rolf Wiehagen from 1999/2000 and
2000/2001 at the University of Kaiserslautern. I have given references to the
original proofs whenever I was able to find them. For the other proofs, as
well as for those that I had to contort beyond recognition, I provide proof
sketches.\<close>

section \<open>Preliminaries\<close>

text \<open>Throughout the chapter, in particular in proof sketches, we use
the following notation.

Let $b\in\mathbb{N}^*$ be a list of numbers. We write $|b|$ for its length
and $b_i$ for the $i$-th element ($i=0,\dots, |b| - 1$). Concatenation of
numbers and lists works in the obvious way; for instance, $jbk$ with
$j,k\in\mathbb{N}$, $b\in\mathbb{N}^*$ refers to the list $jb_0\dots
b_{|b|-1}k$. For $0 \leq i < |b|$, the term $b_{i:=v}$ denotes the list
$b_0\dots b_{i-1}vb_{i+1}\dots b_{|b|-1}$. The notation $b_{<i}$ refers to
$b_0\dots b_{i-1}$ for $0 < i \leq |b|$. Moreover, $v^n$ is short for the
list consisting of $n$ times the value $v \in \mathbb{N}$.

Unary partial functions can be regarded as infinite sequences consisting of
numbers and the symbol~$\uparrow$ denoting undefinedness. We abbreviate the
empty function by $\uparrow^\infty$ and the constant zero function by
$0^\infty$. A function can be written as a list concatenated with a partial
function. For example, $jb\uparrow^\infty$ is the function
\[
x \mapsto \left\{\begin{array}{ll}
  j        & \mbox{if } x = 0,\\
  b_{x-1}  & \mbox{if } 0 < x \leq |b|,\\
  \uparrow & \mbox{otherwise,}
\end{array}\right.
\]
and $jp$, where $p$ is a function, means
\[
x \mapsto \left\{\begin{array}{ll}
  j      & \mbox{if } x = 0,\\
  p(x-1) & \mbox{otherwise.}
\end{array}\right.
\]

A \emph{numbering} is a function $\psi \in \mathcal{P}^2$.\<close>

subsection \<open>The prefixes of a function\<close>

text \<open>A \emph{prefix}, also called \emph{initial segment}, is a list of
initial values of a function.\<close>

definition prefix :: "partial1 \<Rightarrow> nat \<Rightarrow> nat list" where
  "prefix f n \<equiv> map (\<lambda>x. the (f x)) [0..<Suc n]"

lemma length_prefix [simp]: "length (prefix f n) = Suc n"
  unfolding prefix_def by simp

lemma prefix_nth [simp]:
  assumes "k < Suc n"
  shows "prefix f n ! k = the (f k)"
  unfolding prefix_def using assms nth_map_upt[of k "Suc n" 0 "\<lambda>x. the (f x)"] by simp

lemma prefixI:
  assumes "length vs > 0" and "\<And>x. x < length vs \<Longrightarrow> f x \<down>= vs ! x"
  shows "prefix f (length vs - 1) = vs"
  using assms nth_equalityI[of "prefix f (length vs - 1)" vs] by simp

lemma prefixI':
  assumes "length vs = Suc n" and "\<And>x. x < Suc n \<Longrightarrow> f x \<down>= vs ! x"
  shows "prefix f n = vs"
  using assms nth_equalityI[of "prefix f (length vs - 1)" vs] by simp

lemma prefixE:
  assumes "prefix f (length vs - 1) = vs"
    and "f \<in> \<R>"
    and "length vs > 0"
    and "x < length vs"
  shows "f x \<down>= vs ! x"
  using assms length_prefix prefix_nth[of x "length vs - 1" f] by simp

lemma prefix_eqI:
  assumes "\<And>x. x \<le> n \<Longrightarrow> f x = g x"
  shows "prefix f n = prefix g n"
  using assms prefix_def by simp

lemma prefix_0: "prefix f 0 = [the (f 0)]"
  using prefix_def by simp

lemma prefix_Suc: "prefix f (Suc n) = prefix f n @ [the (f (Suc n))]"
  unfolding prefix_def by simp

lemma take_prefix:
  assumes "f \<in> \<R>" and "k \<le> n"
  shows "prefix f k = take (Suc k) (prefix f n)"
proof -
  let ?vs = "take (Suc k) (prefix f n)"
  have "length ?vs = Suc k"
    using assms(2) by simp
  then have "\<And>x. x < length ?vs \<Longrightarrow> f x \<down>= ?vs ! x"
    using assms by auto
  then show ?thesis
    using prefixI[where ?vs="?vs"] \<open>length ?vs = Suc k\<close> by simp
qed

text \<open>Strategies receive prefixes in the form of encoded lists. The
term ``prefix'' refers to both encoded and unencoded lists. We use the
notation @{text "f \<triangleright> n"} for the prefix $f^n$.\<close>

definition init :: "partial1 \<Rightarrow> nat \<Rightarrow> nat" (infix "\<triangleright>" 110) where
  "f \<triangleright> n \<equiv> list_encode (prefix f n)"

lemma init_neq_zero: "f \<triangleright> n \<noteq> 0"
  unfolding init_def prefix_def using list_encode_0 by fastforce

lemma init_prefixE [elim]: "prefix f n = prefix g n \<Longrightarrow> f \<triangleright> n = g \<triangleright> n"
  unfolding init_def by simp

lemma init_eqI:
  assumes "\<And>x. x \<le> n \<Longrightarrow> f x = g x"
  shows "f \<triangleright> n = g \<triangleright> n"
  unfolding init_def using prefix_eqI[OF assms] by simp

lemma initI:
  assumes "e_length e > 0" and "\<And>x. x < e_length e \<Longrightarrow> f x \<down>= e_nth e x"
  shows "f \<triangleright> (e_length e - 1) = e"
  unfolding init_def using assms prefixI by simp

lemma initI':
  assumes "e_length e = Suc n" and "\<And>x. x <  Suc n \<Longrightarrow> f x \<down>= e_nth e x"
  shows "f \<triangleright> n = e"
  unfolding init_def using assms prefixI' by simp

lemma init_iff_list_eq_upto:
  assumes "f \<in> \<R>" and "e_length vs > 0"
  shows "(\<forall>x<e_length vs. f x \<down>= e_nth vs x) \<longleftrightarrow> prefix f (e_length vs - 1) = list_decode vs"
  using prefixI[OF assms(2)] prefixE[OF _ assms] by auto

lemma length_init [simp]: "e_length (f \<triangleright> n) = Suc n"
  unfolding init_def by simp

lemma init_Suc_snoc: "f \<triangleright> (Suc n) = e_snoc (f \<triangleright> n) (the (f (Suc n)))"
  unfolding init_def by (simp add: prefix_Suc)

lemma nth_init: "i < Suc n \<Longrightarrow> e_nth (f \<triangleright> n) i = the (f i)"
  unfolding init_def using prefix_nth by auto

lemma hd_init [simp]: "e_hd (f \<triangleright> n) = the (f 0)"
  unfolding init_def using init_neq_zero by (simp add: e_hd_nth0)

lemma list_decode_init [simp]: "list_decode (f \<triangleright> n) = prefix f n"
  unfolding init_def by simp

lemma init_eq_iff_eq_upto:
  assumes "g \<in> \<R>" and "f \<in> \<R>"
  shows "(\<forall>j<Suc n. g j = f j) \<longleftrightarrow> g \<triangleright> n = f \<triangleright> n"
  using assms initI' init_iff_list_eq_upto length_init list_decode_init
  by (metis diff_Suc_1 zero_less_Suc)

definition is_init_of :: "nat \<Rightarrow> partial1 \<Rightarrow> bool" where
  "is_init_of t f \<equiv> \<forall>i<e_length t. f i \<down>= e_nth t i"

lemma not_initial_imp_not_eq:
  assumes "\<And>x. x < Suc n \<Longrightarrow> f x \<down>" and "\<not> (is_init_of (f \<triangleright> n) g)"
  shows "f \<noteq> g"
  using is_init_of_def assms by auto

lemma all_init_eq_imp_fun_eq:
  assumes "f \<in> \<R>" and "g \<in> \<R>" and "\<And>n. f \<triangleright> n = g \<triangleright> n"
  shows "f = g"
proof
  fix n
  from assms have "prefix f n = prefix g n"
    by (metis init_def list_decode_encode)
  then have "the (f n) = the (g n)"
    unfolding init_def prefix_def by simp
  then show "f n = g n"
    using assms(1,2) by (meson R1_imp_total1 option.expand total1E)
qed

corollary neq_fun_neq_init:
  assumes "f \<in> \<R>" and "g \<in> \<R>" and "f \<noteq> g"
  shows "\<exists>n. f \<triangleright> n \<noteq> g \<triangleright> n"
  using assms all_init_eq_imp_fun_eq by auto

lemma eq_init_forall_le:
  assumes "f \<triangleright> n = g \<triangleright> n" and "m \<le> n"
  shows "f \<triangleright> m = g \<triangleright> m"
proof -
  from assms(1) have "prefix f n = prefix g n"
    by (metis init_def list_decode_encode)
  then have "the (f k) = the (g k)" if "k \<le> n" for k
    using prefix_def that by auto
  then have "the (f k) = the (g k)" if "k \<le> m" for k
    using assms(2) that by simp
  then have "prefix f m = prefix g m"
    using prefix_def by simp
  then show ?thesis by (simp add: init_def)
qed

corollary neq_init_forall_ge:
  assumes "f \<triangleright> n \<noteq> g \<triangleright> n" and "m \<ge> n"
  shows "f \<triangleright> m \<noteq> g \<triangleright> m"
  using eq_init_forall_le assms by blast

lemma e_take_init:
  assumes "f \<in> \<R>" and "k < Suc n"
  shows "e_take (Suc k) (f \<triangleright> n) = f \<triangleright> k"
  using assms take_prefix by (simp add: init_def less_Suc_eq_le)

lemma init_butlast_init:
  assumes "total1 f" and "f \<triangleright> n = e" and "n > 0"
  shows "f \<triangleright> (n - 1) = e_butlast e"
proof -
  let ?e = "e_butlast e"
  have "e_length e = Suc n"
    using assms(2) by auto
  then have len: "e_length ?e = n"
    by simp
  have "f \<triangleright> (e_length ?e - 1) = ?e"
  proof (rule initI)
    show "0 < e_length ?e"
      using assms(3) len by simp
    have "\<And>x. x < e_length e \<Longrightarrow> f x \<down>= e_nth e x"
      using assms(1,2) total1_def \<open>e_length e = Suc n\<close> by auto
    then show "\<And>x. x < e_length ?e \<Longrightarrow> f x \<down>= e_nth ?e x"
      by (simp add: butlast_conv_take)
  qed
  with len show ?thesis by simp
qed

text \<open>Some definitions make use of recursive predicates, that is,
$01$-valued functions.\<close>

definition RPred1 :: "partial1 set" ("\<R>\<^sub>0\<^sub>1") where
  "\<R>\<^sub>0\<^sub>1 \<equiv> {f. f \<in> \<R> \<and> (\<forall>x. f x \<down>= 0 \<or> f x \<down>= 1)}"

lemma RPred1_subseteq_R1: "\<R>\<^sub>0\<^sub>1 \<subseteq> \<R>"
  unfolding RPred1_def by auto

lemma const0_in_RPred1: "(\<lambda>_. Some 0) \<in> \<R>\<^sub>0\<^sub>1"
  using RPred1_def const_in_Prim1 by fast

lemma RPred1_altdef: "\<R>\<^sub>0\<^sub>1 = {f. f \<in> \<R> \<and> (\<forall>x. the (f x) \<le> 1)}"
  (is "\<R>\<^sub>0\<^sub>1 = ?S")
proof
  show "\<R>\<^sub>0\<^sub>1 \<subseteq> ?S"
  proof
    fix f
    assume f: "f \<in> \<R>\<^sub>0\<^sub>1"
    with RPred1_def have "f \<in> \<R>" by auto
    from f have "\<forall>x. f x \<down>= 0 \<or> f x \<down>= 1"
      by (simp add: RPred1_def)
    then have "\<forall>x. the (f x) \<le> 1"
      by (metis eq_refl less_Suc_eq_le zero_less_Suc option.sel)
    with \<open>f \<in> \<R>\<close> show "f \<in> ?S" by simp
  qed
  show "?S \<subseteq> \<R>\<^sub>0\<^sub>1"
  proof
    fix f
    assume f: "f \<in> ?S"
    then have "f \<in> \<R>" by simp
    then have total: "\<And>x. f x \<down>" by auto
    from f have "\<forall>x. the (f x) = 0 \<or> the (f x) = 1"
      by (simp add: le_eq_less_or_eq)
    with total have "\<forall>x. f x \<down>= 0 \<or> f x \<down>= 1"
      by (metis option.collapse)
    then show "f \<in> \<R>\<^sub>0\<^sub>1"
      using \<open>f \<in> \<R>\<close> RPred1_def by auto
  qed
qed

subsection \<open>NUM\<close>

text \<open>A class of recursive functions is in NUM if it can be
embedded in a total numbering. Thus, for learning such classes there is
always a total hypothesis space available.\<close>

definition NUM :: "partial1 set set" where
  "NUM \<equiv> {U. \<exists>\<psi>\<in>\<R>\<^sup>2. \<forall>f\<in>U. \<exists>i. \<psi> i = f}"

definition NUM_wrt :: "partial2 \<Rightarrow> partial1 set set" where
  "\<psi> \<in> \<R>\<^sup>2 \<Longrightarrow> NUM_wrt \<psi> \<equiv> {U. \<forall>f\<in>U. \<exists>i. \<psi> i = f}"

lemma NUM_I [intro]:
  assumes "\<psi> \<in> \<R>\<^sup>2" and "\<And>f. f \<in> U \<Longrightarrow> \<exists>i. \<psi> i = f"
  shows "U \<in> NUM"
  using assms NUM_def by blast

lemma NUM_E [dest]:
  assumes "U \<in> NUM"
  shows "U \<subseteq> \<R>"
    and "\<exists>\<psi>\<in>\<R>\<^sup>2. \<forall>f\<in>U. \<exists>i. \<psi> i = f"
  using NUM_def assms by (force, auto)

lemma NUM_closed_subseteq:
  assumes "U \<in> NUM" and "V \<subseteq> U"
  shows "V \<in> NUM"
  using assms subset_eq[of V U] NUM_I by auto

text \<open>This is the classical diagonalization proof showing that there is
no total numbering containing all total recursive functions.\<close>

lemma R1_not_in_NUM: "\<R> \<notin> NUM"
proof
  assume "\<R> \<in> NUM"
  then obtain \<psi> where num: "\<psi> \<in> \<R>\<^sup>2" "\<forall>f\<in>\<R>. \<exists>i. \<psi> i = f"
    by auto
  then obtain psi where psi: "recfn 2 psi" "total psi" "eval psi [i, x] = \<psi> i x" for i x
    by auto
  define d where "d = Cn 1 S [Cn 1 psi [Id 1 0, Id 1 0]]"
  then have "recfn 1 d"
    using psi(1) by simp
  moreover have d: "eval d [x] \<down>= Suc (the (\<psi> x x))" for x
    unfolding d_def using num psi by simp
  ultimately have "(\<lambda>x. eval d [x]) \<in> \<R>"
    using R1I by blast
  then obtain i where "\<psi> i = (\<lambda>x. eval d [x])"
    using num(2) by auto
  then have "\<psi> i i = eval d [i]" by simp
  with d have "\<psi> i i \<down>= Suc (the (\<psi> i i))" by simp
  then show False
    using option.sel[of "Suc (the (\<psi> i i))"] by simp
qed

text \<open>A hypothesis space that contains a function for every prefix will
come in handy. The following is a total numbering with this property.\<close>

definition "r_prenum \<equiv>
  Cn 2 r_ifless [Id 2 1, Cn 2 r_length [Id 2 0], Cn 2 r_nth [Id 2 0, Id 2 1], r_constn 1 0]"

lemma r_prenum_prim [simp]: "prim_recfn 2 r_prenum"
  unfolding r_prenum_def by simp_all

definition prenum :: partial2 where
  "prenum e x \<equiv> Some (if x < e_length e then e_nth e x else 0)"

lemma prenum_in_R2: "prenum \<in> \<R>\<^sup>2"
  using prenum_def Prim2I[OF r_prenum_prim, of prenum] by simp

lemma prenum [simp]: "prenum e x \<down>= (if x < e_length e then e_nth e x else 0)"
  unfolding prenum_def ..

text \<open>Prepending a list of numbers to a function:\<close>

definition prepend :: "nat list \<Rightarrow> partial1 \<Rightarrow> partial1" (infixr "\<odot>" 64) where
  "vs \<odot> f \<equiv> \<lambda>x. if x < length vs then Some (vs ! x) else f (x - length vs)"

lemma prepend [simp]:
  "(vs \<odot> f) x = (if x < length vs then Some (vs ! x) else f (x - length vs))"
  unfolding prepend_def ..

lemma prepend_total: "total1 f \<Longrightarrow> total1 (vs \<odot> f)"
  unfolding total1_def by simp

lemma prepend_at_less:
  assumes "n < length vs"
  shows "(vs \<odot> f) n \<down>= vs ! n"
  using assms by simp

lemma prepend_at_ge:
  assumes "n \<ge> length vs"
  shows "(vs \<odot> f) n = f (n - length vs)"
  using assms by simp

lemma prefix_prepend_less:
  assumes "n < length vs"
  shows "prefix (vs \<odot> f) n = take (Suc n) vs"
  using assms length_prefix by (intro nth_equalityI) simp_all

lemma prepend_eqI:
  assumes "\<And>x. x < length vs \<Longrightarrow> g x \<down>= vs ! x"
    and "\<And>x. g (length vs + x) = f x"
  shows "g = vs \<odot> f"
proof
  fix x
  show "g x = (vs \<odot> f) x"
  proof (cases "x < length vs")
    case True
    then show ?thesis using assms by simp
  next
    case False
    then show ?thesis
      using assms prepend by (metis add_diff_inverse_nat)
  qed
qed

fun r_prepend :: "nat list \<Rightarrow> recf \<Rightarrow> recf" where
  "r_prepend [] r = r"
| "r_prepend (v # vs) r =
     Cn 1 (r_lifz (r_const v) (Cn 1 (r_prepend vs r) [r_dec])) [Id 1 0, Id 1 0]"

lemma r_prepend_recfn:
  assumes "recfn 1 r"
  shows "recfn 1 (r_prepend vs r)"
  using assms by (induction vs) simp_all

lemma r_prepend:
  assumes "recfn 1 r"
  shows "eval (r_prepend vs r) [x] =
    (if x < length vs then Some (vs ! x) else eval r [x - length vs])"
proof (induction vs arbitrary: x)
  case Nil
  then show ?case using assms by simp
next
  case (Cons v vs)
  show ?case
    using assms Cons by (cases "x = 0") (auto simp add: r_prepend_recfn)
qed

lemma r_prepend_total:
  assumes "recfn 1 r" and "total r"
  shows "eval (r_prepend vs r) [x] \<down>=
    (if x < length vs then vs ! x else the (eval r [x - length vs]))"
proof (induction vs arbitrary: x)
  case Nil
  then show ?case using assms by simp
next
  case (Cons v vs)
  show ?case
    using assms Cons by (cases "x = 0") (auto simp add: r_prepend_recfn)
qed

lemma prepend_in_P1:
  assumes "f \<in> \<P>"
  shows "vs \<odot> f \<in> \<P>"
proof -
  obtain r where r: "recfn 1 r"  "\<And>x. eval r [x] = f x"
    using assms by auto
  moreover have "recfn 1 (r_prepend vs r)"
    using r r_prepend_recfn by simp
  moreover have "eval (r_prepend vs r) [x] = (vs \<odot> f) x" for x
    using r r_prepend by simp
  ultimately show ?thesis by blast
qed

lemma prepend_in_R1:
  assumes "f \<in> \<R>"
  shows "vs \<odot> f \<in> \<R>"
proof -
  obtain r where r: "recfn 1 r" "total r" "\<And>x. eval r [x] = f x"
    using assms by auto
  then have "total1 f"
    using R1_imp_total1[OF assms] by simp
  have "total (r_prepend vs r)"
    using r r_prepend_total r_prepend_recfn totalI1[of "r_prepend vs r"] by simp
  with r have "total (r_prepend vs r)" by simp
  moreover have "recfn 1 (r_prepend vs r)"
    using r r_prepend_recfn by simp
  moreover have "eval (r_prepend vs r) [x] = (vs \<odot> f) x" for x
    using r r_prepend \<open>total1 f\<close> total1E by simp
  ultimately show ?thesis by auto
qed

lemma prepend_associative: "(us @ vs) \<odot> f = us \<odot> vs \<odot> f" (is "?lhs = ?rhs")
proof
  fix x
  consider
      "x < length us"
    | "x \<ge> length us \<and> x < length (us @ vs)"
    | "x \<ge> length (us @ vs)"
    by linarith
  then show "?lhs x = ?rhs x"
  proof (cases)
    case 1
    then show ?thesis
      by (metis le_add1 length_append less_le_trans nth_append prepend_at_less)
  next
    case 2
    then show ?thesis
      by (smt add_diff_inverse_nat add_less_cancel_left length_append nth_append prepend)
  next
    case 3
    then show ?thesis
      using prepend_at_ge by auto
  qed
qed

abbreviation constant_divergent :: partial1 ("\<up>\<^sup>\<infinity>") where
  "\<up>\<^sup>\<infinity> \<equiv> \<lambda>_. None"

abbreviation constant_zero :: partial1 ("0\<^sup>\<infinity>") where
  "0\<^sup>\<infinity> \<equiv> \<lambda>_. Some 0"

lemma almost0_in_R1: "vs \<odot> 0\<^sup>\<infinity> \<in> \<R>"
  using RPred1_subseteq_R1 const0_in_RPred1 prepend_in_R1 by auto

text \<open>The class $U_0$ of all total recursive functions that are almost
everywhere zero will be used several times to construct
(counter-)examples.\<close>

definition U0 :: "partial1 set" ("U\<^sub>0") where
  "U\<^sub>0 \<equiv> {vs \<odot> 0\<^sup>\<infinity> |vs. vs \<in> UNIV}"

text \<open>The class @{term U0} contains exactly the functions in the
numbering @{term prenum}.\<close>

lemma U0_altdef: "U\<^sub>0 = {prenum e| e. e \<in> UNIV}" (is "U\<^sub>0 = ?W")
proof
  show "U\<^sub>0 \<subseteq> ?W"
  proof
    fix f
    assume "f \<in> U\<^sub>0"
    with U0_def obtain vs where "f = vs \<odot> 0\<^sup>\<infinity>"
      by auto
    then have "f = prenum (list_encode vs)"
      using prenum_encode by auto
    then show "f \<in> ?W" by auto
  qed
  show "?W \<subseteq> U\<^sub>0"
    unfolding U0_def by fastforce
qed

lemma U0_in_NUM: "U\<^sub>0 \<in> NUM"
  using prenum_in_R2 U0_altdef by (intro NUM_I[of prenum]; force)

text \<open>Every almost-zero function can be represented by $v0^\infty$ for
a list $v$ not ending in zero.\<close>

lemma almost0_canonical:
  assumes "f = vs \<odot> 0\<^sup>\<infinity>" and "f \<noteq> 0\<^sup>\<infinity>"
  obtains ws where "length ws > 0" and "last ws \<noteq> 0" and "f = ws \<odot> 0\<^sup>\<infinity>"
proof -
  let ?P = "\<lambda>k. k < length vs \<and> vs ! k \<noteq> 0"
  from assms have "vs \<noteq> []"
    by auto
  then have ex: "\<exists>k<length vs. vs ! k \<noteq> 0"
    using assms by auto
  define m where "m = Greatest ?P"
  moreover have le: "\<forall>y. ?P y \<longrightarrow> y \<le> length vs"
    by simp
  ultimately have "?P m"
    using ex GreatestI_ex_nat[of ?P "length vs"] by simp
  have not_gr: "\<not> ?P k" if "k > m" for k
    using Greatest_le_nat[of ?P _ "length vs"] m_def ex le not_less that by blast
  let ?ws = "take (Suc m) vs"
  have "vs \<odot> 0\<^sup>\<infinity> = ?ws \<odot> 0\<^sup>\<infinity>"
  proof
    fix x
    show "(vs \<odot> 0\<^sup>\<infinity>) x = (?ws \<odot> 0\<^sup>\<infinity>) x"
    proof (cases "x < Suc m")
      case True
      then show ?thesis using \<open>?P m\<close> by simp
    next
      case False
      moreover from this have "(?ws \<odot> 0\<^sup>\<infinity>) x \<down>= 0"
        by simp
      ultimately show ?thesis
        using not_gr by (cases "x < length vs") simp_all
    qed
  qed
  then have "f = ?ws \<odot> 0\<^sup>\<infinity>"
    using assms(1) by simp
  moreover have "length ?ws > 0"
    by (simp add: \<open>vs \<noteq> []\<close>)
  moreover have "last ?ws \<noteq> 0"
    by (simp add: \<open>?P m\<close> take_Suc_conv_app_nth)
  ultimately show ?thesis using that by blast
qed

section \<open>Types of inference\label{s:inference_types}\<close>

text \<open>This section introduces all inference types that we are going to
consider together with some of their simple properties. All these inference
types share the following condition, which essentially says that everything
must be computable:\<close>

abbreviation environment :: "partial2 \<Rightarrow> (partial1 set) \<Rightarrow> partial1 \<Rightarrow> bool" where
  "environment \<psi> U s \<equiv> \<psi> \<in> \<P>\<^sup>2 \<and> U \<subseteq> \<R> \<and> s \<in> \<P> \<and> (\<forall>f\<in>U. \<forall>n. s (f \<triangleright> n) \<down>)"

subsection \<open>LIM: Learning in the limit\<close>

text \<open>A strategy $S$ learns a class $U$ in the limit with respect to a
hypothesis space @{term "\<psi> \<in> \<P>\<^sup>2"} if for all $f\in U$, the
sequence $(S(f^n))_{n\in\mathbb{N}}$ converges to an $i$ with $\psi_i = f$.
Convergence for a sequence of natural numbers means that almost all elements
are the same. We express this with the following notation.\<close>

abbreviation Almost_All :: "(nat \<Rightarrow> bool) \<Rightarrow> bool" (binder "\<forall>\<^sup>\<infinity>" 10) where
  "\<forall>\<^sup>\<infinity>n. P n \<equiv> \<exists>n\<^sub>0. \<forall>n\<ge>n\<^sub>0. P n"

definition learn_lim :: "partial2 \<Rightarrow> (partial1 set) \<Rightarrow> partial1 \<Rightarrow> bool" where
  "learn_lim \<psi> U s \<equiv>
     environment \<psi> U s \<and>
     (\<forall>f\<in>U. \<exists>i. \<psi> i = f \<and> (\<forall>\<^sup>\<infinity>n. s (f \<triangleright> n) \<down>= i))"

lemma learn_limE:
  assumes "learn_lim \<psi> U s"
  shows "environment \<psi> U s"
    and "\<And>f. f \<in> U \<Longrightarrow> \<exists>i. \<psi> i = f \<and> (\<forall>\<^sup>\<infinity>n. s (f \<triangleright> n) \<down>= i)"
  using assms learn_lim_def by auto

lemma learn_limI:
  assumes "environment \<psi> U s"
    and "\<And>f. f \<in> U \<Longrightarrow> \<exists>i. \<psi> i = f \<and> (\<forall>\<^sup>\<infinity>n. s (f \<triangleright> n) \<down>= i)"
  shows "learn_lim \<psi> U s"
  using assms learn_lim_def by auto

definition LIM_wrt :: "partial2 \<Rightarrow> partial1 set set" where
  "LIM_wrt \<psi> \<equiv> {U. \<exists>s. learn_lim \<psi> U s}"

definition Lim :: "partial1 set set" ("LIM") where
  "LIM \<equiv> {U. \<exists>\<psi> s. learn_lim \<psi> U s}"

text \<open>LIM is closed under the the subset relation.\<close>

lemma learn_lim_closed_subseteq:
  assumes "learn_lim \<psi> U s" and "V \<subseteq> U"
  shows "learn_lim \<psi> V s"
  using assms learn_lim_def by auto

corollary LIM_closed_subseteq:
  assumes "U \<in> LIM" and "V \<subseteq> U"
  shows "V \<in> LIM"
  using assms learn_lim_closed_subseteq by (smt Lim_def mem_Collect_eq)

text \<open>Changing the hypothesis infinitely often precludes learning in
the limit.\<close>

lemma infinite_hyp_changes_not_Lim:
  assumes "f \<in> U" and "\<forall>n. \<exists>m\<^sub>1>n. \<exists>m\<^sub>2>n. s (f \<triangleright> m\<^sub>1) \<noteq> s (f \<triangleright> m\<^sub>2)"
  shows "\<not> learn_lim \<psi> U s"
  using assms learn_lim_def by (metis less_imp_le)

lemma always_hyp_change_not_Lim:
  assumes "\<And>x. s (f \<triangleright> (Suc x)) \<noteq> s (f \<triangleright> x)"
  shows "\<not> learn_lim \<psi> {f} s"
  using assms learn_limE by (metis le_SucI order_refl singletonI)

text \<open>Guessing a wrong hypothesis infinitely often precludes learning
in the limit.\<close>

lemma infinite_hyp_wrong_not_Lim:
  assumes "f \<in> U" and "\<forall>n. \<exists>m>n. \<psi> (the (s (f \<triangleright> m))) \<noteq> f"
  shows "\<not> learn_lim \<psi> U s"
  using assms learn_limE by (metis less_imp_le option.sel)

text \<open>Converging to the same hypothesis on two functions precludes
learning in the limit.\<close>

lemma same_hyp_for_two_not_Lim:
  assumes "f\<^sub>1 \<in> U"
    and "f\<^sub>2 \<in> U"
    and "f\<^sub>1 \<noteq> f\<^sub>2"
    and "\<forall>n\<ge>n\<^sub>1. s (f\<^sub>1 \<triangleright> n) = h"
    and "\<forall>n\<ge>n\<^sub>2. s (f\<^sub>2 \<triangleright> n) = h"
  shows "\<not> learn_lim \<psi> U s"
  using assms learn_limE by (metis le_cases option.sel)

text \<open>Every class that can be learned in the limit can be learned in
the limit with respect to any Gödel numbering. We prove a generalization in
which hypotheses may have to satisfy an extra condition, so we can re-use it
for other inference types later.\<close>

lemma learn_lim_extra_wrt_goedel:
  fixes extra :: "(partial1 set) \<Rightarrow> partial1 \<Rightarrow> nat \<Rightarrow> partial1 \<Rightarrow> bool"
  assumes "goedel_numbering \<chi>"
    and "learn_lim \<psi> U s"
    and "\<And>f n. f \<in> U \<Longrightarrow> extra U f n (\<psi> (the (s (f \<triangleright> n))))"
  shows "\<exists>t. learn_lim \<chi> U t \<and> (\<forall>f\<in>U. \<forall>n. extra U f n (\<chi> (the (t (f \<triangleright> n)))))"
proof -
  have env: "environment \<psi> U s"
    and lim: "learn_lim \<psi> U s"
    and extra: "\<forall>f\<in>U. \<forall>n. extra U f n (\<psi> (the (s (f \<triangleright> n))))"
    using assms learn_limE by auto
  obtain c where c: "c \<in> \<R>" "\<forall>i. \<psi> i = \<chi> (the (c i))"
    using env goedel_numberingE[OF assms(1), of \<psi>] by auto
  define t where "t \<equiv>
    (\<lambda>x. if s x \<down> \<and> c (the (s x)) \<down> then Some (the (c (the (s x)))) else None)"
  have "t \<in> \<P>"
    unfolding t_def using env c concat_P1_P1[of c s] by auto
  have "t x = (if s x \<down> then Some (the (c (the (s x)))) else None)" for x
    using t_def c(1) R1_imp_total1 by auto
  then have t: "t (f \<triangleright> n) \<down>= the (c (the (s (f \<triangleright> n))))" if "f \<in> U" for f n
    using lim learn_limE that by simp
  have "learn_lim \<chi> U t"
  proof (rule learn_limI)
    show "environment \<chi> U t"
      using t by (simp add: \<open>t \<in> \<P>\<close> env goedel_numbering_P2[OF assms(1)])
    show "\<exists>i. \<chi> i = f \<and> (\<forall>\<^sup>\<infinity>n. t (f \<triangleright> n) \<down>= i)" if "f \<in> U" for f
    proof -
      from lim learn_limE(2) obtain i n\<^sub>0 where
        i: "\<psi> i = f \<and> (\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= i)"
        using \<open>f \<in> U\<close> by blast
      let ?j = "the (c i)"
      have "\<chi> ?j = f"
        using c(2) i by simp
      moreover have "t (f \<triangleright> n) \<down>= ?j" if "n \<ge> n\<^sub>0" for n
        by (simp add: \<open>f \<in> U\<close> i t that)
      ultimately show ?thesis by auto
    qed
  qed
  moreover have "extra U f n (\<chi> (the (t (f \<triangleright> n))))" if "f \<in> U" for f n
  proof -
    from t have "the (t (f \<triangleright> n)) = the (c (the (s (f \<triangleright> n))))"
      by (simp add: that)
    then have "\<chi> (the (t (f \<triangleright> n))) = \<psi> (the (s (f \<triangleright> n)))"
      using c(2) by simp
    with extra show ?thesis using that by simp
  qed
  ultimately show ?thesis by auto
qed

lemma learn_lim_wrt_goedel:
  assumes "goedel_numbering \<chi>" and "learn_lim \<psi> U s"
  shows "\<exists>t. learn_lim \<chi> U t"
  using assms learn_lim_extra_wrt_goedel[where ?extra="\<lambda>U f n h. True"]
  by simp

lemma LIM_wrt_phi_eq_Lim: "LIM_wrt \<phi> = LIM"
  using LIM_wrt_def Lim_def learn_lim_wrt_goedel[OF goedel_numbering_phi]
  by blast

subsection \<open>BC: Behaviorally correct learning in the limit\<close>

text \<open>Behaviorally correct learning in the limit relaxes LIM by
requiring that the strategy almost always output an index for the target
function, but not necessarily the same index. In other words convergence of
$(S(f^n))_{n\in\mathbb{N}}$ is replaced by convergence of
$(\psi_{S(f^n)})_{n\in\mathbb{N}}$.\<close>

definition learn_bc :: "partial2 \<Rightarrow> (partial1 set) \<Rightarrow> partial1 \<Rightarrow> bool" where
  "learn_bc \<psi> U s \<equiv>
     environment \<psi> U s \<and>
     (\<forall>f\<in>U. \<forall>\<^sup>\<infinity>n. \<psi> (the (s (f \<triangleright> n))) = f)"

lemma learn_bcE:
  assumes "learn_bc \<psi> U s"
  shows "environment \<psi> U s"
    and "\<And>f. f \<in> U \<Longrightarrow> \<forall>\<^sup>\<infinity>n. \<psi> (the (s (f \<triangleright> n))) = f"
  using assms learn_bc_def by auto

lemma learn_bcI:
  assumes "environment \<psi> U s"
    and "\<And>f. f \<in> U \<Longrightarrow> \<forall>\<^sup>\<infinity>n. \<psi> (the (s (f \<triangleright> n))) = f"
  shows "learn_bc \<psi> U s"
  using assms learn_bc_def by auto

definition BC_wrt :: "partial2 \<Rightarrow> partial1 set set" where
  "BC_wrt \<psi> \<equiv> {U. \<exists>s. learn_bc \<psi> U s}"

definition BC :: "partial1 set set" where
  "BC \<equiv> {U. \<exists>\<psi> s. learn_bc \<psi> U s}"

text \<open>BC is a superset of LIM and closed under the subset relation.\<close>

lemma learn_lim_imp_BC: "learn_lim \<psi> U s \<Longrightarrow> learn_bc \<psi> U s"
  using learn_limE learn_bcI[of \<psi> U s] by fastforce

lemma Lim_subseteq_BC: "LIM \<subseteq> BC"
  using learn_lim_imp_BC Lim_def BC_def by blast

lemma learn_bc_closed_subseteq:
  assumes "learn_bc \<psi> U s" and "V \<subseteq> U"
  shows "learn_bc \<psi> V s"
  using assms learn_bc_def by auto

corollary BC_closed_subseteq:
  assumes "U \<in> BC" and "V \<subseteq> U"
  shows "V \<in> BC"
  using assms by (smt BC_def learn_bc_closed_subseteq mem_Collect_eq)

text \<open>Just like with LIM, guessing a wrong hypothesis infinitely often
precludes BC-style learning.\<close>

lemma infinite_hyp_wrong_not_BC:
  assumes "f \<in> U" and "\<forall>n. \<exists>m>n. \<psi> (the (s (f \<triangleright> m))) \<noteq> f"
  shows "\<not> learn_bc \<psi> U s"
proof
  assume "learn_bc \<psi> U s"
  then obtain n\<^sub>0 where "\<forall>n\<ge>n\<^sub>0. \<psi> (the (s (f \<triangleright> n))) = f"
    using learn_bcE assms(1) by metis
  with assms(2) show False using less_imp_le by blast
qed

text \<open>The proof that Gödel numberings suffice as hypothesis spaces for
BC is similar to the one for @{thm[source] learn_lim_extra_wrt_goedel}. We do
not need the @{term extra} part for BC, but we get it for free.\<close>

lemma learn_bc_extra_wrt_goedel:
  fixes extra :: "(partial1 set) \<Rightarrow> partial1 \<Rightarrow> nat \<Rightarrow> partial1 \<Rightarrow> bool"
  assumes "goedel_numbering \<chi>"
    and "learn_bc \<psi> U s"
    and "\<And>f n. f \<in> U \<Longrightarrow> extra U f n (\<psi> (the (s (f \<triangleright> n))))"
  shows "\<exists>t. learn_bc \<chi> U t \<and> (\<forall>f\<in>U. \<forall>n. extra U f n (\<chi> (the (t (f \<triangleright> n)))))"
proof -
  have env: "environment \<psi> U s"
    and lim: "learn_bc \<psi> U s"
    and extra: "\<forall>f\<in>U. \<forall>n. extra U f n (\<psi> (the (s (f \<triangleright> n))))"
    using assms learn_bc_def by auto
  obtain c where c: "c \<in> \<R>" "\<forall>i. \<psi> i = \<chi> (the (c i))"
    using env goedel_numberingE[OF assms(1), of \<psi>] by auto
  define t where
    "t = (\<lambda>x. if s x \<down> \<and> c (the (s x)) \<down> then Some (the (c (the (s x)))) else None)"
  have "t \<in> \<P>"
    unfolding t_def using env c concat_P1_P1[of c s] by auto
  have "t x = (if s x \<down> then Some (the (c (the (s x)))) else None)" for x
    using t_def c(1) R1_imp_total1 by auto
  then have t: "t (f \<triangleright> n) \<down>= the (c (the (s (f \<triangleright> n))))" if "f \<in> U" for f n
    using lim learn_bcE(1) that by simp
  have "learn_bc \<chi> U t"
  proof (rule learn_bcI)
    show "environment \<chi> U t"
      using t by (simp add: \<open>t \<in> \<P>\<close> env goedel_numbering_P2[OF assms(1)])
    show "\<forall>\<^sup>\<infinity>n. \<chi> (the (t (f \<triangleright> n))) = f" if "f \<in> U" for f
    proof -
      obtain n\<^sub>0 where "\<forall>n\<ge>n\<^sub>0. \<psi> (the (s (f \<triangleright> n))) = f"
        using lim learn_bcE(2) \<open>f \<in> U\<close> by blast
      then show ?thesis using that t c(2) by auto
    qed
  qed
  moreover have "extra U f n (\<chi> (the (t (f \<triangleright> n))))" if "f \<in> U" for f n
  proof -
    from t have "the (t (f \<triangleright> n)) = the (c (the (s (f \<triangleright> n))))"
      by (simp add: that)
    then have "\<chi> (the (t (f \<triangleright> n))) = \<psi> (the (s (f \<triangleright> n)))"
      using c(2) by simp
    with extra show ?thesis using that by simp
  qed
  ultimately show ?thesis by auto
qed

corollary learn_bc_wrt_goedel:
  assumes "goedel_numbering \<chi>" and "learn_bc \<psi> U s"
  shows "\<exists>t. learn_bc \<chi> U t"
  using assms learn_bc_extra_wrt_goedel[where ?extra="\<lambda>_ _ _ _. True"] by simp

corollary BC_wrt_phi_eq_BC: "BC_wrt \<phi> = BC"
  using learn_bc_wrt_goedel goedel_numbering_phi BC_def BC_wrt_def by blast

subsection \<open>CONS: Learning in the limit with consistent hypotheses\<close>

text \<open>A hypothesis is \emph{consistent} if it matches all values in the
prefix given to the strategy. Consistent learning in the limit requires the
strategy to output only consistent hypotheses for prefixes from the class.\<close>

definition learn_cons :: "partial2 \<Rightarrow> (partial1 set) \<Rightarrow> partial1 \<Rightarrow> bool" where
  "learn_cons \<psi> U s \<equiv>
     learn_lim \<psi> U s \<and>
     (\<forall>f\<in>U. \<forall>n. \<forall>k\<le>n. \<psi> (the (s (f \<triangleright> n))) k = f k)"

definition CONS_wrt :: "partial2 \<Rightarrow> partial1 set set" where
  "CONS_wrt \<psi> \<equiv> {U. \<exists>s. learn_cons \<psi> U s}"

definition CONS :: "partial1 set set" where
  "CONS \<equiv> {U. \<exists>\<psi> s. learn_cons \<psi> U s}"

lemma CONS_subseteq_Lim: "CONS \<subseteq> LIM"
  using CONS_def Lim_def learn_cons_def by blast

lemma learn_consI:
  assumes "environment \<psi> U s"
    and "\<And>f. f \<in> U \<Longrightarrow> \<exists>i. \<psi> i = f \<and> (\<forall>\<^sup>\<infinity>n. s (f \<triangleright> n) \<down>= i)"
    and "\<And>f n. f \<in> U \<Longrightarrow> \<forall>k\<le>n. \<psi> (the (s (f \<triangleright> n))) k = f k"
  shows "learn_cons \<psi> U s"
  using assms learn_lim_def learn_cons_def by simp

text \<open>If a consistent strategy converges, it automatically converges to
a correct hypothesis. Thus we can remove @{term "\<psi> i = f"} from the second
assumption in the previous lemma.\<close>

lemma learn_consI2:
  assumes "environment \<psi> U s"
    and "\<And>f. f \<in> U \<Longrightarrow> \<exists>i. \<forall>\<^sup>\<infinity>n. s (f \<triangleright> n) \<down>= i"
    and "\<And>f n. f \<in> U \<Longrightarrow> \<forall>k\<le>n. \<psi> (the (s (f \<triangleright> n))) k = f k"
  shows "learn_cons \<psi> U s"
proof (rule learn_consI)
  show "environment \<psi> U s"
    and cons: "\<And>f n. f \<in> U \<Longrightarrow> \<forall>k\<le>n. \<psi> (the (s (f \<triangleright> n))) k = f k"
    using assms by simp_all
  show "\<exists>i. \<psi> i = f \<and> (\<forall>\<^sup>\<infinity>n. s (f \<triangleright> n) \<down>= i)" if "f \<in> U" for f
  proof -
    from that assms(2) obtain i n\<^sub>0 where i_n0: "\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= i"
      by blast
    have "\<psi> i x = f x" for x
    proof (cases "x \<le> n\<^sub>0")
      case True
      then show ?thesis
        using i_n0 cons that by fastforce
    next
      case False
      moreover have "\<forall>k\<le>x. \<psi> (the (s (f \<triangleright> x))) k = f k"
        using cons that by simp
      ultimately show ?thesis using i_n0 by simp
    qed
    with i_n0 show ?thesis by auto
  qed
qed

lemma learn_consE:
  assumes "learn_cons \<psi> U s"
  shows "environment \<psi> U s"
    and "\<And>f. f \<in> U \<Longrightarrow> \<exists>i n\<^sub>0. \<psi> i = f \<and> (\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= i)"
    and "\<And>f n. f \<in> U \<Longrightarrow> \<forall>k\<le>n. \<psi> (the (s (f \<triangleright> n))) k = f k"
  using assms learn_cons_def learn_lim_def by auto

lemma learn_cons_wrt_goedel:
  assumes "goedel_numbering \<chi>" and "learn_cons \<psi> U s"
  shows "\<exists>t. learn_cons \<chi> U t"
  using learn_cons_def assms
    learn_lim_extra_wrt_goedel[where ?extra="\<lambda>U f n h. \<forall>k\<le>n. h k = f k"]
  by auto

lemma CONS_wrt_phi_eq_CONS: "CONS_wrt \<phi> = CONS"
  using CONS_wrt_def CONS_def learn_cons_wrt_goedel goedel_numbering_phi
  by blast

lemma learn_cons_closed_subseteq:
  assumes "learn_cons \<psi> U s" and "V \<subseteq> U"
  shows "learn_cons \<psi> V s"
  using assms learn_cons_def learn_lim_closed_subseteq by auto

lemma CONS_closed_subseteq:
  assumes "U \<in> CONS" and "V \<subseteq> U"
  shows "V \<in> CONS"
  using assms learn_cons_closed_subseteq by (smt CONS_def mem_Collect_eq)

text \<open>A consistent strategy cannot output the same hypothesis for two
different prefixes from the class to be learned.\<close>

lemma same_hyp_different_init_not_cons:
  assumes "f \<in> U"
    and "g \<in> U"
    and "f \<triangleright> n \<noteq> g \<triangleright> n"
    and "s (f \<triangleright> n) = s (g \<triangleright> n)"
  shows "\<not> learn_cons \<phi> U s"
  unfolding learn_cons_def by (auto, metis assms init_eqI)

subsection \<open>TOTAL: Learning in the limit with total hypotheses\<close>

text \<open>Total learning in the limit requires the strategy to hypothesize
only total functions for prefixes from the class.\<close>

definition learn_total :: "partial2 \<Rightarrow> (partial1 set) \<Rightarrow> partial1 \<Rightarrow> bool" where
  "learn_total \<psi> U s \<equiv>
     learn_lim \<psi> U s \<and>
     (\<forall>f\<in>U. \<forall>n. \<psi> (the (s (f \<triangleright> n))) \<in> \<R>)"

definition TOTAL_wrt :: "partial2 \<Rightarrow> partial1 set set" where
  "TOTAL_wrt \<psi> \<equiv> {U. \<exists>s. learn_total \<psi> U s}"

definition TOTAL :: "partial1 set set" where
  "TOTAL \<equiv> {U. \<exists>\<psi> s. learn_total \<psi> U s}"

lemma TOTAL_subseteq_LIM: "TOTAL \<subseteq> LIM"
  unfolding TOTAL_def Lim_def using learn_total_def by auto

lemma learn_totalI:
  assumes "environment \<psi> U s"
    and "\<And>f. f \<in> U \<Longrightarrow> \<exists>i. \<psi> i = f \<and> (\<forall>\<^sup>\<infinity>n. s (f \<triangleright> n) \<down>= i)"
    and "\<And>f n. f \<in> U \<Longrightarrow> \<psi> (the (s (f \<triangleright> n))) \<in> \<R>"
  shows "learn_total \<psi> U s"
  using assms learn_lim_def learn_total_def by auto

lemma learn_totalE:
  assumes "learn_total \<psi> U s"
  shows "environment \<psi> U s"
    and "\<And>f. f \<in> U \<Longrightarrow> \<exists>i n\<^sub>0. \<psi> i = f \<and> (\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= i)"
    and "\<And>f n. f \<in> U \<Longrightarrow> \<psi> (the (s (f \<triangleright> n))) \<in> \<R>"
  using assms learn_lim_def learn_total_def by auto

lemma learn_total_wrt_goedel:
  assumes "goedel_numbering \<chi>" and "learn_total \<psi> U s"
  shows "\<exists>t. learn_total \<chi> U t"
  using learn_total_def assms learn_lim_extra_wrt_goedel[where ?extra="\<lambda>U f n h. h \<in> \<R>"]
  by auto

lemma TOTAL_wrt_phi_eq_TOTAL: "TOTAL_wrt \<phi> = TOTAL"
  using TOTAL_wrt_def TOTAL_def learn_total_wrt_goedel goedel_numbering_phi
  by blast

lemma learn_total_closed_subseteq:
  assumes "learn_total \<psi> U s" and "V \<subseteq> U"
  shows "learn_total \<psi> V s"
  using assms learn_total_def learn_lim_closed_subseteq by auto

lemma TOTAL_closed_subseteq:
  assumes "U \<in> TOTAL" and "V \<subseteq> U"
  shows "V \<in> TOTAL"
  using assms learn_total_closed_subseteq by (smt TOTAL_def mem_Collect_eq)

subsection \<open>CP: Learning in the limit with class-preserving hypotheses\<close>

text \<open>Class-preserving learning in the limit requires all hypotheses
for prefixes from the class to be functions from the class.\<close>

definition learn_cp :: "partial2 \<Rightarrow> (partial1 set) \<Rightarrow> partial1 \<Rightarrow> bool" where
  "learn_cp \<psi> U s \<equiv>
     learn_lim \<psi> U s \<and>
     (\<forall>f\<in>U. \<forall>n. \<psi> (the (s (f \<triangleright> n))) \<in> U)"

definition CP_wrt :: "partial2 \<Rightarrow> partial1 set set" where
  "CP_wrt \<psi> \<equiv> {U. \<exists>s. learn_cp \<psi> U s}"

definition CP :: "partial1 set set" where
  "CP \<equiv> {U. \<exists>\<psi> s. learn_cp \<psi> U s}"

lemma learn_cp_wrt_goedel:
  assumes "goedel_numbering \<chi>" and "learn_cp \<psi> U s"
  shows "\<exists>t. learn_cp \<chi> U t"
  using learn_cp_def assms learn_lim_extra_wrt_goedel[where ?extra="\<lambda>U f n h. h \<in> U"]
  by auto

corollary CP_wrt_phi: "CP = CP_wrt \<phi>"
  using learn_cp_wrt_goedel[OF goedel_numbering_phi]
  by (smt CP_def CP_wrt_def Collect_cong)

lemma learn_cpI:
  assumes "environment \<psi> U s"
    and "\<And>f. f \<in> U \<Longrightarrow> \<exists>i. \<psi> i = f \<and> (\<forall>\<^sup>\<infinity>n. s (f \<triangleright> n) \<down>= i)"
    and "\<And>f n. f \<in> U \<Longrightarrow> \<psi> (the (s (f \<triangleright> n))) \<in> U"
  shows "learn_cp \<psi> U s"
  using assms learn_cp_def learn_lim_def by auto

lemma learn_cpE:
  assumes "learn_cp \<psi> U s"
  shows "environment \<psi> U s"
    and "\<And>f. f \<in>  U \<Longrightarrow> \<exists>i n\<^sub>0. \<psi> i = f \<and> (\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= i)"
    and "\<And>f n. f \<in> U \<Longrightarrow> \<psi> (the (s (f \<triangleright> n))) \<in> U"
  using assms learn_lim_def learn_cp_def by auto

text \<open>Since classes contain only total functions, a CP strategy is also
a TOTAL strategy.\<close>

lemma learn_cp_imp_total: "learn_cp \<psi> U s \<Longrightarrow> learn_total \<psi> U s"
  using learn_cp_def learn_total_def learn_lim_def by auto

lemma CP_subseteq_TOTAL: "CP \<subseteq> TOTAL"
  using learn_cp_imp_total CP_def TOTAL_def by blast

subsection \<open>FIN: Finite learning\<close>

text \<open>In general it is undecidable whether a LIM strategy has reached
its final hypothesis. By contrast, in finite learning (also called ``one-shot
learning'') the strategy signals when it is ready to output a hypothesis. Up
until then it outputs a ``don't know yet'' value. This value is represented
by zero and the actual hypothesis $i$ by $i + 1$.\<close>

definition learn_fin :: "partial2 \<Rightarrow> partial1 set \<Rightarrow> partial1 \<Rightarrow> bool" where
  "learn_fin \<psi> U s \<equiv>
     environment \<psi> U s \<and>
     (\<forall>f \<in> U. \<exists>i n\<^sub>0. \<psi> i = f \<and> (\<forall>n<n\<^sub>0. s (f \<triangleright> n) \<down>= 0) \<and> (\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= Suc i))"

definition FIN_wrt :: "partial2 \<Rightarrow> partial1 set set" where
  "FIN_wrt \<psi> \<equiv> {U. \<exists>s. learn_fin \<psi> U s}"

definition FIN :: "partial1 set set" where
  "FIN \<equiv> {U. \<exists>\<psi> s. learn_fin \<psi> U s}"

lemma learn_finI:
  assumes "environment \<psi> U s"
    and "\<And>f. f \<in> U \<Longrightarrow>
      \<exists>i n\<^sub>0. \<psi> i = f \<and> (\<forall>n<n\<^sub>0. s (f \<triangleright> n) \<down>= 0) \<and> (\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= Suc i)"
  shows "learn_fin \<psi> U s"
  using assms learn_fin_def by auto

lemma learn_finE:
  assumes "learn_fin \<psi> U s"
  shows "environment \<psi> U s"
    and "\<And>f. f \<in> U \<Longrightarrow>
      \<exists>i n\<^sub>0. \<psi> i = f \<and> (\<forall>n<n\<^sub>0. s (f \<triangleright> n) \<down>= 0) \<and> (\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= Suc i)"
  using assms learn_fin_def by auto

lemma learn_fin_closed_subseteq:
  assumes "learn_fin \<psi> U s" and "V \<subseteq> U"
  shows "learn_fin \<psi> V s"
  using assms learn_fin_def by auto

lemma learn_fin_wrt_goedel:
  assumes "goedel_numbering \<chi>" and "learn_fin \<psi> U s"
  shows "\<exists>t. learn_fin \<chi> U t"
proof -
  have env: "environment \<psi> U s"
    and fin: "\<And>f. f \<in> U \<Longrightarrow>
      \<exists>i n\<^sub>0. \<psi> i = f \<and> (\<forall>n<n\<^sub>0. s (f \<triangleright> n) \<down>= 0) \<and> (\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= Suc i)"
    using assms(2) learn_finE by auto
  obtain c where c: "c \<in> \<R>" "\<forall>i. \<psi> i = \<chi> (the (c i))"
    using env goedel_numberingE[OF assms(1), of \<psi>] by auto
  define t where "t \<equiv>
    \<lambda>x. if s x \<up> then None
         else if s x = Some 0 then Some 0
              else Some (Suc (the (c (the (s x) - 1))))"
  have "t \<in> \<P>"
  proof -
    from c obtain rc where rc:
      "recfn 1 rc"
      "total rc"
      "\<forall>x. c x = eval rc [x]"
      by auto
    from env obtain rs where rs: "recfn 1 rs" "\<forall>x. s x = eval rs [x]"
      by auto
    then have "eval rs [f \<triangleright> n] \<down>" if "f \<in> U" for f n
      using env that by simp
    define rt where "rt = Cn 1 r_ifz [rs, Z, Cn 1 S [Cn 1 rc [Cn 1 r_dec [rs]]]]"
    then have "recfn 1 rt"
      using rc(1) rs(1) by simp
    have "eval rt [x] \<up>" if "eval rs [x] \<up>" for x
      using rc(1) rs(1) rt_def that by auto
    moreover have "eval rt [x] \<down>= 0" if "eval rs [x] \<down>= 0" for x
      using rt_def that rc(1,2) rs(1) by simp
    moreover have "eval rt [x] \<down>= Suc (the (c (the (s x) - 1)))" if "eval rs [x] \<down>\<noteq> 0" for x
      using rt_def that rc rs by auto
    ultimately have "eval rt [x] = t x" for x
      by (simp add: rs(2) t_def)
    with \<open>recfn 1 rt\<close> show ?thesis by auto
  qed
  have t: "t (f \<triangleright> n) \<down>=
      (if s (f \<triangleright> n) = Some 0 then 0 else Suc (the (c (the (s (f \<triangleright> n)) - 1))))"
    if "f \<in> U" for f n
    using that env by (simp add: t_def)
  have "learn_fin \<chi> U t"
  proof (rule learn_finI)
    show "environment \<chi> U t"
      using t by (simp add: \<open>t \<in> \<P>\<close> env goedel_numbering_P2[OF assms(1)])
    show "\<exists>i n\<^sub>0. \<chi> i = f \<and> (\<forall>n<n\<^sub>0. t (f \<triangleright> n) \<down>= 0) \<and> (\<forall>n\<ge>n\<^sub>0. t (f \<triangleright> n) \<down>= Suc i)"
      if "f \<in> U" for f
    proof -
      from fin obtain i n\<^sub>0 where
        i: "\<psi> i = f \<and> (\<forall>n<n\<^sub>0. s (f \<triangleright> n) \<down>= 0) \<and> (\<forall>n\<ge>n\<^sub>0. s (f \<triangleright> n) \<down>= Suc i)"
        using \<open>f \<in> U\<close> by blast
      let ?j = "the (c i)"
      have "\<chi> ?j = f"
        using c(2) i by simp
      moreover have "\<forall>n<n\<^sub>0. t (f \<triangleright> n) \<down>= 0"
        using t[OF that] i by simp
      moreover have "t (f \<triangleright> n) \<down>= Suc ?j" if "n \<ge> n\<^sub>0" for n
        using that i t[OF \<open>f \<in> U\<close>] by simp
      ultimately show ?thesis by auto
    qed
  qed
  then show ?thesis by auto
qed

end


(*  Title:      HOL/Nonstandard_Analysis/NatStar.thy
    Author:     Jacques D. Fleuriot
    Copyright:  1998  University of Cambridge

Converted to Isar and polished by lcp
*)

section \<open>Star-transforms for the Hypernaturals\<close>

theory NatStar
  imports Star
begin

lemma star_n_eq_starfun_whn: "star_n X = ( *f* X) whn"
  by (simp add: hypnat_omega_def starfun_def star_of_def Ifun_star_n)

lemma starset_n_Un: "*sn* (\<lambda>n. (A n) \<union> (B n)) = *sn* A \<union> *sn* B"
  apply (simp add: starset_n_def star_n_eq_starfun_whn Un_def)
  apply (rule_tac x=whn in spec, transfer, simp)
  done

lemma InternalSets_Un: "X \<in> InternalSets \<Longrightarrow> Y \<in> InternalSets \<Longrightarrow> X \<union> Y \<in> InternalSets"
  by (auto simp add: InternalSets_def starset_n_Un [symmetric])

lemma starset_n_Int: "*sn* (\<lambda>n. A n \<inter> B n) = *sn* A \<inter> *sn* B"
  apply (simp add: starset_n_def star_n_eq_starfun_whn Int_def)
  apply (rule_tac x=whn in spec, transfer, simp)
  done

lemma InternalSets_Int: "X \<in> InternalSets \<Longrightarrow> Y \<in> InternalSets \<Longrightarrow> X \<inter> Y \<in> InternalSets"
  by (auto simp add: InternalSets_def starset_n_Int [symmetric])

lemma starset_n_Compl: "*sn* ((\<lambda>n. - A n)) = - ( *sn* A)"
  apply (simp add: starset_n_def star_n_eq_starfun_whn Compl_eq)
  apply (rule_tac x=whn in spec, transfer, simp)
  done

lemma InternalSets_Compl: "X \<in> InternalSets \<Longrightarrow> - X \<in> InternalSets"
  by (auto simp add: InternalSets_def starset_n_Compl [symmetric])

lemma starset_n_diff: "*sn* (\<lambda>n. (A n) - (B n)) = *sn* A - *sn* B"
  apply (simp add: starset_n_def star_n_eq_starfun_whn set_diff_eq)
  apply (rule_tac x=whn in spec, transfer, simp)
  done

lemma InternalSets_diff: "X \<in> InternalSets \<Longrightarrow> Y \<in> InternalSets \<Longrightarrow> X - Y \<in> InternalSets"
  by (auto simp add: InternalSets_def starset_n_diff [symmetric])

lemma NatStar_SHNat_subset: "Nats \<le> *s* (UNIV:: nat set)"
  by simp

lemma NatStar_hypreal_of_real_Int: "*s* X Int Nats = hypnat_of_nat ` X"
  by (auto simp add: SHNat_eq)

lemma starset_starset_n_eq: "*s* X = *sn* (\<lambda>n. X)"
  by (simp add: starset_n_starset)

lemma InternalSets_starset_n [simp]: "( *s* X) \<in> InternalSets"
  by (auto simp add: InternalSets_def starset_starset_n_eq)

lemma InternalSets_UNIV_diff: "X \<in> InternalSets \<Longrightarrow> UNIV - X \<in> InternalSets"
  apply (subgoal_tac "UNIV - X = - X")
   apply (auto intro: InternalSets_Compl)
  done

subsection \<open>Nonstandard Extensions of Functions\<close>

text \<open>Example of transfer of a property from reals to hyperreals
  --- used for limit comparison of sequences.\<close>

lemma starfun_le_mono: "\<forall>n. N \<le> n \<longrightarrow> f n \<le> g n \<Longrightarrow>
  \<forall>n. hypnat_of_nat N \<le> n \<longrightarrow> ( *f* f) n \<le> ( *f* g) n"
  by transfer

text \<open>And another:\<close>
lemma starfun_less_mono:
  "\<forall>n. N \<le> n \<longrightarrow> f n < g n \<Longrightarrow> \<forall>n. hypnat_of_nat N \<le> n \<longrightarrow> ( *f* f) n < ( *f* g) n"
  by transfer

text \<open>Nonstandard extension when we increment the argument by one.\<close>

lemma starfun_shift_one: "\<And>N. ( *f* (\<lambda>n. f (Suc n))) N = ( *f* f) (N + (1::hypnat))"
  by transfer simp

text \<open>Nonstandard extension with absolute value.\<close>
lemma starfun_abs: "\<And>N. ( *f* (\<lambda>n. \<bar>f n\<bar>)) N = \<bar>( *f* f) N\<bar>"
  by transfer (rule refl)

text \<open>The \<open>hyperpow\<close> function as a nonstandard extension of \<open>realpow\<close>.\<close>
lemma starfun_pow: "\<And>N. ( *f* (\<lambda>n. r ^ n)) N = hypreal_of_real r pow N"
  by transfer (rule refl)

lemma starfun_pow2: "\<And>N. ( *f* (\<lambda>n. X n ^ m)) N = ( *f* X) N pow hypnat_of_nat m"
  by transfer (rule refl)

lemma starfun_pow3: "\<And>R. ( *f* (\<lambda>r. r ^ n)) R = R pow hypnat_of_nat n"
  by transfer (rule refl)

text \<open>The @{term hypreal_of_hypnat} function as a nonstandard extension of
  @{term real_of_nat}.\<close>
lemma starfunNat_real_of_nat: "( *f* real) = hypreal_of_hypnat"
  by transfer (simp add: fun_eq_iff)

lemma starfun_inverse_real_of_nat_eq:
  "N \<in> HNatInfinite \<Longrightarrow> ( *f* (\<lambda>x::nat. inverse (real x))) N = inverse (hypreal_of_hypnat N)"
  apply (rule_tac f1 = inverse in starfun_o2 [THEN subst])
  apply (subgoal_tac "hypreal_of_hypnat N \<noteq> 0")
   apply (simp_all add: zero_less_HNatInfinite starfunNat_real_of_nat)
  done

text \<open>Internal functions -- some redundancy with \<open>*f*\<close> now.\<close>

lemma starfun_n: "( *fn* f) (star_n X) = star_n (\<lambda>n. f n (X n))"
  by (simp add: starfun_n_def Ifun_star_n)

text \<open>Multiplication: \<open>( *fn) x ( *gn) = *(fn x gn)\<close>\<close>

lemma starfun_n_mult: "( *fn* f) z * ( *fn* g) z = ( *fn* (\<lambda>i x. f i x * g i x)) z"
  by (cases z) (simp add: starfun_n star_n_mult)

text \<open>Addition: \<open>( *fn) + ( *gn) = *(fn + gn)\<close>\<close>
lemma starfun_n_add: "( *fn* f) z + ( *fn* g) z = ( *fn* (\<lambda>i x. f i x + g i x)) z"
  by (cases z) (simp add: starfun_n star_n_add)

text \<open>Subtraction: \<open>( *fn) - ( *gn) = *(fn + - gn)\<close>\<close>
lemma starfun_n_add_minus: "( *fn* f) z + -( *fn* g) z = ( *fn* (\<lambda>i x. f i x + -g i x)) z"
  by (cases z) (simp add: starfun_n star_n_minus star_n_add)

text \<open>Composition: \<open>( *fn) \<circ> ( *gn) = *(fn \<circ> gn)\<close>\<close>

lemma starfun_n_const_fun [simp]: "( *fn* (\<lambda>i x. k)) z = star_of k"
  by (cases z) (simp add: starfun_n star_of_def)

lemma starfun_n_minus: "- ( *fn* f) x = ( *fn* (\<lambda>i x. - (f i) x)) x"
  by (cases x) (simp add: starfun_n star_n_minus)

lemma starfun_n_eq [simp]: "( *fn* f) (star_of n) = star_n (\<lambda>i. f i n)"
  by (simp add: starfun_n star_of_def)

lemma starfun_eq_iff: "(( *f* f) = ( *f* g)) \<longleftrightarrow> f = g"
  by transfer (rule refl)

lemma starfunNat_inverse_real_of_nat_Infinitesimal [simp]:
  "N \<in> HNatInfinite \<Longrightarrow> ( *f* (%x. inverse (real x))) N \<in> Infinitesimal"
  apply (rule_tac f1 = inverse in starfun_o2 [THEN subst])
  apply (subgoal_tac "hypreal_of_hypnat N ~= 0")
   apply (simp_all add: zero_less_HNatInfinite starfunNat_real_of_nat)
  done

subsection \<open>Nonstandard Characterization of Induction\<close>

lemma hypnat_induct_obj:
  "\<And>n. (( *p* P) (0::hypnat) \<and> (\<forall>n. ( *p* P) n \<longrightarrow> ( *p* P) (n + 1))) \<longrightarrow> ( *p* P) n"
  by transfer (induct_tac n, auto)

lemma hypnat_induct:
  "\<And>n. ( *p* P) (0::hypnat) \<Longrightarrow> (\<And>n. ( *p* P) n \<Longrightarrow> ( *p* P) (n + 1)) \<Longrightarrow> ( *p* P) n"
  by transfer (induct_tac n, auto)

lemma starP2_eq_iff: "( *p2* (op =)) = (op =)"
  by transfer (rule refl)

lemma starP2_eq_iff2: "( *p2* (\<lambda>x y. x = y)) X Y \<longleftrightarrow> X = Y"
  by (simp add: starP2_eq_iff)

lemma nonempty_nat_set_Least_mem: "c \<in> S \<Longrightarrow> (LEAST n. n \<in> S) \<in> S"
  for S :: "nat set"
  by (erule LeastI)

lemma nonempty_set_star_has_least:
  "\<And>S::nat set star. Iset S \<noteq> {} \<Longrightarrow> \<exists>n \<in> Iset S. \<forall>m \<in> Iset S. n \<le> m"
  apply (transfer empty_def)
  apply (rule_tac x="LEAST n. n \<in> S" in bexI)
   apply (simp add: Least_le)
  apply (rule LeastI_ex, auto)
  done

lemma nonempty_InternalNatSet_has_least: "S \<in> InternalSets \<Longrightarrow> S \<noteq> {} \<Longrightarrow> \<exists>n \<in> S. \<forall>m \<in> S. n \<le> m"
  for S :: "hypnat set"
  apply (clarsimp simp add: InternalSets_def starset_n_def)
  apply (erule nonempty_set_star_has_least)
  done

text \<open>Goldblatt, page 129 Thm 11.3.2.\<close>
lemma internal_induct_lemma:
  "\<And>X::nat set star.
    (0::hypnat) \<in> Iset X \<Longrightarrow> \<forall>n. n \<in> Iset X \<longrightarrow> n + 1 \<in> Iset X \<Longrightarrow> Iset X = (UNIV:: hypnat set)"
  apply (transfer UNIV_def)
  apply (rule equalityI [OF subset_UNIV subsetI])
  apply (induct_tac x, auto)
  done

lemma internal_induct:
  "X \<in> InternalSets \<Longrightarrow> (0::hypnat) \<in> X \<Longrightarrow> \<forall>n. n \<in> X \<longrightarrow> n + 1 \<in> X \<Longrightarrow> X = (UNIV:: hypnat set)"
  apply (clarsimp simp add: InternalSets_def starset_n_def)
  apply (erule (1) internal_induct_lemma)
  done

end


(*  Title:      HOL/Nonstandard_Analysis/CLim.thy
    Author:     Jacques D. Fleuriot
    Copyright:  2001 University of Edinburgh
    Conversion to Isar and new proofs by Lawrence C Paulson, 2004
*)

section \<open>Limits, Continuity and Differentiation for Complex Functions\<close>

theory CLim
  imports CStar
begin

(*not in simpset?*)
declare epsilon_not_zero [simp]

(*??generalize*)
lemma lemma_complex_mult_inverse_squared [simp]: "x \<noteq> 0 \<Longrightarrow> x * (inverse x)\<^sup>2 = inverse x"
  for x :: complex
  by (simp add: numeral_2_eq_2)

text \<open>Changing the quantified variable. Install earlier?\<close>
lemma all_shift: "(\<forall>x::'a::comm_ring_1. P x) \<longleftrightarrow> (\<forall>x. P (x - a))"
  apply auto
  apply (drule_tac x = "x + a" in spec)
  apply (simp add: add.assoc)
  done

lemma complex_add_minus_iff [simp]: "x + - a = 0 \<longleftrightarrow> x = a"
  for x a :: complex
  by (simp add: diff_eq_eq)

lemma complex_add_eq_0_iff [iff]: "x + y = 0 \<longleftrightarrow> y = - x"
  for x y :: complex
  apply auto
  apply (drule sym [THEN diff_eq_eq [THEN iffD2]])
  apply auto
  done

subsection \<open>Limit of Complex to Complex Function\<close>

lemma NSLIM_Re: "f \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S L \<Longrightarrow> (\<lambda>x. Re (f x)) \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S Re L"
  by (simp add: NSLIM_def starfunC_approx_Re_Im_iff hRe_hcomplex_of_complex)

lemma NSLIM_Im: "f \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S L \<Longrightarrow> (\<lambda>x. Im (f x)) \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S Im L"
  by (simp add: NSLIM_def starfunC_approx_Re_Im_iff hIm_hcomplex_of_complex)

lemma LIM_Re: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> (\<lambda>x. Re (f x)) \<midarrow>a\<rightarrow> Re L"
  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  by (simp add: LIM_NSLIM_iff NSLIM_Re)

lemma LIM_Im: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> (\<lambda>x. Im (f x)) \<midarrow>a\<rightarrow> Im L"
  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  by (simp add: LIM_NSLIM_iff NSLIM_Im)

lemma LIM_cnj: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> (\<lambda>x. cnj (f x)) \<midarrow>a\<rightarrow> cnj L"
  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  by (simp add: LIM_eq complex_cnj_diff [symmetric] del: complex_cnj_diff)

lemma LIM_cnj_iff: "((\<lambda>x. cnj (f x)) \<midarrow>a\<rightarrow> cnj L) \<longleftrightarrow> f \<midarrow>a\<rightarrow> L"
  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  by (simp add: LIM_eq complex_cnj_diff [symmetric] del: complex_cnj_diff)

lemma starfun_norm: "( *f* (\<lambda>x. norm (f x))) = (\<lambda>x. hnorm (( *f* f) x))"
  by transfer (rule refl)

lemma star_of_Re [simp]: "star_of (Re x) = hRe (star_of x)"
  by transfer (rule refl)

lemma star_of_Im [simp]: "star_of (Im x) = hIm (star_of x)"
  by transfer (rule refl)

text \<open>Another equivalence result.\<close>
lemma NSCLIM_NSCRLIM_iff: "f \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S L \<longleftrightarrow> (\<lambda>y. cmod (f y - L)) \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S 0"
  by (simp add: NSLIM_def starfun_norm
      approx_approx_zero_iff [symmetric] approx_minus_iff [symmetric])

text \<open>Much, much easier standard proof.\<close>
lemma CLIM_CRLIM_iff: "f \<midarrow>x\<rightarrow> L \<longleftrightarrow> (\<lambda>y. cmod (f y - L)) \<midarrow>x\<rightarrow> 0"
  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  by (simp add: LIM_eq)

text \<open>So this is nicer nonstandard proof.\<close>
lemma NSCLIM_NSCRLIM_iff2: "f \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S L \<longleftrightarrow> (\<lambda>y. cmod (f y - L)) \<midarrow>x\<rightarrow>\<^sub>N\<^sub>S 0"
  by (simp add: LIM_NSLIM_iff [symmetric] CLIM_CRLIM_iff)

lemma NSLIM_NSCRLIM_Re_Im_iff:
  "f \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S L \<longleftrightarrow> (\<lambda>x. Re (f x)) \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S Re L \<and> (\<lambda>x. Im (f x)) \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S Im L"
  apply (auto intro: NSLIM_Re NSLIM_Im)
  apply (auto simp add: NSLIM_def starfun_Re starfun_Im)
  apply (auto dest!: spec)
  apply (simp add: hcomplex_approx_iff)
  done

lemma LIM_CRLIM_Re_Im_iff: "f \<midarrow>a\<rightarrow> L \<longleftrightarrow> (\<lambda>x. Re (f x)) \<midarrow>a\<rightarrow> Re L \<and> (\<lambda>x. Im (f x)) \<midarrow>a\<rightarrow> Im L"
  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  by (simp add: LIM_NSLIM_iff NSLIM_NSCRLIM_Re_Im_iff)

subsection \<open>Continuity\<close>

lemma NSLIM_isContc_iff: "f \<midarrow>a\<rightarrow>\<^sub>N\<^sub>S f a \<longleftrightarrow> (\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow>\<^sub>N\<^sub>S f a"
  by (rule NSLIM_at0_iff)

subsection \<open>Functions from Complex to Reals\<close>

lemma isNSContCR_cmod [simp]: "isNSCont cmod a"
  by (auto intro: approx_hnorm
      simp: starfunCR_cmod hcmod_hcomplex_of_complex [symmetric] isNSCont_def)

lemma isContCR_cmod [simp]: "isCont cmod a"
  by (simp add: isNSCont_isCont_iff [symmetric])

lemma isCont_Re: "isCont f a \<Longrightarrow> isCont (\<lambda>x. Re (f x)) a"
  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  by (simp add: isCont_def LIM_Re)

lemma isCont_Im: "isCont f a \<Longrightarrow> isCont (\<lambda>x. Im (f x)) a"
  for f :: "'a::real_normed_vector \<Rightarrow> complex"
  by (simp add: isCont_def LIM_Im)

subsection \<open>Differentiation of Natural Number Powers\<close>

lemma CDERIV_pow [simp]: "DERIV (\<lambda>x. x ^ n) x :> complex_of_real (real n) * (x ^ (n - Suc 0))"
  apply (induct n)
   apply (drule_tac [2] DERIV_ident [THEN DERIV_mult])
   apply (auto simp add: distrib_right of_nat_Suc)
  apply (case_tac "n")
   apply (auto simp add: ac_simps)
  done

text \<open>Nonstandard version.\<close>
lemma NSCDERIV_pow: "NSDERIV (\<lambda>x. x ^ n) x :> complex_of_real (real n) * (x ^ (n - 1))"
  by (metis CDERIV_pow NSDERIV_DERIV_iff One_nat_def)

text \<open>Can't relax the premise \<^term>\<open>x \<noteq> 0\<close>: it isn't continuous at zero.\<close>
lemma NSCDERIV_inverse: "x \<noteq> 0 \<Longrightarrow> NSDERIV (\<lambda>x. inverse x) x :> - (inverse x)\<^sup>2"
  for x :: complex
  unfolding numeral_2_eq_2 by (rule NSDERIV_inverse)

lemma CDERIV_inverse: "x \<noteq> 0 \<Longrightarrow> DERIV (\<lambda>x. inverse x) x :> - (inverse x)\<^sup>2"
  for x :: complex
  unfolding numeral_2_eq_2 by (rule DERIV_inverse)

subsection \<open>Derivative of Reciprocals (Function \<^term>\<open>inverse\<close>)\<close>

lemma CDERIV_inverse_fun:
  "DERIV f x :> d \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> DERIV (\<lambda>x. inverse (f x)) x :> - (d * inverse ((f x)\<^sup>2))"
  for x :: complex
  unfolding numeral_2_eq_2 by (rule DERIV_inverse_fun)

lemma NSCDERIV_inverse_fun:
  "NSDERIV f x :> d \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> NSDERIV (\<lambda>x. inverse (f x)) x :> - (d * inverse ((f x)\<^sup>2))"
  for x :: complex
  unfolding numeral_2_eq_2 by (rule NSDERIV_inverse_fun)

subsection \<open>Derivative of Quotient\<close>

lemma CDERIV_quotient:
  "DERIV f x :> d \<Longrightarrow> DERIV g x :> e \<Longrightarrow> g(x) \<noteq> 0 \<Longrightarrow>
    DERIV (\<lambda>y. f y / g y) x :> (d * g x - (e * f x)) / (g x)\<^sup>2"
  for x :: complex
  unfolding numeral_2_eq_2 by (rule DERIV_quotient)

lemma NSCDERIV_quotient:
  "NSDERIV f x :> d \<Longrightarrow> NSDERIV g x :> e \<Longrightarrow> g x \<noteq> (0::complex) \<Longrightarrow>
    NSDERIV (\<lambda>y. f y / g y) x :> (d * g x - (e * f x)) / (g x)\<^sup>2"
  unfolding numeral_2_eq_2 by (rule NSDERIV_quotient)

subsection \<open>Caratheodory Formulation of Derivative at a Point: Standard Proof\<close>

lemma CARAT_CDERIVD:
  "(\<forall>z. f z - f x = g z * (z - x)) \<and> isNSCont g x \<and> g x = l \<Longrightarrow> NSDERIV f x :> l"
  by clarify (rule CARAT_DERIVD)

end


(*
  File:     Gaussian_Integers_Pythagorean_Triples.thy
  Author:   Manuel Eberl, TU München

  Application of Gaussian integers to deriving Euclid's formula for primitive Pythagorean triples
*)
subsection \<open>Primitive Pythagorean triples\<close>
theory Gaussian_Integers_Pythagorean_Triples
  imports Gaussian_Integers
begin

text \<open>
  In this section, we derive Euclid's formula for primitive Pythagorean triples using
  Gaussian integers, following Stillwell~\cite{stillwell}.
\<close>
definition prim_pyth_triple :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
  "prim_pyth_triple x y z \<longleftrightarrow> x > 0 \<and> y > 0 \<and> coprime x y \<and> x\<^sup>2 + y\<^sup>2 = z\<^sup>2"

lemma prim_pyth_triple_commute: "prim_pyth_triple x y z \<longleftrightarrow> prim_pyth_triple y x z"
  by (simp add: prim_pyth_triple_def coprime_commute add_ac conj_ac)

lemma prim_pyth_triple_aux:
  fixes u v :: nat
  assumes "v \<le> u"
  shows "(2 * u * v) ^ 2 + (u ^ 2 - v ^ 2) ^ 2 = (u ^ 2 + v ^ 2) ^ 2"
proof -
  have "int ((2 * u * v) ^ 2 + (u ^ 2 - v ^ 2) ^ 2) =
        (2 * int u * int v) ^ 2 + (int u ^ 2 - int v ^ 2) ^ 2"
    using assms by (simp add: of_nat_diff)
  also have "\<dots> = (int u ^ 2 + int v ^ 2) ^ 2"
    by (simp add: power2_eq_square algebra_simps)
  also have "\<dots> = int ((u ^ 2 + v ^ 2) ^ 2)"
    by simp
  finally show ?thesis
    by (simp only: of_nat_eq_iff)
qed

lemma prim_pyth_tripleI1:
  assumes "0 < v" "v < u" "coprime u v" "\<not>(odd u \<and> odd v)"
  shows   "prim_pyth_triple (2 * u * v) (u\<^sup>2 - v\<^sup>2) (u\<^sup>2 + v\<^sup>2)"
proof -
  have "v ^ 2 < u ^ 2"
    using assms by (intro power_strict_mono) auto
  hence "\<not>u ^ 2 < v ^ 2" by linarith

  from assms have "coprime (int u) (int v ^ 2)"
    by auto
  hence "coprime (int u) (int u * int u + (-(int v ^ 2)))"
    unfolding coprime_iff_gcd_eq_1 by (subst gcd_add_mult) auto
  also have "int u * int u + (-(int v ^ 2)) = int (u ^ 2 - v ^ 2)"
    using \<open>v < u\<close> by (simp add: of_nat_diff flip: power2_eq_square)
  finally have coprime1: "coprime u (u ^ 2 - v ^ 2)"
    by auto

  from assms have "coprime (int v) (int u ^ 2)"
    by (auto simp: coprime_commute)
  hence "coprime (int v) ((-int v) * int v + int u ^ 2)"
    unfolding coprime_iff_gcd_eq_1 by (subst gcd_add_mult) auto
  also have "(-int v) * int v + int u ^ 2 = int (u ^ 2 - v ^ 2)"
    using \<open>v < u\<close> by (simp add: of_nat_diff flip: power2_eq_square)
  finally have coprime2: "coprime v (u ^ 2 - v ^ 2)"
    by auto

  have "(2 * u * v) ^ 2 + (u ^ 2 - v ^ 2) ^ 2 = (u ^ 2 + v ^ 2) ^ 2"
    using \<open>v < u\<close> by (intro prim_pyth_triple_aux) auto
  moreover have "coprime (2 * u * v) (u ^ 2 - v ^ 2)"
    using assms \<open>\<not>u ^ 2 < v ^ 2\<close> coprime1 coprime2 by auto
  ultimately show ?thesis using assms \<open>v ^ 2 < u ^ 2\<close>
    by (simp add: prim_pyth_triple_def)
qed

lemma prim_pyth_tripleI2:
  assumes "0 < v" "v < u" "coprime u v" "\<not>(odd u \<and> odd v)"
  shows   "prim_pyth_triple (u\<^sup>2 - v\<^sup>2) (2 * u * v) (u\<^sup>2 + v\<^sup>2)"
  using prim_pyth_tripleI1[OF assms] by (simp add: prim_pyth_triple_commute)

lemma primitive_pythagorean_tripleE_int:
  assumes "z ^ 2 = x ^ 2 + y ^ 2"
  assumes "coprime x y"
  obtains u v :: int
    where "coprime u v" and "\<not>(odd u \<and> odd v)"
      and "x = 2 * u * v \<and> y = u\<^sup>2 - v\<^sup>2  \<or>  x = u\<^sup>2 - v\<^sup>2 \<and> y = 2 * u * v"
proof -
  have "\<not>(even x \<and> even y)"
    using not_coprimeI[of 2 x y] \<open>coprime x y\<close> by auto
  moreover have "\<not>(odd x \<and> odd y)"
  proof safe
    assume "odd x" "odd y"
    hence "[x ^ 2 + y ^ 2 = 1 + 1] (mod 4)"
      by (intro cong_add odd_square_cong_4_int)
    hence "[z ^ 2 = 2] (mod 4)"
      by (simp add: assms)
    moreover have "[z ^ 2 = 0] (mod 4) \<or> [z ^ 2 = 1] (mod 4)"
      using even_square_cong_4_int[of z] odd_square_cong_4_int[of z]
      by (cases "even z") auto
    ultimately show False
      by (auto simp: cong_def)
  qed
  ultimately have "even y \<longleftrightarrow> odd x"
    by blast

  have "even z \<longleftrightarrow> even (z ^ 2)"
    by auto
  also have "even (z ^ 2) \<longleftrightarrow> even (x ^ 2 + y ^ 2)"
    by (subst assms(1)) auto
  finally have "odd z"
    by (cases "even x") (auto simp: \<open>even y \<longleftrightarrow> \<not>even x\<close>)

  define t where "t = of_int x + \<i>\<^sub>\<int> * of_int y"
  from assms have t_mult_cnj: "t * gauss_cnj t = of_int z ^ 2"
    by (simp add: t_def power2_eq_square algebra_simps flip: of_int_mult of_int_add)

  have "gauss_int_norm t = z ^ 2"
    by (simp add: gauss_int_norm_def t_def assms)
  with \<open>coprime x y\<close> and \<open>odd z\<close> have "coprime t (gauss_cnj t)"
    by (intro coprime_self_gauss_cnj)
       (auto simp: t_def gauss_int_norm_def assms(1) [symmetric] even_nat_iff)
  moreover have "is_square (t * gauss_cnj t)"
    by (subst t_mult_cnj) auto
  hence "is_nth_power_upto_unit 2 (t * gauss_cnj t)"
    by (auto intro: is_nth_power_upto_unit_base)
  ultimately have "is_nth_power_upto_unit 2 t"
    by (rule is_nth_power_upto_unit_mult_coprimeD1)
  then obtain a b where ab: "is_unit a" "a * t = b ^ 2"
    by (auto simp: is_nth_power_upto_unit_def is_nth_power_def)
  from ab(1) have "a \<in> {1, -1, \<i>\<^sub>\<int>, -\<i>\<^sub>\<int>}"
    by (auto simp: is_unit_gauss_int_iff)
  then obtain u v :: int where "ReZ t = 2 * u * v \<and> ImZ t = u ^ 2 - v ^ 2 \<or>
                                ImZ t = 2 * u * v \<and> ReZ t = u ^ 2 - v ^ 2"
  proof safe
    assume [simp]: "a = 1"
    have "ReZ t = ReZ b ^ 2 - ImZ b ^ 2" "ImZ t = 2 * ReZ b * ImZ b" using ab(2)
      by (auto simp: gauss_int_eq_iff power2_eq_square)
    thus ?thesis using that by blast
  next
    assume [simp]: "a = -1"
    have "ReZ t = ImZ b ^ 2 - (-ReZ b) ^ 2" "ImZ t = 2 * ImZ b * (-ReZ b)" using ab(2)
      by (auto simp: gauss_int_eq_iff power2_eq_square algebra_simps)
    thus ?thesis using that by blast
  next
    assume [simp]: "a = \<i>\<^sub>\<int>"
    hence "ImZ t = ImZ b ^ 2 - ReZ b ^ 2" "ReZ t = 2 * ImZ b * ReZ b" using ab(2)
      by (auto simp: gauss_int_eq_iff power2_eq_square algebra_simps)
    thus ?thesis using that by blast
  next
    assume [simp]: "a = -\<i>\<^sub>\<int>"
    hence "ImZ t = (-ReZ b) ^ 2 - ImZ b ^ 2" "ReZ t = 2 * (-ReZ b) * ImZ b" using ab(2)
      by (auto simp: gauss_int_eq_iff power2_eq_square algebra_simps)
    thus ?thesis using that by blast
  qed
  also have "ReZ t = x"
    by (simp add: t_def)
  also have "ImZ t = y"
    by (simp add: t_def)
  finally have xy: "x = 2 * u * v \<and> y = u\<^sup>2 - v\<^sup>2 \<or> x = u\<^sup>2 - v\<^sup>2 \<and> y = 2 * u * v"
    by blast

  have not_both_odd: "\<not>(odd u \<and> odd v)"
  proof safe
    assume "odd u" "odd v"
    hence "even x" "even y"
      using xy by auto
    with \<open>coprime x y\<close> show False
      by auto
  qed

  have "coprime u v"
  proof (rule coprimeI)
    fix d assume "d dvd u" "d dvd v"
    hence "d dvd (u\<^sup>2 - v\<^sup>2)" "d dvd 2 * u * v"
      by (auto simp: power2_eq_square)
    with xy have "d dvd x" "d dvd y"
      by auto
    with \<open>coprime x y\<close> show "is_unit d"
      using not_coprimeI by blast
  qed
  with xy not_both_odd show ?thesis
    using that[of u v] by blast
qed

lemma prim_pyth_tripleE:
  assumes "prim_pyth_triple x y z"
  obtains u v :: nat
  where "0 < v" and "v < u" and "coprime u v" and "\<not>(odd u \<and> odd v)" and "z = u\<^sup>2 + v\<^sup>2"
    and "x = 2 * u * v \<and> y = u\<^sup>2 - v\<^sup>2  \<or>  x = u\<^sup>2 - v\<^sup>2 \<and> y = 2 * u * v"
proof -
  have *: "(int z) ^ 2 = (int x) ^ 2 + (int y) ^ 2" "coprime (int x) (int y)"
    using assms by (auto simp flip: of_nat_power of_nat_add simp: prim_pyth_triple_def)
  obtain u v
    where uv: "coprime u v" "\<not>(odd u \<and> odd v)"
              "int x = 2 * u * v \<and> int y = u\<^sup>2 - v\<^sup>2  \<or>  int x = u\<^sup>2 - v\<^sup>2 \<and> int y = 2 * u * v"
    using primitive_pythagorean_tripleE_int[OF *] by metis
  define u' v' where "u' = nat \<bar>u\<bar>" and "v' = nat \<bar>v\<bar>"

  have **: "a = 2 * u' * v'" if "int a = 2 * u * v" for a
  proof -
    from that have "nat \<bar>int a\<bar> = nat \<bar>2 * u * v\<bar>"
      by (simp only: )
    thus "a = 2 * u' * v'"
      by (simp add: u'_def v'_def abs_mult nat_mult_distrib)
  qed
  have ***: "a = u' ^ 2 - v' ^ 2" "v' \<le> u'" if "int a = u ^ 2 - v ^ 2" for a
  proof -
    have "v ^ 2 \<le> v ^ 2 + int a"
      by simp
    also have "\<dots> = u ^ 2"
      using that by simp
    finally have "\<bar>v\<bar> \<le> \<bar>u\<bar>"
      using abs_le_square_iff by blast
    thus "v' \<le> u'"
      by (simp add: v'_def u'_def)

    from that have "u ^ 2 = v ^ 2 + int a"
      by simp
    hence "nat \<bar>u ^ 2\<bar> = nat \<bar>v ^ 2 + int a\<bar>"
      by (simp only: )
    also have "nat \<bar>u ^ 2\<bar> = u' ^ 2"
      by (simp add: u'_def flip: nat_power_eq)
    also have "nat \<bar>v ^ 2 + int a\<bar> = v' ^ 2 + a"
      by (simp add: nat_add_distrib v'_def flip: nat_power_eq)
    finally show "a = u' ^ 2 - v' ^ 2"
      by simp
  qed

  have eq: "x = 2 * u' * v' \<and> y = u'\<^sup>2 - v'\<^sup>2  \<or>  x = u'\<^sup>2 - v'\<^sup>2 \<and> y = 2 * u' * v'" and "v' \<le> u'"
    using uv(3) **[of x] **[of y] ***[of x] ***[of y] by blast+
  moreover have "coprime u' v'"
    using \<open>coprime u v\<close>
    by (auto simp: u'_def v'_def)
  moreover have "\<not>(odd u' \<and> odd v')"
    using uv(2) by (auto simp: u'_def v'_def)
  moreover have "v' \<noteq> u'" "v' > 0"
    using \<open>coprime u' v'\<close> eq assms by (auto simp: prim_pyth_triple_def)
  moreover from this have "v' < u'"
    using \<open>v' \<le> u'\<close> by auto
  moreover have "z = u'\<^sup>2 + v'\<^sup>2"
  proof -
    from assms have "z ^ 2 = x ^ 2 + y ^ 2"
      by (simp add: prim_pyth_triple_def)
    also have "\<dots> = (2 * u' * v') ^ 2 + (u' ^ 2 - v' ^ 2) ^ 2"
      using eq by (auto simp: add_ac)
    also have "\<dots> = (u' ^ 2 + v' ^ 2) ^ 2"
      by (intro prim_pyth_triple_aux) fact
    finally show ?thesis by simp
  qed
  ultimately show ?thesis using that[of v' u'] by metis
qed

theorem prim_pyth_triple_iff:
  "prim_pyth_triple x y z \<longleftrightarrow>
     (\<exists>u v. 0 < v \<and> v < u \<and> coprime u v \<and> \<not>(odd u \<and> odd v) \<and>
            (x = 2 * u * v \<and> y = u\<^sup>2 - v\<^sup>2  \<or>  x = u\<^sup>2 - v\<^sup>2 \<and> y = 2 * u * v) \<and> z = u\<^sup>2 + v\<^sup>2)"
  (is "_ \<longleftrightarrow> ?rhs")
proof
  assume "prim_pyth_triple x y z"
  from prim_pyth_tripleE[OF this] show ?rhs by metis
next
  assume ?rhs
  then obtain u v where uv: "0 < v" "v < u" "coprime u v" "\<not>(odd u \<and> odd v)" "z = u\<^sup>2 + v\<^sup>2" and
                        eq: "x = 2 * u * v \<and> y = u\<^sup>2 - v\<^sup>2  \<or>  x = u\<^sup>2 - v\<^sup>2 \<and> y = 2 * u * v"
    by metis
  thus "prim_pyth_triple x y z"
    using uv prim_pyth_tripleI1[OF uv(1-4)] prim_pyth_tripleI2[OF uv(1-4)] uv(5) eq by auto
qed

end


(*  Title:      ZF/Induct/ListN.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1994  University of Cambridge
*)

section \<open>Lists of n elements\<close>

theory ListN imports ZF begin

text \<open>
  Inductive definition of lists of \<open>n\<close> elements; see
  @{cite "paulin-tlca"}.
\<close>

consts listn :: "i=>i"
inductive
  domains "listn(A)" \<subseteq> "nat \<times> list(A)"
  intros
    NilI: "<0,Nil> \<in> listn(A)"
    ConsI: "[| a \<in> A; <n,l> \<in> listn(A) |] ==> <succ(n), Cons(a,l)> \<in> listn(A)"
  type_intros nat_typechecks list.intros

lemma list_into_listn: "l \<in> list(A) ==> <length(l),l> \<in> listn(A)"
  by (induct set: list) (simp_all add: listn.intros)

lemma listn_iff: "<n,l> \<in> listn(A) \<longleftrightarrow> l \<in> list(A) & length(l)=n"
  apply (rule iffI)
   apply (erule listn.induct)
    apply auto
  apply (blast intro: list_into_listn)
  done

lemma listn_image_eq: "listn(A)``{n} = {l \<in> list(A). length(l)=n}"
  apply (rule equality_iffI)
  apply (simp add: listn_iff separation image_singleton_iff)
  done

lemma listn_mono: "A \<subseteq> B ==> listn(A) \<subseteq> listn(B)"
  apply (unfold listn.defs)
  apply (rule lfp_mono)
    apply (rule listn.bnd_mono)+
  apply (assumption | rule univ_mono Sigma_mono list_mono basic_monos)+
  done

lemma listn_append:
    "[| <n,l> \<in> listn(A); <n',l'> \<in> listn(A) |] ==> <n#+n', l@l'> \<in> listn(A)"
  apply (erule listn.induct)
   apply (frule listn.dom_subset [THEN subsetD])
   apply (simp_all add: listn.intros)
  done

inductive_cases
      Nil_listn_case: "<i,Nil> \<in> listn(A)"
  and Cons_listn_case: "<i,Cons(x,l)> \<in> listn(A)"

inductive_cases
      zero_listn_case: "<0,l> \<in> listn(A)"
  and succ_listn_case: "<succ(i),l> \<in> listn(A)"

end


theory Predicate_Compile_Quickcheck_Examples
imports "HOL-Library.Predicate_Compile_Quickcheck"
begin

(*
section {* Sets *}

lemma "x \<in> {(1::nat)} ==> False"
quickcheck[generator=predicate_compile_wo_ff, iterations=10]
oops

lemma "x \<in> {Suc 0, Suc (Suc 0)} ==> x \<noteq> Suc 0"
quickcheck[generator=predicate_compile_wo_ff]
oops

lemma "x \<in> {Suc 0, Suc (Suc 0)} ==> x = Suc 0"
quickcheck[generator=predicate_compile_wo_ff]
oops

lemma "x \<in> {Suc 0, Suc (Suc 0)} ==> x <= Suc 0"
quickcheck[generator=predicate_compile_wo_ff]
oops

section {* Numerals *}

lemma
  "x \<in> {1, 2, (3::nat)} ==> x = 1 \<or> x = 2"
quickcheck[generator=predicate_compile_wo_ff]
oops

lemma "x \<in> {1, 2, (3::nat)} ==> x < 3"
quickcheck[generator=predicate_compile_wo_ff]
oops

lemma
  "x \<in> {1, 2} \<union> {3, 4} ==> x = (1::nat) \<or> x = (2::nat)"
quickcheck[generator=predicate_compile_wo_ff]
oops
*)

section \<open>Equivalences\<close>

inductive is_ten :: "nat => bool"
where
  "is_ten 10"

inductive is_eleven :: "nat => bool"
where
  "is_eleven 11"

lemma
  "is_ten x = is_eleven x"
quickcheck[tester = smart_exhaustive, iterations = 1, size = 1, expect = counterexample]
oops

section \<open>Context Free Grammar\<close>

datatype alphabet = a | b

inductive_set S\<^sub>1 and A\<^sub>1 and B\<^sub>1 where
  "[] \<in> S\<^sub>1"
| "w \<in> A\<^sub>1 \<Longrightarrow> b # w \<in> S\<^sub>1"
| "w \<in> B\<^sub>1 \<Longrightarrow> a # w \<in> S\<^sub>1"
| "w \<in> S\<^sub>1 \<Longrightarrow> a # w \<in> A\<^sub>1"
| "w \<in> S\<^sub>1 \<Longrightarrow> b # w \<in> S\<^sub>1"
| "\<lbrakk>v \<in> B\<^sub>1; v \<in> B\<^sub>1\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^sub>1"

lemma
  "S\<^sub>1p w \<Longrightarrow> w = []"
quickcheck[tester = smart_exhaustive, iterations=1]
oops

theorem S\<^sub>1_sound:
"S\<^sub>1p w \<Longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
quickcheck[tester=smart_exhaustive, size=15]
oops

inductive_set S\<^sub>2 and A\<^sub>2 and B\<^sub>2 where
  "[] \<in> S\<^sub>2"
| "w \<in> A\<^sub>2 \<Longrightarrow> b # w \<in> S\<^sub>2"
| "w \<in> B\<^sub>2 \<Longrightarrow> a # w \<in> S\<^sub>2"
| "w \<in> S\<^sub>2 \<Longrightarrow> a # w \<in> A\<^sub>2"
| "w \<in> S\<^sub>2 \<Longrightarrow> b # w \<in> B\<^sub>2"
| "\<lbrakk>v \<in> B\<^sub>2; v \<in> B\<^sub>2\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^sub>2"
(*
code_pred [random_dseq inductify] S\<^sub>2 .
thm S\<^sub>2.random_dseq_equation
thm A\<^sub>2.random_dseq_equation
thm B\<^sub>2.random_dseq_equation

values [random_dseq 1, 2, 8] 10 "{x. S\<^sub>2 x}"

lemma "w \<in> S\<^sub>2 ==> w \<noteq> [] ==> w \<noteq> [b, a] ==> w \<in> {}"
quickcheck[generator=predicate_compile, size=8]
oops

lemma "[x <- w. x = a] = []"
quickcheck[generator=predicate_compile]
oops

declare list.size(3,4)[code_pred_def]

(*
lemma "length ([x \<leftarrow> w. x = a]) = (0::nat)"
quickcheck[generator=predicate_compile]
oops
*)

lemma
"w \<in> S\<^sub>2 ==> length [x \<leftarrow> w. x = a] <= Suc (Suc 0)"
quickcheck[generator=predicate_compile, size = 10, iterations = 1]
oops
*)
theorem S\<^sub>2_sound:
"S\<^sub>2p w \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
quickcheck[tester=smart_exhaustive, size=5, iterations=10]
oops

inductive_set S\<^sub>3 and A\<^sub>3 and B\<^sub>3 where
  "[] \<in> S\<^sub>3"
| "w \<in> A\<^sub>3 \<Longrightarrow> b # w \<in> S\<^sub>3"
| "w \<in> B\<^sub>3 \<Longrightarrow> a # w \<in> S\<^sub>3"
| "w \<in> S\<^sub>3 \<Longrightarrow> a # w \<in> A\<^sub>3"
| "w \<in> S\<^sub>3 \<Longrightarrow> b # w \<in> B\<^sub>3"
| "\<lbrakk>v \<in> B\<^sub>3; w \<in> B\<^sub>3\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^sub>3"

code_pred [inductify, skip_proof] S\<^sub>3p .
thm S\<^sub>3p.equation
(*
values 10 "{x. S\<^sub>3 x}"
*)

lemma S\<^sub>3_sound:
"S\<^sub>3p w \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
quickcheck[tester=smart_exhaustive, size=10, iterations=10]
oops

lemma "\<not> (length w > 2) \<or> \<not> (length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b])"
quickcheck[size=10, tester = smart_exhaustive]
oops

theorem S\<^sub>3_complete:
"length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. b = x] \<longrightarrow> S\<^sub>3p w"
(*quickcheck[generator=SML]*)
quickcheck[tester=smart_exhaustive, size=10, iterations=100]
oops

inductive_set S\<^sub>4 and A\<^sub>4 and B\<^sub>4 where
  "[] \<in> S\<^sub>4"
| "w \<in> A\<^sub>4 \<Longrightarrow> b # w \<in> S\<^sub>4"
| "w \<in> B\<^sub>4 \<Longrightarrow> a # w \<in> S\<^sub>4"
| "w \<in> S\<^sub>4 \<Longrightarrow> a # w \<in> A\<^sub>4"
| "\<lbrakk>v \<in> A\<^sub>4; w \<in> A\<^sub>4\<rbrakk> \<Longrightarrow> b # v @ w \<in> A\<^sub>4"
| "w \<in> S\<^sub>4 \<Longrightarrow> b # w \<in> B\<^sub>4"
| "\<lbrakk>v \<in> B\<^sub>4; w \<in> B\<^sub>4\<rbrakk> \<Longrightarrow> a # v @ w \<in> B\<^sub>4"

theorem S\<^sub>4_sound:
"S\<^sub>4p w \<longrightarrow> length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b]"
quickcheck[tester = smart_exhaustive, size=5, iterations=1]
oops

theorem S\<^sub>4_complete:
"length [x \<leftarrow> w. x = a] = length [x \<leftarrow> w. x = b] \<longrightarrow> S\<^sub>4p w"
quickcheck[tester = smart_exhaustive, size=5, iterations=1]
oops

hide_const a b

subsection \<open>Lexicographic order\<close>
(* TODO *)
(*
lemma
  "(u, v) : lexord r ==> (x @ u, y @ v) : lexord r"
oops
*)
subsection \<open>IMP\<close>

type_synonym var = nat
type_synonym state = "int list"

datatype com =
  Skip |
  Ass var "int" |
  Seq com com |
  IF "state list" com com |
  While "state list" com

inductive exec :: "com => state => state => bool" where
  "exec Skip s s" |
  "exec (Ass x e) s (s[x := e])" |
  "exec c1 s1 s2 ==> exec c2 s2 s3 ==> exec (Seq c1 c2) s1 s3" |
  "s \<in> set b ==> exec c1 s t ==> exec (IF b c1 c2) s t" |
  "s \<notin> set b ==> exec c2 s t ==> exec (IF b c1 c2) s t" |
  "s \<notin> set b ==> exec (While b c) s s" |
  "s1 \<in> set b ==> exec c s1 s2 ==> exec (While b c) s2 s3 ==> exec (While b c) s1 s3"

code_pred [random_dseq] exec .

values [random_dseq 1, 2, 3] 10 "{(c, s, s'). exec c s s'}"

lemma
  "exec c s s' ==> exec (Seq c c) s s'"
  quickcheck[tester = smart_exhaustive, size=2, iterations=20, expect = counterexample]
oops

subsection \<open>Lambda\<close>

datatype type =
    Atom nat
  | Fun type type    (infixr "\<Rightarrow>" 200)

datatype dB =
    Var nat
  | App dB dB (infixl "\<degree>" 200)
  | Abs type dB

primrec
  nth_el :: "'a list \<Rightarrow> nat \<Rightarrow> 'a option" ("_\<langle>_\<rangle>" [90, 0] 91)
where
  "[]\<langle>i\<rangle> = None"
| "(x # xs)\<langle>i\<rangle> = (case i of 0 \<Rightarrow> Some x | Suc j \<Rightarrow> xs \<langle>j\<rangle>)"

inductive nth_el' :: "'a list \<Rightarrow> nat \<Rightarrow> 'a \<Rightarrow> bool"
where
  "nth_el' (x # xs) 0 x"
| "nth_el' xs i y \<Longrightarrow> nth_el' (x # xs) (Suc i) y"

inductive typing :: "type list \<Rightarrow> dB \<Rightarrow> type \<Rightarrow> bool"  ("_ \<turnstile> _ : _" [50, 50, 50] 50)
  where
    Var [intro!]: "nth_el' env x T \<Longrightarrow> env \<turnstile> Var x : T"
  | Abs [intro!]: "T # env \<turnstile> t : U \<Longrightarrow> env \<turnstile> Abs T t : (T \<Rightarrow> U)"
  | App [intro!]: "env \<turnstile> s : U \<Rightarrow> T \<Longrightarrow> env \<turnstile> t : T \<Longrightarrow> env \<turnstile> (s \<degree> t) : U"

primrec
  lift :: "[dB, nat] => dB"
where
    "lift (Var i) k = (if i < k then Var i else Var (i + 1))"
  | "lift (s \<degree> t) k = lift s k \<degree> lift t k"
  | "lift (Abs T s) k = Abs T (lift s (k + 1))"

primrec
  subst :: "[dB, dB, nat] => dB"  ("_[_'/_]" [300, 0, 0] 300)
where
    subst_Var: "(Var i)[s/k] =
      (if k < i then Var (i - 1) else if i = k then s else Var i)"
  | subst_App: "(t \<degree> u)[s/k] = t[s/k] \<degree> u[s/k]"
  | subst_Abs: "(Abs T t)[s/k] = Abs T (t[lift s 0 / k+1])"

inductive beta :: "[dB, dB] => bool"  (infixl "\<rightarrow>\<^sub>\<beta>" 50)
  where
    beta [simp, intro!]: "Abs T s \<degree> t \<rightarrow>\<^sub>\<beta> s[t/0]"
  | appL [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> s \<degree> u \<rightarrow>\<^sub>\<beta> t \<degree> u"
  | appR [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> u \<degree> s \<rightarrow>\<^sub>\<beta> u \<degree> t"
  | abs [simp, intro!]: "s \<rightarrow>\<^sub>\<beta> t ==> Abs T s \<rightarrow>\<^sub>\<beta> Abs T t"

lemma
  "\<Gamma> \<turnstile> t : U \<Longrightarrow> t \<rightarrow>\<^sub>\<beta> t' \<Longrightarrow> \<Gamma> \<turnstile> t' : U"
quickcheck[tester = smart_exhaustive, size = 7, iterations = 10]
oops

subsection \<open>JAD\<close>

definition matrix :: "('a :: semiring_0) list list \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
  "matrix M rs cs \<longleftrightarrow> (\<forall> row \<in> set M. length row = cs) \<and> length M = rs"
(*
code_pred [random_dseq inductify] matrix .
thm matrix.random_dseq_equation

thm matrix_aux.random_dseq_equation

values [random_dseq 3, 2] 10 "{(M, rs, cs). matrix (M:: int list list) rs cs}"
*)
lemma [code_pred_intro]:
  "matrix [] 0 m"
  "matrix xss n m ==> length xs = m ==> matrix (xs # xss) (Suc n) m"
proof -
  show "matrix [] 0 m" unfolding matrix_def by auto
next
  show "matrix xss n m ==> length xs = m ==> matrix (xs # xss) (Suc n) m"
    unfolding matrix_def by auto
qed

code_pred [random_dseq] matrix
  apply (cases x)
  unfolding matrix_def apply fastforce
  apply fastforce done

values [random_dseq 2, 2, 15] 6 "{(M::int list list, n, m). matrix M n m}"

definition "scalar_product v w = (\<Sum> (x, y)\<leftarrow>zip v w. x * y)"

definition mv :: "('a :: semiring_0) list list \<Rightarrow> 'a list \<Rightarrow> 'a list"
  where [simp]: "mv M v = map (scalar_product v) M"
text \<open>
  This defines the matrix vector multiplication. To work properly \<^term>\<open>matrix M m n \<and> length v = n\<close> must hold.
\<close>

subsection "Compressed matrix"

definition "sparsify xs = [i \<leftarrow> zip [0..<length xs] xs. snd i \<noteq> 0]"
(*
lemma sparsify_length: "(i, x) \<in> set (sparsify xs) \<Longrightarrow> i < length xs"
  by (auto simp: sparsify_def set_zip)

lemma sum_list_sparsify[simp]:
  fixes v :: "('a :: semiring_0) list"
  assumes "length w = length v"
  shows "(\<Sum>x\<leftarrow>sparsify w. (\<lambda>(i, x). v ! i) x * snd x) = scalar_product v w"
    (is "(\<Sum>x\<leftarrow>_. ?f x) = _")
  unfolding sparsify_def scalar_product_def
  using assms sum_list_map_filter[where f="?f" and P="\<lambda> i. snd i \<noteq> (0::'a)"]
  by (simp add: sum_list_sum)
*)
definition [simp]: "unzip w = (map fst w, map snd w)"

primrec insert :: "('a \<Rightarrow> 'b :: linorder) => 'a \<Rightarrow> 'a list => 'a list" where
  "insert f x [] = [x]" |
  "insert f x (y # ys) = (if f y < f x then y # insert f x ys else x # y # ys)"

primrec sort :: "('a \<Rightarrow> 'b :: linorder) \<Rightarrow> 'a list => 'a list" where
  "sort f [] = []" |
  "sort f (x # xs) = insert f x (sort f xs)"

definition
  "length_permutate M = (unzip o sort (length o snd)) (zip [0 ..< length M] M)"
(*
definition
  "transpose M = [map (\<lambda> xs. xs ! i) (takeWhile (\<lambda> xs. i < length xs) M). i \<leftarrow> [0 ..< length (M ! 0)]]"
*)
definition
  "inflate upds = foldr (\<lambda> (i, x) upds. upds[i := x]) upds (replicate (length upds) 0)"

definition
  "jad = apsnd transpose o length_permutate o map sparsify"

definition
  "jad_mv v = inflate o case_prod zip o apsnd (map sum_list o transpose o map (map (\<lambda> (i, x). v ! i * x)))"

lemma "matrix (M::int list list) rs cs \<Longrightarrow> False"
quickcheck[tester = smart_exhaustive, size = 6]
oops

lemma
  "\<lbrakk> matrix M rs cs ; length v = cs \<rbrakk> \<Longrightarrow> jad_mv v (jad M) = mv M v"
quickcheck[tester = smart_exhaustive]
oops

end


(* Property from Case-Analysis for Rippling and Inductive Proof,
   Moa Johansson, Lucas Dixon and Alan Bundy, ITP 2010.
   This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.*)
  theory TIP_prop_41
imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

datatype Nat = Z | S "Nat"

fun take :: "Nat => 'a list => 'a list" where
"take (Z) y = nil2"
| "take (S z) (nil2) = nil2"
| "take (S z) (cons2 x2 x3) = cons2 x2 (take z x3)"

fun map :: "('a => 'b) => 'a list => 'b list" where
"map x (nil2) = nil2"
| "map x (cons2 z xs) = cons2 (x z) (map x xs)"

theorem property0 :
  "((take n (map f xs)) = (map f (take n xs)))"
  oops

end


(* This Isabelle theory is produced using the TIP tool offered at the following website:
     https://github.com/tip-org/tools
   This file was originally provided as part of TIP benchmark at the following website:
     https://github.com/tip-org/benchmarks
   Yutaka Nagashima at CIIRC, CTU changed the TIP output theory file slightly
   to make it compatible with Isabelle2017.
\:w
   Some proofs were added by Yutaka Nagashima.*)
  theory TIP_sort_ISortSorts
imports "../../Test_Base"
begin

datatype 'a list = nil2 | cons2 "'a" "'a list"

fun ordered :: "int list => bool" where
"ordered (nil2) = True"
| "ordered (cons2 y (nil2)) = True"
| "ordered (cons2 y (cons2 y2 xs)) =
     ((y <= y2) & (ordered (cons2 y2 xs)))"

fun insert :: "int => int list => int list" where
"insert x (nil2) = cons2 x (nil2)"
| "insert x (cons2 z xs) =
     (if x <= z then cons2 x (cons2 z xs) else cons2 z (insert x xs))"

fun isort :: "int list => int list" where
"isort (nil2) = nil2"
| "isort (cons2 y xs) = insert y (isort xs)"

theorem property0 :
  "ordered (isort xs)"
  oops

end