(*<*)
theory Types_and_funs
imports Main
begin
(*>*)
text\<open>
\vspace{-5ex}
\section{Type and Function Definitions}

Type synonyms are abbreviations for existing types, for example
\index{string@\<open>string\<close>}\<close>

type_synonym string = "char list"

text\<open>
Type synonyms are expanded after parsing and are not present in internal representation and output. They are mere conveniences for the reader.

\subsection{Datatypes}
\label{sec:datatypes}

The general form of a datatype definition looks like this:
\begin{quote}
\begin{tabular}{@ {}rclcll}
\indexed{\isacom{datatype}}{datatype} \<open>('a\<^sub>1,\<dots>,'a\<^sub>n)t\<close>
     & = & $C_1 \ \<open>"\<close>\tau_{1,1}\<open>"\<close> \dots \<open>"\<close>\tau_{1,n_1}\<open>"\<close>$ \\
     & $|$ & \dots \\
     & $|$ & $C_k \ \<open>"\<close>\tau_{k,1}\<open>"\<close> \dots \<open>"\<close>\tau_{k,n_k}\<open>"\<close>$
\end{tabular}
\end{quote}
It introduces the constructors \
$C_i :: \tau_{i,1}\Rightarrow \cdots \Rightarrow \tau_{i,n_i} \Rightarrow$~\<open>('a\<^sub>1,\<dots>,'a\<^sub>n)t\<close> \ and expresses that any value of this type is built from these constructors in a unique manner. Uniqueness is implied by the following
properties of the constructors:
\begin{itemize}
\item \emph{Distinctness:} $C_i\ \ldots \neq C_j\ \dots$ \quad if $i \neq j$
\item \emph{Injectivity:}
\begin{tabular}[t]{l}
 $(C_i \ x_1 \dots x_{n_i} = C_i \ y_1 \dots y_{n_i}) =$\\
 $(x_1 = y_1 \land \dots \land x_{n_i} = y_{n_i})$
\end{tabular}
\end{itemize}
The fact that any value of the datatype is built from the constructors implies
the \concept{structural induction}\index{induction} rule: to show
$P~x$ for all $x$ of type \<open>('a\<^sub>1,\<dots>,'a\<^sub>n)t\<close>,
one needs to show $P(C_i\ x_1 \dots x_{n_i})$ (for each $i$) assuming
$P(x_j)$ for all $j$ where $\tau_{i,j} =$~\<open>('a\<^sub>1,\<dots>,'a\<^sub>n)t\<close>.
Distinctness and injectivity are applied automatically by \<open>auto\<close>
and other proof methods. Induction must be applied explicitly.

Like in functional programming languages, datatype values can be taken apart
with case expressions\index{case expression}\index{case expression@\<open>case ... of\<close>}, for example
\begin{quote}
\noquotes{@{term[source] "(case xs of [] \<Rightarrow> 0 | x # _ \<Rightarrow> Suc x)"}}
\end{quote}
Case expressions must be enclosed in parentheses.

As an example of a datatype beyond \<^typ>\<open>nat\<close> and \<open>list\<close>, consider binary trees:
\<close>

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

text\<open>with a mirror function:\<close>

fun mirror :: "'a tree \<Rightarrow> 'a tree" where
"mirror Tip = Tip" |
"mirror (Node l a r) = Node (mirror r) a (mirror l)"

text\<open>The following lemma illustrates induction:\<close>

lemma "mirror(mirror t) = t"
apply(induction t)

txt\<open>yields
@{subgoals[display]}
The induction step contains two induction hypotheses, one for each subtree.
An application of \<open>auto\<close> finishes the proof.

A very simple but also very useful datatype is the predefined
@{datatype[display] option}\index{option@\<open>option\<close>}\index{None@\<^const>\<open>None\<close>}\index{Some@\<^const>\<open>Some\<close>}
Its sole purpose is to add a new element \<^const>\<open>None\<close> to an existing
type \<^typ>\<open>'a\<close>. To make sure that \<^const>\<open>None\<close> is distinct from all the
elements of \<^typ>\<open>'a\<close>, you wrap them up in \<^const>\<open>Some\<close> and call
the new type \<^typ>\<open>'a option\<close>. A typical application is a lookup function
on a list of key-value pairs, often called an association list:
\<close>
(*<*)
apply auto
done
(*>*)
fun lookup :: "('a * 'b) list \<Rightarrow> 'a \<Rightarrow> 'b option" where
"lookup [] x = None" |
"lookup ((a,b) # ps) x = (if a = x then Some b else lookup ps x)"

text\<open>
Note that \<open>\<tau>\<^sub>1 * \<tau>\<^sub>2\<close> is the type of pairs, also written \<open>\<tau>\<^sub>1 \<times> \<tau>\<^sub>2\<close>.
Pairs can be taken apart either by pattern matching (as above) or with the
projection functions \<^const>\<open>fst\<close> and \<^const>\<open>snd\<close>: @{thm fst_conv[of x y]} and @{thm snd_conv[of x y]}.
Tuples are simulated by pairs nested to the right: \<^term>\<open>(a,b,c)\<close>
is short for \<open>(a, (b, c))\<close> and \<open>\<tau>\<^sub>1 \<times> \<tau>\<^sub>2 \<times> \<tau>\<^sub>3\<close> is short for
\<open>\<tau>\<^sub>1 \<times> (\<tau>\<^sub>2 \<times> \<tau>\<^sub>3)\<close>.

\subsection{Definitions}

Non-recursive functions can be defined as in the following example:
\index{definition@\isacom{definition}}\<close>

definition sq :: "nat \<Rightarrow> nat" where
"sq n = n * n"

text\<open>Such definitions do not allow pattern matching but only
\<open>f x\<^sub>1 \<dots> x\<^sub>n = t\<close>, where \<open>f\<close> does not occur in \<open>t\<close>.

\subsection{Abbreviations}

Abbreviations are similar to definitions:
\index{abbreviation@\isacom{abbreviation}}\<close>

abbreviation sq' :: "nat \<Rightarrow> nat" where
"sq' n \<equiv> n * n"

text\<open>The key difference is that \<^const>\<open>sq'\<close> is only syntactic sugar:
after parsing, \<^term>\<open>sq' t\<close> is replaced by \mbox{\<^term>\<open>t*t\<close>};
before printing, every occurrence of \<^term>\<open>u*u\<close> is replaced by
\mbox{\<^term>\<open>sq' u\<close>}.  Internally, \<^const>\<open>sq'\<close> does not exist.
This is the
advantage of abbreviations over definitions: definitions need to be expanded
explicitly (\autoref{sec:rewr-defs}) whereas abbreviations are already
expanded upon parsing. However, abbreviations should be introduced sparingly:
if abused, they can lead to a confusing discrepancy between the internal and
external view of a term.

The ASCII representation of \<open>\<equiv>\<close> is \texttt{==} or \xsymbol{equiv}.

\subsection{Recursive Functions}
\label{sec:recursive-funs}

Recursive functions are defined with \indexed{\isacom{fun}}{fun} by pattern matching
over datatype constructors. The order of equations matters, as in
functional programming languages. However, all HOL functions must be
total. This simplifies the logic --- terms are always defined --- but means
that recursive functions must terminate. Otherwise one could define a
function \<^prop>\<open>f n = f n + (1::nat)\<close> and conclude \mbox{\<^prop>\<open>(0::nat) = 1\<close>} by
subtracting \<^term>\<open>f n\<close> on both sides.

Isabelle's automatic termination checker requires that the arguments of
recursive calls on the right-hand side must be strictly smaller than the
arguments on the left-hand side. In the simplest case, this means that one
fixed argument position decreases in size with each recursive call. The size
is measured as the number of constructors (excluding 0-ary ones, e.g., \<open>Nil\<close>). Lexicographic combinations are also recognized. In more complicated
situations, the user may have to prove termination by hand. For details
see~\<^cite>\<open>Krauss\<close>.

Functions defined with \isacom{fun} come with their own induction schema
that mirrors the recursion schema and is derived from the termination
order. For example,
\<close>

fun div2 :: "nat \<Rightarrow> nat" where
"div2 0 = 0" |
"div2 (Suc 0) = 0" |
"div2 (Suc(Suc n)) = Suc(div2 n)"

text\<open>does not just define \<^const>\<open>div2\<close> but also proves a
customized induction rule:
\[
\inferrule{
\mbox{@{thm (prem 1) div2.induct}}\\
\mbox{@{thm (prem 2) div2.induct}}\\
\mbox{@{thm (prem 3) div2.induct}}}
{\mbox{@{thm (concl) div2.induct[of _ "m"]}}}
\]
This customized induction rule can simplify inductive proofs. For example,
\<close>

lemma "div2 n = n div 2"
apply(induction n rule: div2.induct)

txt\<open>(where the infix \<open>div\<close> is the predefined division operation)
yields the subgoals
@{subgoals[display,margin=65]}
An application of \<open>auto\<close> finishes the proof.
Had we used ordinary structural induction on \<open>n\<close>,
the proof would have needed an additional
case analysis in the induction step.

This example leads to the following induction heuristic:
\begin{quote}
\emph{Let \<open>f\<close> be a recursive function.
If the definition of \<open>f\<close> is more complicated
than having one equation for each constructor of some datatype,
then properties of \<open>f\<close> are best proved via \<open>f.induct\<close>.\index{inductionrule@\<open>.induct\<close>}}
\end{quote}

The general case is often called \concept{computation induction},
because the induction follows the (terminating!) computation.
For every defining equation
\begin{quote}
\<open>f(e) = \<dots> f(r\<^sub>1) \<dots> f(r\<^sub>k) \<dots>\<close>
\end{quote}
where \<open>f(r\<^sub>i)\<close>, \<open>i=1\<dots>k\<close>, are all the recursive calls,
the induction rule \<open>f.induct\<close> contains one premise of the form
\begin{quote}
\<open>P(r\<^sub>1) \<Longrightarrow> \<dots> \<Longrightarrow> P(r\<^sub>k) \<Longrightarrow> P(e)\<close>
\end{quote}
If \<open>f :: \<tau>\<^sub>1 \<Rightarrow> \<dots> \<Rightarrow> \<tau>\<^sub>n \<Rightarrow> \<tau>\<close> then \<open>f.induct\<close> is applied like this:
\begin{quote}
\isacom{apply}\<open>(induction x\<^sub>1 \<dots> x\<^sub>n rule: f.induct)\<close>\index{inductionrule@\<open>induction ... rule:\<close>}
\end{quote}
where typically there is a call \<open>f x\<^sub>1 \<dots> x\<^sub>n\<close> in the goal.
But note that the induction rule does not mention \<open>f\<close> at all,
except in its name, and is applicable independently of \<open>f\<close>.

\subsection*{Exercises}

\begin{exercise}
Starting from the type \<open>'a tree\<close> defined in the text, define
a function \<open>contents ::\<close> \<^typ>\<open>'a tree \<Rightarrow> 'a list\<close>
that collects all values in a tree in a list, in any order,
without removing duplicates.
Then define a function \<open>sum_tree ::\<close> \<^typ>\<open>nat tree \<Rightarrow> nat\<close>
that sums up all values in a tree of natural numbers
and prove \<^prop>\<open>sum_tree t = sum_list(contents t)\<close>
where \<^const>\<open>sum_list\<close> is predefined by the equations
@{thm sum_list.Nil[where 'a=nat]} and
@{thm sum_list.Cons}.
\end{exercise}

\begin{exercise}
Define the two functions
\<open>pre_order\<close> and \<open>post_order\<close> of type @{typ "'a tree \<Rightarrow> 'a list"}
that traverse a tree and collect all stored values in the respective order in
a list. Prove \<^prop>\<open>pre_order (mirror t) = rev (post_order t)\<close>.
\end{exercise}

\begin{exercise}
Define a function \<open>intersperse ::\<close> \<^typ>\<open>'a \<Rightarrow> 'a list \<Rightarrow> 'a list\<close>
such that \<open>intersperse a [x\<^sub>1, ..., x\<^sub>n] = [x\<^sub>1, a, x\<^sub>2, a, ..., a, x\<^sub>n]\<close>.
Now prove that \<^prop>\<open>map f (intersperse a xs) = intersperse (f a) (map f xs)\<close>.
\end{exercise}

\section{Induction Heuristics}\index{induction heuristics}

We have already noted that theorems about recursive functions are proved by
induction. In case the function has more than one argument, we have followed
the following heuristic in the proofs about the append function:
\begin{quote}
\emph{Perform induction on argument number $i$\\
 if the function is defined by recursion on argument number $i$.}
\end{quote}
The key heuristic, and the main point of this section, is to
\emph{generalize the goal before induction}.
The reason is simple: if the goal is
too specific, the induction hypothesis is too weak to allow the induction
step to go through. Let us illustrate the idea with an example.

Function \<^const>\<open>rev\<close> has quadratic worst-case running time
because it calls append for each element of the list and
append is linear in its first argument.  A linear time version of
\<^const>\<open>rev\<close> requires an extra argument where the result is accumulated
gradually, using only~\<open>#\<close>:
\<close>
(*<*)
apply auto
done
(*>*)
fun itrev :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" where
"itrev []        ys = ys" |
"itrev (x#xs) ys = itrev xs (x#ys)"

text\<open>The behaviour of \<^const>\<open>itrev\<close> is simple: it reverses
its first argument by stacking its elements onto the second argument,
and it returns that second argument when the first one becomes
empty. Note that \<^const>\<open>itrev\<close> is tail-recursive: it can be
compiled into a loop; no stack is necessary for executing it.

Naturally, we would like to show that \<^const>\<open>itrev\<close> reverses its first argument:
\<close>

lemma "itrev xs [] = rev xs"

txt\<open>There is no choice as to the induction variable:
\<close>

apply(induction xs)
apply(auto)

txt\<open>
Unfortunately, this attempt does not prove
the induction step:
@{subgoals[display,margin=70]}
The induction hypothesis is too weak.  The fixed
argument,~\<^term>\<open>[]\<close>, prevents it from rewriting the conclusion.
This example suggests a heuristic:
\begin{quote}
\emph{Generalize goals for induction by replacing constants by variables.}
\end{quote}
Of course one cannot do this naively: \<^prop>\<open>itrev xs ys = rev xs\<close> is
just not true.  The correct generalization is
\<close>
(*<*)oops(*>*)
lemma "itrev xs ys = rev xs @ ys"
(*<*)apply(induction xs, auto)(*>*)
txt\<open>
If \<open>ys\<close> is replaced by \<^term>\<open>[]\<close>, the right-hand side simplifies to
\<^term>\<open>rev xs\<close>, as required.
In this instance it was easy to guess the right generalization.
Other situations can require a good deal of creativity.

Although we now have two variables, only \<open>xs\<close> is suitable for
induction, and we repeat our proof attempt. Unfortunately, we are still
not there:
@{subgoals[display,margin=65]}
The induction hypothesis is still too weak, but this time it takes no
intuition to generalize: the problem is that the \<open>ys\<close>
in the induction hypothesis is fixed,
but the induction hypothesis needs to be applied with
\<^term>\<open>a # ys\<close> instead of \<open>ys\<close>. Hence we prove the theorem
for all \<open>ys\<close> instead of a fixed one. We can instruct induction
to perform this generalization for us by adding \<open>arbitrary: ys\<close>\index{arbitrary@\<open>arbitrary:\<close>}.
\<close>
(*<*)oops
lemma "itrev xs ys = rev xs @ ys"
(*>*)
apply(induction xs arbitrary: ys)

txt\<open>The induction hypothesis in the induction step is now universally quantified over \<open>ys\<close>:
@{subgoals[display,margin=65]}
Thus the proof succeeds:
\<close>

apply(auto)
done

text\<open>
This leads to another heuristic for generalization:
\begin{quote}
\emph{Generalize induction by generalizing all free
variables\\ {\em(except the induction variable itself)}.}
\end{quote}
Generalization is best performed with \<open>arbitrary: y\<^sub>1 \<dots> y\<^sub>k\<close>.
This heuristic prevents trivial failures like the one above.
However, it should not be applied blindly.
It is not always required, and the additional quantifiers can complicate
matters in some cases. The variables that need to be quantified are typically
those that change in recursive calls.

\subsection*{Exercises}

\begin{exercise}
Write a tail-recursive variant of the \<open>add\<close> function on \<^typ>\<open>nat\<close>:
\<^term>\<open>itadd :: nat \<Rightarrow> nat \<Rightarrow> nat\<close>.
Tail-recursive means that in the recursive case, \<open>itadd\<close> needs to call
itself directly: \mbox{\<^term>\<open>itadd (Suc m) n\<close>} \<open>= itadd \<dots>\<close>.
Prove \<^prop>\<open>itadd m n = add m n\<close>.
\end{exercise}

\section{Simplification}

So far we have talked a lot about simplifying terms without explaining the concept.
\conceptidx{Simplification}{simplification} means
\begin{itemize}
\item using equations $l = r$ from left to right (only),
\item as long as possible.
\end{itemize}
To emphasize the directionality, equations that have been given the
\<open>simp\<close> attribute are called \conceptidx{simplification rules}{simplification rule}.
Logically, they are still symmetric, but proofs by
simplification use them only in the left-to-right direction.  The proof tool
that performs simplifications is called the \concept{simplifier}. It is the
basis of \<open>auto\<close> and other related proof methods.

The idea of simplification is best explained by an example. Given the
simplification rules
\[
\begin{array}{rcl@ {\quad}l}
\<^term>\<open>0 + n::nat\<close> &\<open>=\<close>& \<open>n\<close> & (1) \\
\<^term>\<open>(Suc m) + n\<close> &\<open>=\<close>& \<^term>\<open>Suc (m + n)\<close> & (2) \\
\<open>(Suc m \<le> Suc n)\<close> &\<open>=\<close>& \<open>(m \<le> n)\<close> & (3)\\
\<open>(0 \<le> m)\<close> &\<open>=\<close>& \<^const>\<open>True\<close> & (4)
\end{array}
\]
the formula \<^prop>\<open>0 + Suc 0 \<le> Suc 0 + x\<close> is simplified to \<^const>\<open>True\<close>
as follows:
\[
\begin{array}{r@ {}c@ {}l@ {\quad}l}
\<open>(0 + Suc 0\<close> & \leq & \<open>Suc 0 + x)\<close>  & \stackrel{(1)}{=} \\
\<open>(Suc 0\<close>     & \leq & \<open>Suc 0 + x)\<close>  & \stackrel{(2)}{=} \\
\<open>(Suc 0\<close>     & \leq & \<open>Suc (0 + x))\<close> & \stackrel{(3)}{=} \\
\<open>(0\<close>         & \leq & \<open>0 + x)\<close>      & \stackrel{(4)}{=} \\[1ex]
 & \<^const>\<open>True\<close>
\end{array}
\]
Simplification is often also called \concept{rewriting}
and simplification rules \conceptidx{rewrite rules}{rewrite rule}.

\subsection{Simplification Rules}

The attribute \<open>simp\<close> declares theorems to be simplification rules,
which the simplifier will use automatically. In addition,
\isacom{datatype} and \isacom{fun} commands implicitly declare some
simplification rules: \isacom{datatype} the distinctness and injectivity
rules, \isacom{fun} the defining equations. Definitions are not declared
as simplification rules automatically! Nearly any theorem can become a
simplification rule. The simplifier will try to transform it into an
equation. For example, the theorem \<^prop>\<open>\<not> P\<close> is turned into \<^prop>\<open>P = False\<close>.

Only equations that really simplify, like \<^prop>\<open>rev (rev xs) = xs\<close> and
\<^prop>\<open>xs @ [] = xs\<close>, should be declared as simplification
rules. Equations that may be counterproductive as simplification rules
should only be used in specific proof steps (see \autoref{sec:simp} below).
Distributivity laws, for example, alter the structure of terms
and can produce an exponential blow-up.

\subsection{Conditional Simplification Rules}

Simplification rules can be conditional.  Before applying such a rule, the
simplifier will first try to prove the preconditions, again by
simplification. For example, given the simplification rules
\begin{quote}
\<^prop>\<open>p(0::nat) = True\<close>\\
\<^prop>\<open>p(x) \<Longrightarrow> f(x) = g(x)\<close>,
\end{quote}
the term \<^term>\<open>f(0::nat)\<close> simplifies to \<^term>\<open>g(0::nat)\<close>
but \<^term>\<open>f(1::nat)\<close> does not simplify because \<^prop>\<open>p(1::nat)\<close>
is not provable.

\subsection{Termination}

Simplification can run forever, for example if both \<^prop>\<open>f x = g x\<close> and
\<^prop>\<open>g(x) = f(x)\<close> are simplification rules. It is the user's
responsibility not to include simplification rules that can lead to
nontermination, either on their own or in combination with other
simplification rules. The right-hand side of a simplification rule should
always be ``simpler'' than the left-hand side --- in some sense. But since
termination is undecidable, such a check cannot be automated completely
and Isabelle makes little attempt to detect nontermination.

When conditional simplification rules are applied, their preconditions are
proved first. Hence all preconditions need to be
simpler than the left-hand side of the conclusion. For example
\begin{quote}
\<^prop>\<open>n < m \<Longrightarrow> (n < Suc m) = True\<close>
\end{quote}
is suitable as a simplification rule: both \<^prop>\<open>n<m\<close> and \<^const>\<open>True\<close>
are simpler than \mbox{\<^prop>\<open>n < Suc m\<close>}. But
\begin{quote}
\<^prop>\<open>Suc n < m \<Longrightarrow> (n < m) = True\<close>
\end{quote}
leads to nontermination: when trying to rewrite \<^prop>\<open>n<m\<close> to \<^const>\<open>True\<close>
one first has to prove \mbox{\<^prop>\<open>Suc n < m\<close>}, which can be rewritten to \<^const>\<open>True\<close> provided \<^prop>\<open>Suc(Suc n) < m\<close>, \emph{ad infinitum}.

\subsection{The \indexed{\<open>simp\<close>}{simp} Proof Method}
\label{sec:simp}

So far we have only used the proof method \<open>auto\<close>.  Method \<open>simp\<close>
is the key component of \<open>auto\<close>, but \<open>auto\<close> can do much more. In
some cases, \<open>auto\<close> is overeager and modifies the proof state too much.
In such cases the more predictable \<open>simp\<close> method should be used.
Given a goal
\begin{quote}
\<open>1. \<lbrakk> P\<^sub>1; \<dots>; P\<^sub>m \<rbrakk> \<Longrightarrow> C\<close>
\end{quote}
the command
\begin{quote}
\isacom{apply}\<open>(simp add: th\<^sub>1 \<dots> th\<^sub>n)\<close>
\end{quote}
simplifies the assumptions \<open>P\<^sub>i\<close> and the conclusion \<open>C\<close> using
\begin{itemize}
\item all simplification rules, including the ones coming from \isacom{datatype} and \isacom{fun},
\item the additional lemmas \<open>th\<^sub>1 \<dots> th\<^sub>n\<close>, and
\item the assumptions.
\end{itemize}
In addition to or instead of \<open>add\<close> there is also \<open>del\<close> for removing
simplification rules temporarily. Both are optional. Method \<open>auto\<close>
can be modified similarly:
\begin{quote}
\isacom{apply}\<open>(auto simp add: \<dots> simp del: \<dots>)\<close>
\end{quote}
Here the modifiers are \<open>simp add\<close> and \<open>simp del\<close>
instead of just \<open>add\<close> and \<open>del\<close> because \<open>auto\<close>
does not just perform simplification.

Note that \<open>simp\<close> acts only on subgoal 1, \<open>auto\<close> acts on all
subgoals. There is also \<open>simp_all\<close>, which applies \<open>simp\<close> to
all subgoals.

\subsection{Rewriting with Definitions}
\label{sec:rewr-defs}

Definitions introduced by the command \isacom{definition}
can also be used as simplification rules,
but by default they are not: the simplifier does not expand them
automatically. Definitions are intended for introducing abstract concepts and
not merely as abbreviations. Of course, we need to expand the definition
initially, but once we have proved enough abstract properties of the new
constant, we can forget its original definition. This style makes proofs more
robust: if the definition has to be changed, only the proofs of the abstract
properties will be affected.

The definition of a function \<open>f\<close> is a theorem named \<open>f_def\<close>
and can be added to a call of \<open>simp\<close> like any other theorem:
\begin{quote}
\isacom{apply}\<open>(simp add: f_def)\<close>
\end{quote}
In particular, let-expressions can be unfolded by
making @{thm[source] Let_def} a simplification rule.

\subsection{Case Splitting With \<open>simp\<close>}

Goals containing if-expressions are automatically split into two cases by
\<open>simp\<close> using the rule
\begin{quote}
\<^prop>\<open>P(if A then s else t) = ((A \<longrightarrow> P(s)) \<and> (~A \<longrightarrow> P(t)))\<close>
\end{quote}
For example, \<open>simp\<close> can prove
\begin{quote}
\<^prop>\<open>(A \<and> B) = (if A then B else False)\<close>
\end{quote}
because both \<^prop>\<open>A \<longrightarrow> (A & B) = B\<close> and \<^prop>\<open>~A \<longrightarrow> (A & B) = False\<close>
simplify to \<^const>\<open>True\<close>.

We can split case-expressions similarly. For \<open>nat\<close> the rule looks like this:
@{prop[display,margin=65,indent=4]"P(case e of 0 \<Rightarrow> a | Suc n \<Rightarrow> b n) = ((e = 0 \<longrightarrow> P a) \<and> (\<forall>n. e = Suc n \<longrightarrow> P(b n)))"}
Case expressions are not split automatically by \<open>simp\<close>, but \<open>simp\<close>
can be instructed to do so:
\begin{quote}
\isacom{apply}\<open>(simp split: nat.split)\<close>
\end{quote}
splits all case-expressions over natural numbers. For an arbitrary
datatype \<open>t\<close> it is \<open>t.split\<close>\index{split@\<open>.split\<close>} instead of @{thm[source] nat.split}.
Method \<open>auto\<close> can be modified in exactly the same way.
The modifier \indexed{\<open>split:\<close>}{split} can be followed by multiple names.
Splitting if or case-expressions in the assumptions requires
\<open>split: if_splits\<close> or \<open>split: t.splits\<close>.

\ifsem\else
\subsection{Rewriting \<open>let\<close> and Numerals}

Let-expressions (\<^term>\<open>let x = s in t\<close>) can be expanded explicitly with the simplification rule
@{thm[source] Let_def}. The simplifier will not expand \<open>let\<close>s automatically in many cases.

Numerals of type \<^typ>\<open>nat\<close> can be converted to \<^const>\<open>Suc\<close> terms with the simplification rule
@{thm[source] numeral_eq_Suc}. This is required, for example, when a function that is defined
by pattern matching with \<^const>\<open>Suc\<close> is applied to a numeral: if \<open>f\<close> is defined by
\<open>f 0 = ...\<close> and  \<open>f (Suc n) = ...\<close>, the simplifier cannot simplify \<open>f 2\<close> unless
\<open>2\<close> is converted to \<^term>\<open>Suc(Suc 0)\<close> (via @{thm[source] numeral_eq_Suc}).
\fi

\subsection*{Exercises}

\exercise\label{exe:tree0}
Define a datatype \<open>tree0\<close> of binary tree skeletons which do not store
any information, neither in the inner nodes nor in the leaves.
Define a function \<open>nodes :: tree0 \<Rightarrow> nat\<close> that counts the number of
all nodes (inner nodes and leaves) in such a tree.
Consider the following recursive function:
\<close>
(*<*)
datatype tree0 = Tip | Node tree0 tree0
(*>*)
fun explode :: "nat \<Rightarrow> tree0 \<Rightarrow> tree0" where
"explode 0 t = t" |
"explode (Suc n) t = explode n (Node t t)"

text \<open>
Find an equation expressing the size of a tree after exploding it
(\noquotes{@{term [source] "nodes (explode n t)"}}) as a function
of \<^term>\<open>nodes t\<close> and \<open>n\<close>. Prove your equation.
You may use the usual arithmetic operators, including the exponentiation
operator ``\<open>^\<close>''. For example, \noquotes{@{prop [source] "2 ^ 2 = 4"}}.

Hint: simplifying with the list of theorems @{thm[source] algebra_simps}
takes care of common algebraic properties of the arithmetic operators.
\endexercise

\exercise
Define arithmetic expressions in one variable over integers (type \<^typ>\<open>int\<close>)
as a data type:
\<close>

datatype exp = Var | Const int | Add exp exp | Mult exp exp

text\<open>
Define a function \noquotes{@{term [source]"eval :: exp \<Rightarrow> int \<Rightarrow> int"}}
such that \<^term>\<open>eval e x\<close> evaluates \<open>e\<close> at the value
\<open>x\<close>.

A polynomial can be represented as a list of coefficients, starting with
the constant. For example, \<^term>\<open>[4, 2, -1, 3::int]\<close> represents the
polynomial $4 + 2x - x^2 + 3x^3$.
Define a function \noquotes{@{term [source] "evalp :: int list \<Rightarrow> int \<Rightarrow> int"}}
that evaluates a polynomial at the given value.
Define a function \noquotes{@{term[source] "coeffs :: exp \<Rightarrow> int list"}}
that transforms an expression into a polynomial. This may require auxiliary
functions. Prove that \<open>coeffs\<close> preserves the value of the expression:
\mbox{\<^prop>\<open>evalp (coeffs e) x = eval e x\<close>.}
Hint: consider the hint in Exercise~\ref{exe:tree0}.
\endexercise
\<close>
(*<*)
end
(*>*)


theory Eplus_zero
  imports Main "$HIPSTER_HOME/IsaHipster"
begin

setup Tactic_Data.set_coinduct_sledgehammer

codatatype ENat = is_zero: EZ | ESuc (epred: ENat)

primcorec eplus :: "ENat \<Rightarrow> ENat \<Rightarrow> ENat" where
"eplus m n = (if is_zero m then n else ESuc (eplus (epred m) n))"

theorem eplus_zero: "eplus n EZ = n"
by hipster_coinduct_sledgehammer
end


theory Example_Necessary
  imports Computation
begin

(* Example 19 *)

datatype states = Init | Copy bool | Skip bool | Check bool | Accept

instantiation states :: finite
begin

instance
proof (standard)
  have "(UNIV :: states set) \<subseteq> {Init, Copy True, Copy False, Skip True, Skip False,
    Check True, Check False, Accept}"
    using states.exhaust by blast
  then show "finite (UNIV :: states set)"
    using finite_subset by auto
qed

end

type_synonym Sigma = "bool"

inductive delta :: "states \<Rightarrow> Sigma \<Rightarrow> states \<times> Sigma list \<Rightarrow> bool" where
  "delta Init False (Copy False, [False])"
| "delta Init False (Skip True, [])"
| "delta Init True (Skip False, [])"
| "delta Init True (Copy True, [])"
| "delta (Copy False) True (Skip False, [])"
| "delta (Skip True) True (Copy True, [])"
| "delta (Copy b) False (Copy b, [False])"
| "delta (Skip b) False (Skip b, [])"
| "delta (Skip False) True (Check False, [])"
| "delta (Copy True) True (Check True, [])"
| "delta (Check False) False (Accept, [])"
| "delta (Check True) True (Accept, [])"

lemma finite_delta: "finite {x. delta q z x}"
proof -
  have "{x. delta q z x} \<subseteq> UNIV \<times> {xs. length xs \<le> 1}"
    by (auto elim: delta.cases)
  then show ?thesis
    using finite_subset finite_bounded_lists by fastforce
qed

interpretation NFT Init delta "\<lambda>q. q = Accept" UNIV
  using finite_UNIV finite_delta
  by unfold_locales auto

lemma nft_comp_Accept: "computation q (as, bs) q' \<Longrightarrow> q = Accept \<Longrightarrow>
  q' = Accept \<and> as = [] \<and> bs = []"
  by (induction q "(as, bs)" q' arbitrary: as bs rule: computation.induct)
     (auto elim: delta.cases)

lemma nft_comp_Check_Accept: "computation q (as, bs) q' \<Longrightarrow> q = Check b \<Longrightarrow>
  q' = Check b \<or> q' = Accept"
  by (induction q "(as, bs)" q' arbitrary: as bs rule: computation.induct)
     (auto elim: delta.cases dest: nft_comp_Accept)

lemma nft_comp_Copy_True_Skip: "computation q (as, bs) q' \<Longrightarrow>
  q = Copy True \<Longrightarrow> q' = Skip b \<Longrightarrow> False"
  by (induction q "(as, bs)" q' arbitrary: as bs rule: computation.induct)
     (auto elim: delta.cases dest: nft_comp_Check_Accept)

lemma nft_comp_Skip_False_Copy: "computation q (as, bs) q' \<Longrightarrow>
  q = Skip False \<Longrightarrow> q' = Copy b \<Longrightarrow> False"
  by (induction q "(as, bs)" q' arbitrary: as bs rule: computation.induct)
     (auto elim: delta.cases dest: nft_comp_Check_Accept)

lemma nft_comp_Skip_dest: "computation q (as, bs) q' \<Longrightarrow> q = Skip b \<Longrightarrow> q' = Skip b' \<Longrightarrow>
  as = replicate (length as) False \<and> bs = [] \<and> b = b'"
  by (induction q "(as, bs)" q' arbitrary: as bs b b' rule: computation.induct)
     (auto elim: delta.cases dest: nft_comp_Copy_True_Skip nft_comp_Check_Accept)

lemma nft_comp_Copy_dest: "computation q (as, bs) q' \<Longrightarrow> q = Copy b \<Longrightarrow> q' = Copy b' \<Longrightarrow>
  as = replicate (length as) False \<and> bs = as \<and> b = b'"
  by (induction q "(as, bs)" q' arbitrary: as bs b b' rule: computation.induct)
     (auto elim: delta.cases dest: nft_comp_Skip_False_Copy nft_comp_Check_Accept)

lemma nft_comp_Skip_intro: "computation (Skip b) (replicate n False, []) (Skip b)"
  using computation.step delta.intros(8)
  by (induction n) fastforce+

lemma nft_comp_Copy_intro: "computation (Copy b) (replicate n False, replicate n False) (Copy b)"
  using computation.step delta.intros(7)
  by (induction n) fastforce+

lemma sound_True: "(replicate n False @ [True] @ replicate n' False @ [True] @ [False],
  replicate n False) \<in> \<tau>"
  unfolding \<tau>_def
  using comp_trans[OF comp_trans[OF comp_trans[OF
        one_step[OF delta.intros(3)] nft_comp_Skip_intro]
        one_step[OF delta.intros(9)]]
        one_step[OF delta.intros(11)]]
        comp_trans[OF comp_trans[OF comp_trans[OF comp_trans[OF comp_trans[OF
        one_step[OF delta.intros(1)] nft_comp_Copy_intro]
        one_step[OF delta.intros(5)]] nft_comp_Skip_intro]
        one_step[OF delta.intros(9)]]
        one_step[OF delta.intros(11)]]
  by (cases n) auto

lemma sound_False: "(replicate n False @ [True] @ replicate n' False @ [True] @ [True],
  replicate n' False) \<in> \<tau>"
  unfolding \<tau>_def
  using comp_trans[OF comp_trans[OF comp_trans[OF
        one_step[OF delta.intros(4)] nft_comp_Copy_intro]
        one_step[OF delta.intros(10)]]
        one_step[OF delta.intros(12)]]
        comp_trans[OF comp_trans[OF comp_trans[OF comp_trans[OF comp_trans[OF
        one_step[OF delta.intros(2)] nft_comp_Skip_intro]
        one_step[OF delta.intros(6)]] nft_comp_Copy_intro]
        one_step[OF delta.intros(10)]]
        one_step[OF delta.intros(12)]]
  by (cases n) auto

lemma snd_part:
  assumes "computation q (as, bs) q'" "q = Skip False \<or> q = Copy True"
    "q' = Skip False \<or> q' = Copy True"
  shows "q = q'" "as = replicate (length as) False \<and> bs = (if q = Copy True then as else [])"
proof -
  show q_q': "q = q'"
    using nft_comp_Copy_True_Skip[OF assms(1)] nft_comp_Skip_False_Copy[OF assms(1)] assms(2,3)
    by auto
  show "as = replicate (length as) False \<and> bs = (if q = Copy True then as else [])"
    using assms(2)
  proof (rule disjE)
    assume q_def: "q = Copy True"
    then show "as = replicate (length as) False \<and> bs = (if q = Copy True then as else [])"
      using nft_comp_Copy_dest[OF assms(1) q_def q_q'[symmetric, unfolded q_def]]
      by auto
  next
    assume q_def: "q = Skip False"
    then show "as = replicate (length as) False \<and> bs = (if q = Copy True then as else [])"
      using nft_comp_Skip_dest[OF assms(1) q_def q_q'[symmetric, unfolded q_def]]
      by auto
  qed
qed

lemma fst_part:
  assumes "computation q (as, bs) q'" "q = Copy False \<or> q = Skip True"
    "q' = Skip False \<or> q' = Copy True"
  shows "\<exists>n n'. as = replicate n False @ [True] @ replicate n' False \<and>
    bs = replicate (if q = Copy False then n else n') False"
  using assms
proof (induction q "(as, bs)" q' arbitrary: as bs rule: computation.induct)
  case (step q a q' bs as bs' q'')
  show ?case
  proof (cases a)
    case False
    then show ?thesis
      using step nft_comp_Copy_dest nft_comp_Skip_dest
      apply (auto elim!: delta.cases)
      subgoal for n n'
        apply (rule exI[of _ "Suc n"])
        apply auto
        done
      subgoal for n n'
        apply (rule exI[of _ "Suc n"])
        apply auto
        done
      subgoal for n n'
        apply (rule exI[of _ "Suc n"])
        apply auto
        done
      subgoal for n n'
        apply (rule exI[of _ "Suc n"])
        apply auto
        done
      done
  next
    case True
    show ?thesis
      using step
      using snd_part[OF step(2)]
      apply (auto simp add: True elim!: delta.cases)
      apply (rule exI[of _ "0"])
      apply auto
      done
  qed
qed auto

lemma comp_end_Accept:
  assumes "computation q (as, bs) Accept" "q \<noteq> Accept"
  shows "\<exists>as' \<beta>. computation q (as', bs) (Check \<beta>) \<and> as = as' @ [\<beta>]"
  using assms
  apply (induction q as bs Accept rule: comp_rev_induct)
  using assms
    apply (auto elim: delta.cases)
  done

lemma comp_end_Check:
  assumes "computation q (as, bs) (Check b)" "q \<noteq> Check b"
  shows "\<exists>as'. computation q (as', bs) (if b then Copy True else Skip False) \<and> as = as' @ [True]"
  using assms
  apply (induction q as bs "Check b" rule: comp_rev_induct)
  using assms
    apply (auto elim: delta.cases)
  done

lemma completeness:
  assumes "(as, bs) \<in> \<tau>"
  shows "\<exists>n n' \<beta>. as = replicate n False @ [True] @ replicate n' False @ [True] @ [\<beta>] \<and>
    bs = replicate (if \<beta> then n' else n) False"
  using assms
proof (cases as)
  case (Cons a as')
  have comp: "computation Init (a # as', bs) Accept"
    using assms
    unfolding \<tau>_def Cons
    by auto
  obtain q cs cs' where split: "delta Init a (q, cs)" "computation q (as', cs') Accept"
    "bs = cs @ cs'"
    by (rule computation.cases[OF comp(1)]) auto
  show ?thesis
  proof (cases a)
    case False
    then have q_or: "q = Copy False \<or> q = Skip True"
      using split(1)
      by (auto elim: delta.cases)
    have cs_def: "cs = (if q = Copy False then [False] else [])"
      using split(1)
      by (auto simp add: False elim: delta.cases)
    obtain as'' \<beta> where tail: "as' = as'' @ [True] @ [\<beta>]"
      "computation q (as'', cs') (if \<beta> then Copy True else Skip False)"
      using comp_end_Accept[OF split(2)] comp_end_Check q_or
      by fastforce
    obtain n n' where wit: "as'' = replicate n False @ [True] @ replicate n' False"
      "cs' = replicate (if q = Copy False then n else n') False"
      using fst_part[OF tail(2) q_or]
      by fastforce
    have \<beta>_iff: "\<beta> \<longleftrightarrow> q = Skip True"
      using tail(2) q_or
      by (fastforce split: if_splits dest: nft_comp_Copy_dest nft_comp_Skip_dest)
    show ?thesis
      apply (auto simp add: Cons False tail(1) split(3) cs_def wit \<beta>_iff)
      apply (rule exI[of _ "n + 1"])
         apply (auto)[1]
      apply (rule exI[of _ "n + 1"])
      using q_or
      apply auto
      done
  next
    case True
    then have q_or: "q = Skip False \<or> q = Copy True"
      using split(1)
      by (auto elim: delta.cases)
    have cs_def: "cs = []"
      using split(1)
      by (auto simp add: True elim: delta.cases)
    obtain as'' \<beta> where tail: "as' = as'' @ [True] @ [\<beta>]"
      "computation q (as'', cs') (if \<beta> then Copy True else Skip False)"
      using comp_end_Accept[OF split(2)] comp_end_Check q_or
      by fastforce
    define n where "n = length as''"
    have wit: "as'' = replicate n False"
      "cs' = (if q = Copy True then as'' else [])"
      "q = (if \<beta> then Copy True else Skip False)"
      using snd_part[OF tail(2) q_or]
      by (auto simp add: n_def)
    show ?thesis
      using wit(3)
      by (auto simp add: Cons True tail(1) wit(1,2) split(3) cs_def)
  qed
qed (auto simp add: \<tau>_def dest: no_step)

lemma active_Copy: "active (Copy False) []"
  using comp_trans[OF comp_trans[OF one_step[OF delta.intros(5)] one_step[OF delta.intros(9)]]
        one_step[OF delta.intros(11)]]
  by (auto simp add: active_def)

lemma active_Skip: "active (Skip True) (replicate n False)"
  using comp_trans[OF comp_trans[OF comp_trans[OF one_step[OF delta.intros(6)]
        nft_comp_Copy_intro[of True "n"]]
        one_step[OF delta.intros(10)]] one_step[OF delta.intros(12)]]
  by (auto simp add: active_def) (metis append.right_neutral)

lemma correctness: "\<tau> = {(as, bs). \<exists>n n' \<beta>. as = replicate n False @ [True] @
  replicate n' False @ [True] @ [\<beta>] \<and> bs = replicate (if \<beta> then n' else n) False}"
  using sound_True sound_False completeness
  by fastforce

lemma unbounded: "\<not>bounded K"
  unfolding bounded_def
  using comp_trans[OF one_step[OF delta.intros(1)] nft_comp_Copy_intro[of False "K"]]
        active_Copy
        comp_trans[OF one_step[OF delta.intros(2)] nft_comp_Skip_intro[of True "K"]]
        active_Skip[of "K + 1"]
  using impossible_Cons
  by auto fastforce

end


(*  Title:      Fermat4.thy
    Author:     Roelof Oosterhuis
                2007  Rijksuniversiteit Groningen
*)

header {* Pythagorean triples and Fermat's last theorem, case $n=4$ *}

theory Fermat4
imports Main IntNatAux
begin

text {* Proof of Fermat's last theorem for the case $n=4$: $$\forall x,y,z:~x^4 + y^4 = z^4 \Longrightarrow xyz=0.$$ *}

lemma nat_power2_add: "((a::nat)+b)^2 = a^2 + b^2 + 2*a*b"
  by (fact power2_sum)
(*
NB: this lemma is quite slow, maybe use more steps *)
lemma nat_power2_diff: "a \<ge> (b::nat) \<Longrightarrow> (a-b)^2 = a^2 + b^2 - 2*a*b"
proof -
  assume a_ge_b: "a \<ge> b"
  hence a2_ge_b2: "a^2 \<ge> b^2" by (simp only: power_mono)
  from a_ge_b have ab_ge_b2: "a*b \<ge> b^2" by (simp add: power2_eq_square)
  have "b*(a-b) + (a-b)^2 = a*(a-b)" by (simp add: power2_eq_square diff_mult_distrib)
  also have "\<dots> = a*b + a^2 + (b^2 - b^2) - 2*a*b"
    by (simp add: diff_mult_distrib2 power2_eq_square)
  also with a2_ge_b2 have "\<dots> = a*b + (a^2 - b^2) + b^2 - 2*a*b" by simp
  also with ab_ge_b2 have "\<dots> = (a*b - b^2) + a^2 + b^2 - 2*a*b" by auto
  also have "\<dots> = b*(a-b) + a^2 + b^2 - 2*a*b"
    by (simp only: diff_mult_distrib2 power2_eq_square mult.commute)
  finally show ?thesis by arith
qed

lemma nat_power_le_imp_le_base: "\<lbrakk> n \<noteq> 0; a^n \<le> b^n \<rbrakk> \<Longrightarrow> (a::nat) \<le> b"
proof -
  assume "n \<noteq> 0" and ab: "a^n \<le> b^n"
  then obtain m where "n = Suc m" by (frule_tac n="n" in not0_implies_Suc, auto)
  with ab have "a \<ge> 0" and "a^Suc m \<le> b^Suc m" and "b \<ge> 0" by auto
  thus ?thesis by (rule_tac n="m" in power_le_imp_le_base)
qed

lemma nat_power_inject_base: "\<lbrakk> n \<noteq> 0; a^n = b^n \<rbrakk> \<Longrightarrow> (a::nat) = b"
proof -
  assume "n \<noteq> 0" and ab: "a^n = b^n"
  then obtain m where "n = Suc m" by (frule_tac n="n" in not0_implies_Suc, auto)
  with ab have "a^Suc m = b^Suc m" and "a \<ge> 0" and "b \<ge> 0" by auto
  thus ?thesis by (rule power_inject_base)
qed

subsection {* Parametrisation of Pythagorean triples (over $\mathbb{N}$ and $\mathbb{Z}$) *}

theorem nat_euclid_pyth_triples:
  assumes abc: "a^2 + b^2 = c^2" and ab_relprime: "gcd a b=1" and aodd: "odd a"
  shows "\<exists> p q. a = p^2 - q^2 \<and> b = 2*p*q \<and> c = p^2 + q^2 \<and> gcd p q=1"
proof -
  have two0: "(2::nat) \<noteq> 0" by simp
  from abc have a2cb: "a^2 = c^2 - b^2" by arith
  -- "factor $a^2$ in coprime factors $(c-b)$ and $(c+b)$; hence both are squares"
  have a2factor: "a^2 = (c-b)*(c+b)"
  proof -
    have "c*b - c*b = 0" by simp
    with a2cb have "a^2 = c*c + c*b - c*b - b*b" by (simp add: power2_eq_square)
    also have "\<dots> = c*(c+b) - b*(c+b)"
      by (simp add: add_mult_distrib2 add_mult_distrib mult.commute)
    finally show ?thesis by (simp only: diff_mult_distrib)
  qed
  have a_nonzero: "a \<noteq> 0"
  proof (rule ccontr)
    assume "\<not> a \<noteq> 0" hence "a = 0" by simp
    with aodd have "odd (0::nat)" by simp
    thus False by simp
  qed
  have b_less_c: "b < c"
  proof -
    from abc have "b^2 \<le> c^2" by auto
    with two0 have "b \<le> c" by (rule_tac n="2" in nat_power_le_imp_le_base)
    moreover have"b \<noteq> c"
    proof
      assume "b=c" with a2cb have "a^2 = 0" by simp
      with a_nonzero show False by (simp add: power2_eq_square)
    qed
    ultimately show ?thesis by auto
  qed
  hence b2_le_c2: "b^2 \<le> c^2" by (simp add: power_mono)
  have bc_relprime: "gcd b c = 1"
  proof -
    from b2_le_c2 have cancelb2: "c^2-b^2+b^2 = c^2" by auto
    let ?g = "gcd b c"
    have "?g^2 = gcd (b^2) (c^2)" by (simp only: gcd_power_distrib)
    with cancelb2 have "?g^2 = gcd (b^2) (c^2-b^2+b^2)" by simp
    hence "?g^2 = gcd (b^2) (c^2-b^2)" by simp
    with a2cb have "?g^2 dvd a^2" by (simp only: gcd_dvd2)
    hence "?g dvd a \<and> ?g dvd b" by simp
    hence "?g dvd gcd a b" by (simp only: gcd_greatest)
    with ab_relprime show ?thesis by auto
  qed
  have p2: "prime 2" by (rule two_is_prime)
  have factors_odd: "odd (c-b) \<and> odd (c+b)"
  proof (auto simp only: ccontr)
    assume "even (c-b)"
    with a2factor have "2 dvd a^2" by (simp only: dvd_mult2)
    with p2 have "2 dvd a" by (rule prime_dvd_power)
    with aodd show False by simp
  next
    assume "even (c+b)"
    with a2factor have "2 dvd a^2" by (simp only: dvd_mult)
    with p2 have "2 dvd a" by (rule prime_dvd_power)
    with aodd show False by simp
  qed
  have cb1: "c-b + (c+b) = 2*c"
  proof -
    have "c-b + (c+b) = ((c-b)+b)+c" by simp
    also with b_less_c have "\<dots> = (c+b-b)+c" by (simp only: diff_add_assoc2)
    also have "\<dots> = c+c" by simp
    finally show ?thesis by simp
  qed
  have cb2: "2*b + (c-b) = c+b"
  proof -
    have "2*b + (c-b) = b+b + (c - b)" by auto
    also have "\<dots> = b + ((c-b)+b)" by simp
    also with b_less_c have " \<dots> = b + (c+b-b)" by (simp only: diff_add_assoc2)
    finally show ?thesis by simp
  qed
  have factors_relprime: "gcd (c-b) (c+b) =1"
  proof -
    let ?g = "gcd (c-b) (c+b)"
    have cb1: "c-b + (c+b) = 2*c"
    proof -
      have "c-b + (c+b) = ((c-b)+b)+c" by simp
      also with b_less_c have "\<dots> = (c+b-b)+c" by (simp only: diff_add_assoc2)
      also have "\<dots> = c+c" by simp
      finally show ?thesis by simp
    qed
    have "?g = gcd (c-b + (c+b)) (c+b)" by simp
    with cb1 have "?g = gcd (2*c) (c+b)" by (rule_tac a="c-b + (c+b)" in back_subst)
    hence g2c: "?g dvd 2*c" by (simp only: gcd_dvd1)
    have "gcd (c-b) (2*b + (c-b)) = gcd (c-b) (2*b)" by simp
    with cb2 have "?g = gcd (c-b) (2*b)" by (rule_tac a="2*b + (c-b)" in back_subst)
    hence g2b: "?g dvd 2*b" by (simp only: gcd_dvd2)
    with g2c have "?g dvd 2 * gcd b c" by (simp only: gcd_greatest gcd_mult_distrib2)
    with bc_relprime have "?g dvd 2" by simp
    with p2 have g1or2: "?g = 2 \<or> ?g = 1" by (unfold prime_def, auto)
    thus ?thesis
    proof (auto)
      assume "?g = 2" hence "2 dvd ?g" by simp
      hence "2 dvd c-b" by simp
      with factors_odd show False by simp
    qed
  qed
  from a2factor have "(c-b)*(c+b) = a^2" and "(2::nat) >1"  by auto
  with factors_relprime have "\<exists> k. c-b = k^2" by (simp only: nat_relprime_power_divisors)
  then obtain r where r: "c-b = r^2" by auto
  from a2factor have "(c+b)*(c-b) = a^2" and "(2::nat) >1"  by auto
  with factors_relprime have "\<exists> k. c+b = k^2"
    by (simp only: nat_relprime_power_divisors gcd_commute)
  then obtain s where s: "c+b = s^2" by auto
  -- "now $p := (s+r)/2$ and $q := (s-r)/2$ is our solution"
  have rs_odd: "odd r \<and> odd s"
  proof (auto dest: ccontr)
    assume "even r" hence "2 dvd r"by presburger
    with r have  "2 dvd (c-b)" by (simp only: power2_eq_square dvd_mult)
    with factors_odd show False by auto
  next
    assume "even s" hence "2 dvd s" by presburger
    with s have "2 dvd (c+b)" by (simp only: power2_eq_square dvd_mult)
    with factors_odd show False by auto
  qed
  obtain m where m: "m = s-r" by simp
  from r s have "r^2 \<le> s^2" by arith
  with two0 have "r \<le> s" by (rule_tac n="2" in nat_power_le_imp_le_base)
  with m have m2: "s = r + m" by simp
  have "even m"
  proof (rule ccontr)
    assume "odd m" with rs_odd and m2 show False by presburger
  qed
  then obtain q where "m = 2*q" ..
  with m2 have q: "s = r + 2*q" by simp
  obtain p where p: "p = r+q" by simp
  have c: "c = p^2 + q^2"
  proof -
    from cb1 and r and s have "2*c = r^2 + s^2" by simp
    also with q have "\<dots> = 2*r^2+(2*q)^2+2*r*(2*q)"
      by (simp add: nat_power2_add)
    also have "\<dots> = 2*r^2+2^2*q^2+2*2*q*r" by (simp add: power_mult_distrib)
    also have "\<dots> = 2*(r^2+2*q*r+q^2)+2*q^2" by (simp add: power2_eq_square)
    also with p have "\<dots> = 2*p^2+2*q^2" by (simp add: nat_power2_add)
    finally show ?thesis by auto
  qed
  moreover have b: "b = 2*p*q"
  proof -
    from cb2 and r and s have "2*b = s^2 - r^2" by arith
    also with q have "\<dots> = (2*q)^2 + 2*r*(2*q)" by (simp add: nat_power2_add)
    also with p have "\<dots> = 4*q*p" by (simp add: power2_eq_square add_mult_distrib2)
    finally show ?thesis by auto
  qed
  moreover have a: "a = p^2 - q^2"
  proof -
    from p have "p\<ge>q" by simp
    hence p2_ge_q2: "p^2 \<ge> q^2" by (simp only: power_mono)
    from a2cb and b and c have "a^2 = (p^2 + q^2)^2 - (2*p*q)^2" by simp
    also have "\<dots> = (p^2)^2 + (q^2)^2 - 2*(p^2)*(q^2)"
      by (auto simp add: nat_power2_add power_mult_distrib ac_simps)
    also with p2_ge_q2 have "\<dots> = (p^2 - q^2)^2" by (simp only: nat_power2_diff)
    finally have "a^2 = (p^2 - q^2)^2" by simp
    with two0 show ?thesis by (rule_tac n="2" in nat_power_inject_base)
  qed
  moreover have "gcd p q=1"
  proof -
    let ?k = "gcd p q"
    have "?k dvd p \<and> ?k dvd q" by simp
    with b and a have "?k dvd a \<and> ?k dvd b"
      by (simp add: power2_eq_square)
    hence "?k dvd gcd a b" by (simp only: gcd_greatest)
    with ab_relprime show ?thesis by auto
  qed
  ultimately show ?thesis by auto
qed

text {* Now for the case of integers. Based on \textit{nat-euclid-pyth-triples}. *}

corollary int_euclid_pyth_triples: "\<lbrakk> zgcd a b = 1; a \<in> zOdd; a^2 + b^2 = c^2 \<rbrakk>
  \<Longrightarrow> \<exists> p q. a = p^2 - q^2 \<and> b = 2*p*q \<and> \<bar>c\<bar> = p^2 + q^2 \<and> zgcd p q=1"
proof -
  assume ab_rel: "zgcd a b = 1" and aodd: "a \<in> zOdd" and abc: "a^2 + b^2 = c^2"
  let ?a = "nat\<bar>a\<bar>"
  let ?b = "nat\<bar>b\<bar>"
  let ?c = "nat\<bar>c\<bar>"
  have ab2_pos: "a^2 \<ge> 0 \<and> b^2 \<ge> 0" by simp
  hence "nat(a^2) + nat(b^2) = nat(a^2 + b^2)" by (simp only: nat_add_distrib)
  with abc have "nat(a^2) + nat(b^2) = nat(c^2)"
    by (auto simp add: power2_eq_square abs_power2_distrib)
  hence "nat(\<bar>a\<bar>^2) + nat(\<bar>b\<bar>^2) = nat(\<bar>c\<bar>^2)"
    by (simp add: abs_power2_distrib)
  hence new_abc: "?a^2 + ?b^2 = ?c^2"
    by (simp only: nat_mult_distrib power2_eq_square nat_add_distrib)
  moreover from ab_rel have new_ab_rel: "gcd ?a ?b = 1" by (simp add: zgcd_def)
  moreover have new_a_odd: "odd ?a"
  proof -
    from aodd obtain k where k: "a = 2*k+1" by (unfold zOdd_def, auto)
    show ?thesis
    proof (cases)
      assume apos: "a \<ge> 0" with k have "k\<ge>0" by auto
      with k and apos have "?a = 2*(nat k)+1" by arith
      thus ?thesis by simp
    next
      assume "\<not> a\<ge>0" hence aneg: "a<0" by simp
      with k have k2: "2*(-1-k)\<ge> 0" by simp
      have aux2: "(2::int) \<ge> 0" by simp
      have aux1: "(1::int) \<ge> 0" by simp
      from k and aneg have "\<bar>a\<bar> = 2*(-1-k) + 1" by simp
      with k2 aux1 have "?a = nat (2*(-1-k)) + nat 1"
        by (simp only: nat_add_distrib)
      with aux2 have "?a = (nat 2)*nat(-1-k) + nat 1"
        by (simp only: nat_mult_distrib)
      thus ?thesis by simp
    qed
  qed
  ultimately have
    "\<exists> p q. ?a = p^2-q^2 \<and> ?b = 2*p*q \<and> ?c = p^2 + q^2 \<and> gcd p q =1"
    by (rule_tac a="?a" and b = "?b" and c="?c" in nat_euclid_pyth_triples)
  then obtain m and n where mn:
    "?a = m^2-n^2 \<and> ?b = 2*m*n \<and> ?c = m^2 + n^2 \<and> gcd m n =1" by auto
  have "n^2 \<le> m^2"
  proof (rule ccontr)
    assume "\<not> n^2 \<le> m^2" hence "n^2 > m^2" by simp
    with mn have "?a = 0" by simp
    with new_a_odd show False by simp
  qed
  moreover from mn have "int ?a = int(m^2 - n^2)" and "int ?b = int(2*m*n)"
    and "int ?c = int(m^2 + n^2)" by auto
  ultimately have "\<bar>a\<bar> = int(m^2) - int(n^2)" and "\<bar>b\<bar> = int(2*m*n)"
    and "\<bar>c\<bar> = int(m^2) + int(n^2)" by (auto simp only: int_nat_abs_eq_abs zdiff_int)
  hence absabc: "\<bar>a\<bar> = (int m)^2 - (int n)^2 \<and> \<bar>b\<bar> = 2*(int m)*int n
    \<and> \<bar>c\<bar> = (int m)^2 + (int n)^2" by (simp add: power2_eq_square int_mult)
  from mn have mn_rel: "zgcd (int m) (int n) = 1" by (simp add: zgcd_def)
  show "\<exists> p q. a = p^2 - q^2 \<and> b = 2*p*q \<and> \<bar>c\<bar> = p^2 + q^2 \<and> zgcd p q=1"
    (is "\<exists> p q. ?Q p q")
  proof (cases)
    assume apos: "a \<ge> 0" then obtain p where p: "p = int m" by simp
    hence "\<exists> q. ?Q p q"
    proof (cases)
      assume bpos: "b \<ge> 0" then obtain q where "q = int n" by simp
      with p apos bpos absabc mn_rel have "?Q p q" by simp
      thus ?thesis by (rule exI)
    next
      assume "\<not> b\<ge>0" hence bneg: "b<0" by simp
      then obtain q where "q = - int n" by simp
      with p apos bneg absabc mn_rel have "?Q p q" by simp
      thus ?thesis by (rule exI)
    qed
    thus ?thesis by (simp only: exI)
  next
    assume "\<not> a\<ge>0" hence aneg: "a<0" by simp
    then obtain p where p: "p = int n" by simp
    hence "\<exists> q. ?Q p q"
    proof (cases)
      assume bpos: "b \<ge> 0" then obtain q where "q = int m" by simp
      with p aneg bpos absabc mn_rel have "?Q p q"
        by (simp add: zgcd_commute)
      thus ?thesis by (rule exI)
    next
      assume "\<not> b\<ge>0" hence bneg: "b<0" by simp
      then obtain q where "q = - int m" by simp
      with p aneg bneg absabc mn_rel have "?Q p q"
        by (simp add: zgcd_commute ac_simps)
      thus ?thesis by (rule exI)
    qed
    thus ?thesis by (simp only: exI)
  qed
qed

subsection {* Fermat's last theorem, case $n=4$ *}

text {* Core of the proof. Constructs a smaller solution over $\mathbb{Z}$ of $$a^4+b^4=c^2\,\land\,\gcd a b=1\,\land\,abc\ne 0\,\land\,a~{\rm odd}.$$ *}

lemma smaller_fermat4:
  assumes abc: "a^4+b^4=c^2" and abc0: "a*b*c \<noteq> 0" and aodd: "a \<in> zOdd"
    and ab_relprime: "zgcd a b=1"
  shows
  "\<exists> p q r. (p^4+q^4=r^2 \<and> p*q*r \<noteq> 0 \<and> p \<in> zOdd \<and> zgcd p q = 1 \<and> r^2 < c^2)"
proof -
  -- "put equation in shape of a pythagorean triple and obtain $u$ and $v$"
  from ab_relprime have a2b2relprime: "zgcd (a^2) (b^2) = 1"
    by (simp only: zgcd_1_power_distrib)
  moreover from aodd have "a^2 \<in> zOdd" by (simp only: power_preserves_odd)
  moreover from abc have "(a^2)^2 + (b^2)^2 = c^2" by (simp only: quartic_square_square)
  ultimately obtain u and v where uvabc:
    "a^2 = u^2-v^2 \<and> b^2 = 2*u*v \<and> \<bar>c\<bar> = u^2 + v^2 \<and> zgcd u v = 1"
    by (frule_tac a="a^2" in int_euclid_pyth_triples, auto)
  with abc0 have uv0: "u\<noteq>0 \<and> v\<noteq>0" by auto
  have av_relprime: "zgcd a v = 1"
  proof -
    have "zgcd a v dvd zgcd (a^2) v"
      by (simp only: zgcd_zdvd_zgcd_zmult power2_eq_square)
    moreover
    from uvabc have "zgcd v (a^2) dvd zgcd (b^2) (a^2)" by (simp only: zgcd_zdvd_zgcd_zmult)
    with a2b2relprime have "zgcd (a^2) v dvd (1::int)" by (simp only: zgcd_commute)
    ultimately have "zgcd a v dvd 1" by (rule dvd_trans)
    hence "\<bar>zgcd a v\<bar>= 1" by auto
    thus ?thesis by (simp add: zgcd_geq_zero)
  qed
  -- "make again a pythagorean triple and obtain $k$ and $l$"
  from uvabc have "a^2 + v^2 = u^2" by simp
  with av_relprime and aodd obtain k l where
    klavu: "a = k^2-l^2 \<and> v = 2*k*l \<and> \<bar>u\<bar> = k^2+l^2" and kl_rel: "zgcd k l = 1"
    by (frule_tac a="a" in int_euclid_pyth_triples, auto)
  --"prove $b=2m$ and $kl(k^2 + l^2) = m^2$, for coprime $k$, $l$ and $k^2+l^2$"
  from uvabc have "b^2 \<in> zEven" by (unfold zEven_def, auto)
  hence "b \<in> zEven" by (simp only: power_preserves_even)
  then obtain m where bm: "b = 2*m" by (auto simp only: zEven_def)
  have "\<bar>k\<bar>*\<bar>l\<bar>*\<bar>k^2+l^2\<bar> = m^2"
  proof -
    from bm have "4*m^2 = b^2" by (simp only: power2_eq_square ac_simps)
    also have "\<dots> = \<bar>b^2\<bar>" by simp
    also with uvabc have "\<dots> = 2*\<bar>v\<bar>*\<bar>\<bar>u\<bar>\<bar>" by (simp add: abs_mult)
    also with klavu have "\<dots> = 2*\<bar>2*k*l\<bar>*\<bar>k^2+l^2\<bar>" by simp
    also have "\<dots> = 4*\<bar>k\<bar>*\<bar>l\<bar>*\<bar>k^2+l^2\<bar>" by (auto simp add: abs_mult)
    finally show ?thesis by simp
  qed
  moreover have "(2::nat) > 1" by auto
  moreover from kl_rel have "zgcd \<bar>k\<bar> \<bar>l\<bar> = 1" by (unfold zgcd_def, auto)
  moreover have "zgcd \<bar>l\<bar> (\<bar>k^2+l^2\<bar>) = 1"
  proof -
    from kl_rel have "zgcd (k*k) l = 1" by (simp only: zgcd_zgcd_zmult)
    hence "zgcd (k*k+l*l) l = 1" by simp
    hence "zgcd l (k^2+l^2)=1" by (simp only: power2_eq_square zgcd_commute)
    thus ?thesis by (unfold zgcd_def, auto)
  qed
  moreover have "zgcd \<bar>k^2+l^2\<bar> \<bar>k\<bar>=1"
  proof -
    from kl_rel have "zgcd l k = 1" by (simp only: zgcd_commute)
    hence "zgcd (l*l) k = 1" by (simp only: zgcd_zgcd_zmult)
    hence "zgcd (l*l+k*k) k = 1" by simp
    hence "zgcd (k^2+l^2) k = 1" by (simp only: ac_simps power2_eq_square)
    thus ?thesis by (unfold zgcd_def, auto)
  qed
  ultimately have
    "\<exists> x y z. \<bar>\<bar>k\<bar>\<bar> = x^2 \<and> \<bar>\<bar>l\<bar>\<bar> = y^2 \<and> \<bar>\<bar>k^2+l^2\<bar>\<bar> = z^2"
    by (rule int_triple_relprime_power_divisors)
  then obtain \<alpha> \<beta> \<gamma> where albega:
    "\<bar>k\<bar> = \<alpha>^2 \<and> \<bar>l\<bar> = \<beta>^2 \<and> \<bar>k^2+l^2\<bar> = \<gamma>^2"
    by auto
  -- "show this is a new solution"
  have "k^2 = \<alpha>^4"
  proof -
    from albega have "\<bar>k\<bar>^2 = (\<alpha>^2)^2" by simp
    thus ?thesis by (simp add: quartic_square_square abs_power2_distrib)
  qed
  moreover have "l^2 = \<beta>^4"
  proof -
    from albega have "\<bar>l\<bar>^2 = (\<beta>^2)^2" by simp
    thus ?thesis by (simp add: quartic_square_square abs_power2_distrib)
  qed
  moreover have gamma2: "k^2 + l^2 = \<gamma>^2"
  proof -
    have "k^2 \<ge> 0 \<and> l^2 \<ge> 0" by simp
    with albega show ?thesis by auto
  qed
  ultimately have newabc: "\<alpha>^4 + \<beta>^4 = \<gamma>^2" by auto
  from uv0 klavu albega have albega0: "\<alpha> * \<beta> * \<gamma>  \<noteq> 0" by auto
  -- "show the coprimality"
  have alphabeta_relprime: "zgcd \<alpha> \<beta> = 1"
  proof (rule classical)
    let ?g = "zgcd \<alpha> \<beta>"
    assume gnot1: "?g \<noteq> 1"
    have "?g > 1"
    proof -
      have "?g \<noteq> 0"
      proof
        assume "?g=0"
        hence "nat \<bar>\<alpha>\<bar>=0" by (unfold zgcd_def, auto simp add: gcd_zero)
        hence "\<alpha>=0" by arith
        with albega0 show False by simp
      qed
      hence "?g>0" by (auto simp only: zgcd_geq_zero less_le)
      with gnot1 show ?thesis by simp
    qed
    moreover have "?g dvd zgcd k l"
    proof -
      have "?g dvd \<alpha> \<and> ?g dvd \<beta>" by auto
      with albega have "?g dvd \<bar>k\<bar> \<and> ?g dvd \<bar>l\<bar>"
        by (simp add: power2_eq_square mult.commute)
      hence "?g dvd k \<and> ?g dvd l" by simp
      thus ?thesis by (simp add: zgcd_greatest_iff)
    qed
    ultimately have "zgcd k l \<noteq> 1" by auto
    with kl_rel show ?thesis by auto
  qed
  -- "choose $p$ and $q$ in the right way"
  have "\<exists> p q. p^4 + q^4 = \<gamma>^2 \<and> p*q*\<gamma> \<noteq> 0 \<and> p \<in> zOdd \<and> zgcd p q=1"
  proof -
    have "\<alpha> \<in> zOdd \<or> \<beta> \<in> zOdd"
    proof (rule ccontr)
      assume "\<not> (\<alpha> \<in> zOdd \<or> \<beta> \<in> zOdd)"
      hence "\<alpha> \<in> zEven \<and> \<beta> \<in> zEven" by (auto simp add: not_odd_impl_even)
      then have "2 dvd \<alpha> \<and> 2 dvd \<beta>" by (auto simp add: zEven_def)
      then have "2 dvd zgcd \<alpha> \<beta>" by (simp add: zgcd_greatest_iff)
      with alphabeta_relprime show False by auto
    qed
    moreover
    { assume "\<alpha> \<in> zOdd"
      with newabc albega0 alphabeta_relprime obtain p q where
        "p=\<alpha> \<and> q=\<beta> \<and> p^4 + q^4 = \<gamma>^2 \<and> p*q*\<gamma>  \<noteq> 0 \<and> p \<in> zOdd \<and> zgcd p q=1"
        by auto
      hence ?thesis by auto }
    moreover
    { assume "\<beta> \<in> zOdd"
      with newabc albega0 alphabeta_relprime obtain p q where
        "q=\<alpha> \<and> p=\<beta> \<and> p^4 + q^4 = \<gamma>^2 \<and> p*q*\<gamma>  \<noteq> 0 \<and> p \<in> zOdd \<and> zgcd p q=1"
        by (auto simp add: ac_simps zgcd_commute)
      hence ?thesis by auto }
    ultimately show ?thesis by auto
  qed
  -- "show the solution is smaller"
  moreover have "\<gamma>^2 < c^2"
  proof -
    from gamma2 klavu have "\<gamma>^2 \<le> \<bar>u\<bar>" by simp
    also have "\<dots> \<le> \<bar>u\<bar>^2" by (rule power2_ge_self)
    also have "\<dots> \<le> u^2" by (simp add: abs_power2_distrib)
    also have "\<dots> < u^2 + v^2"
    proof -
      from uv0 have v2non0: "0 \<noteq> v^2"
        by simp
      have "0 \<le> v^2" by (rule zero_le_power2)
      with v2non0 have "0 < v^2" by (auto simp add: less_le)
      thus ?thesis by auto
    qed
    also with uvabc have "\<dots> \<le> \<bar>c\<bar>" by auto
    also have "\<dots> \<le> \<bar>c\<bar>^2" by (rule power2_ge_self)
    also have "\<dots> \<le> c^2" by (simp add: abs_power2_distrib)
    finally show ?thesis by simp
  qed
  ultimately show ?thesis by auto
qed

text {* Show that no solution exists, by infinite descent of $c^2$. *}

lemma no_rewritten_fermat4:
  "\<not> (\<exists> a b. (a^4 + b^4 = c^2 \<and> a*b*c \<noteq> 0 \<and> a \<in> zOdd \<and> zgcd a b=1))"
proof (induct c rule: infinite_descent0_measure[where V="\<lambda>c. nat(c^2)"])
  case (0 x)
  have "x^2 \<ge> 0" by (rule zero_le_power2)
  with 0 have "int(nat(x^2)) = 0" by auto
  hence "x = 0" by auto
  thus ?case by auto
next
  case (smaller x)
  then obtain a b where "a^4 + b^4 = x^2" and "a*b*x \<noteq> 0"
    and "a \<in> zOdd" and "zgcd a b=1" by auto
  hence "\<exists> p q r. (p^4+q^4=r^2 \<and> p*q*r \<noteq> 0 \<and> p \<in> zOdd
    \<and> zgcd p q=1 \<and> r^2 < x^2)" by (rule smaller_fermat4)
  then obtain p q r where pqr: "p^4 + q^4 = r^2 \<and> p*q*r \<noteq> 0 \<and> p \<in> zOdd
    \<and> zgcd p q=1 \<and> r^2 < x^2" by auto
  have "r^2 \<ge> 0" and "x^2 \<ge> 0" by (auto simp only: zero_le_power2)
  hence "int(nat(r^2)) = r^2 \<and> int(nat(x^2)) = x^2" by auto
  with pqr have "int(nat(r^2)) < int(nat(x^2))" by auto
  hence "nat(r^2) < nat(x^2)" by (simp only: zless_int)
  with pqr show ?case by auto
qed

text {* The theorem. Puts equation in requested shape. *}

theorem fermat4:
  assumes ass: "(x::int)^4 + y^4 = z^4"
  shows "x*y*z=0"
proof (rule ccontr)
  let ?g = "zgcd x y"
  let ?c = "(z div ?g)^2"
  assume xyz0: "x*y*z \<noteq> 0"
  -- "divide out the g.c.d."
  hence "x \<noteq> 0 \<or> y \<noteq> 0" by simp
  then obtain a b where ab: "x = ?g*a \<and> y = ?g*b \<and> zgcd a b=1"
    by (frule_tac a="x" in make_zrelprime, auto)
  moreover have abc: "a^4 + b^4 = ?c^2 \<and> a*b*?c \<noteq> 0"
  proof -
    have zgab: "z^4 = ?g^4 * (a^4+b^4)"
    proof -
      from ab ass have "z^4 = (?g*a)^4+(?g*b)^4" by simp
      thus ?thesis by (simp only: power_mult_distrib distrib_left)
    qed
    have cgz: "z^2 = ?c * ?g^2"
    proof -
      from zgab have "?g^4 dvd z^4" by simp
      hence "?g dvd z" by (simp only: zpower_zdvd_mono)
      hence "(z div ?g)*?g = z" by (simp only: ac_simps dvd_mult_div_cancel)
      with ab show ?thesis by (auto simp only: power2_eq_square ac_simps)
    qed
    with xyz0 have c0: "?c\<noteq>0" by (auto simp add: power2_eq_square)
    from xyz0 have g0: "?g\<noteq>0" by (simp add: zgcd_def gcd_zero)
    have "a^4 + b^4 = ?c^2"
    proof -
      have "?c^2 * ?g^4 = (a^4+b^4)*?g^4"
      proof -
        have "?c^2 * ?g^4 = (?c*?g^2)^2"
          by (simp only: quartic_square_square power_mult_distrib)
        also with cgz have "\<dots> = (z^2)^2" by simp
        also have "\<dots> = z^4" by (rule quartic_square_square)
        also with zgab have "\<dots> = ?g^4*(a^4+b^4)" by simp
        finally show ?thesis by simp
      qed
      with g0 show ?thesis by auto
    qed
    moreover from ab xyz0 c0 have "a*b*?c\<noteq>0" by auto
    ultimately show ?thesis by simp
  qed
  -- "choose the parity right"
  have "\<exists> p q. p^4 + q^4 = ?c^2 \<and> p*q*?c\<noteq>0 \<and> p \<in> zOdd \<and> zgcd p q=1"
  proof -
    have "a \<in> zOdd \<or> b \<in> zOdd"
    proof (rule ccontr)
      assume "\<not>(a \<in> zOdd \<or> b \<in> zOdd)"
      hence "a \<in> zEven \<and> b \<in> zEven" by (auto simp add: not_odd_impl_even)
      hence "2 dvd a \<and> 2 dvd b" by (auto simp add: zEven_def)
      hence "2 dvd zgcd a b" by (simp add: zgcd_greatest_iff)
      with ab show False by auto
    qed
    moreover
    { assume "a \<in> zOdd"
      then obtain p q where "p = a" and "q = b" and "p \<in> zOdd" by simp
      with ab abc have ?thesis by auto }
    moreover
    { assume "b \<in> zOdd"
      then obtain p q where "p = b" and "q = a" and "p \<in> zOdd" by simp
      with ab abc have
        "p^4 + q^4 = ?c^2 \<and> p*q*?c\<noteq>0 \<and> p \<in> zOdd \<and> zgcd p q=1"
        by (auto simp add: zgcd_commute mult.commute)
      hence ?thesis by auto }
    ultimately show ?thesis by auto
  qed
  -- "show contradiction using the earlier result"
  thus False by (auto simp only: no_rewritten_fermat4)
qed

corollary fermat_mult4:
  assumes xyz: "(x::int)^n + y^n = z^n" and n: "4 dvd n"
  shows "x*y*z=0"
proof -
  from n obtain m where "n = m*4" by (auto simp only: ac_simps dvd_def)
  with xyz have "(x^m)^4 + (y^m)^4 = (z^m)^4" by (simp only: power_mult)
  hence "(x^m)*(y^m)*(z^m) = 0" by (rule fermat4)
  thus ?thesis by auto
qed

end