(*<*)theory Even imports Main begin
ML_file "../../antiquote_setup.ML"
(*>*)

section{* The Set of Even Numbers *}

text {*
\index{even numbers!defining inductively|(}%
The set of even numbers can be inductively defined as the least set
containing 0 and closed under the operation $+2$.  Obviously,
\emph{even} can also be expressed using the divides relation (@{text dvd}).
We shall prove below that the two formulations coincide.  On the way we
shall examine the primary means of reasoning about inductively defined
sets: rule induction.
*}

subsection{* Making an Inductive Definition *}

text {*
Using \commdx{inductive\protect\_set}, we declare the constant @{text even} to be
a set of natural numbers with the desired properties.
*}

inductive_set even :: "nat set" where
zero[intro!]: "0 \<in> even" |
step[intro!]: "n \<in> even \<Longrightarrow> (Suc (Suc n)) \<in> even"

text {*
An inductive definition consists of introduction rules.  The first one
above states that 0 is even; the second states that if $n$ is even, then so
is~$n+2$.  Given this declaration, Isabelle generates a fixed point
definition for @{term even} and proves theorems about it,
thus following the definitional approach (see {\S}\ref{sec:definitional}).
These theorems
include the introduction rules specified in the declaration, an elimination
rule for case analysis and an induction rule.  We can refer to these
theorems by automatically-generated names.  Here are two examples:
@{named_thms[display,indent=0] even.zero[no_vars] (even.zero) even.step[no_vars] (even.step)}

The introduction rules can be given attributes.  Here
both rules are specified as \isa{intro!},%
\index{intro"!@\isa {intro"!} (attribute)}
directing the classical reasoner to
apply them aggressively. Obviously, regarding 0 as even is safe.  The
@{text step} rule is also safe because $n+2$ is even if and only if $n$ is
even.  We prove this equivalence later.
*}

subsection{*Using Introduction Rules*}

text {*
Our first lemma states that numbers of the form $2\times k$ are even.
Introduction rules are used to show that specific values belong to the
inductive set.  Such proofs typically involve
induction, perhaps over some other inductive set.
*}

lemma two_times_even[intro!]: "2*k \<in> even"
apply (induct_tac k)
 apply auto
done
(*<*)
lemma "2*k \<in> even"
apply (induct_tac k)
(*>*)
txt {*
\noindent
The first step is induction on the natural number @{text k}, which leaves
two subgoals:
@{subgoals[display,indent=0,margin=65]}
Here @{text auto} simplifies both subgoals so that they match the introduction
rules, which are then applied automatically.

Our ultimate goal is to prove the equivalence between the traditional
definition of @{text even} (using the divides relation) and our inductive
definition.  One direction of this equivalence is immediate by the lemma
just proved, whose @{text "intro!"} attribute ensures it is applied automatically.
*}
(*<*)oops(*>*)
lemma dvd_imp_even: "2 dvd n \<Longrightarrow> n \<in> even"
by (auto simp add: dvd_def)

subsection{* Rule Induction \label{sec:rule-induction} *}

text {*
\index{rule induction|(}%
From the definition of the set
@{term even}, Isabelle has
generated an induction rule:
@{named_thms [display,indent=0,margin=40] even.induct [no_vars] (even.induct)}
A property @{term P} holds for every even number provided it
holds for~@{text 0} and is closed under the operation
\isa{Suc(Suc \(\cdot\))}.  Then @{term P} is closed under the introduction
rules for @{term even}, which is the least set closed under those rules.
This type of inductive argument is called \textbf{rule induction}.

Apart from the double application of @{term Suc}, the induction rule above
resembles the familiar mathematical induction, which indeed is an instance
of rule induction; the natural numbers can be defined inductively to be
the least set containing @{text 0} and closed under~@{term Suc}.

Induction is the usual way of proving a property of the elements of an
inductively defined set.  Let us prove that all members of the set
@{term even} are multiples of two.
*}

lemma even_imp_dvd: "n \<in> even \<Longrightarrow> 2 dvd n"
txt {*
We begin by applying induction.  Note that @{text even.induct} has the form
of an elimination rule, so we use the method @{text erule}.  We get two
subgoals:
*}
apply (erule even.induct)
txt {*
@{subgoals[display,indent=0]}
We unfold the definition of @{text dvd} in both subgoals, proving the first
one and simplifying the second:
*}
apply (simp_all add: dvd_def)
txt {*
@{subgoals[display,indent=0]}
The next command eliminates the existential quantifier from the assumption
and replaces @{text n} by @{text "2 * k"}.
*}
apply clarify
txt {*
@{subgoals[display,indent=0]}
To conclude, we tell Isabelle that the desired value is
@{term "Suc k"}.  With this hint, the subgoal falls to @{text simp}.
*}
apply (rule_tac x = "Suc k" in exI, simp)
(*<*)done(*>*)

text {*
Combining the previous two results yields our objective, the
equivalence relating @{term even} and @{text dvd}.
%
%we don't want [iff]: discuss?
*}

theorem even_iff_dvd: "(n \<in> even) = (2 dvd n)"
by (blast intro: dvd_imp_even even_imp_dvd)

subsection{* Generalization and Rule Induction \label{sec:gen-rule-induction} *}

text {*
\index{generalizing for induction}%
Before applying induction, we typically must generalize
the induction formula.  With rule induction, the required generalization
can be hard to find and sometimes requires a complete reformulation of the
problem.  In this  example, our first attempt uses the obvious statement of
the result.  It fails:
*}

lemma "Suc (Suc n) \<in> even \<Longrightarrow> n \<in> even"
apply (erule even.induct)
oops
(*<*)
lemma "Suc (Suc n) \<in> even \<Longrightarrow> n \<in> even"
apply (erule even.induct)
(*>*)
txt {*
Rule induction finds no occurrences of @{term "Suc(Suc n)"} in the
conclusion, which it therefore leaves unchanged.  (Look at
@{text even.induct} to see why this happens.)  We have these subgoals:
@{subgoals[display,indent=0]}
The first one is hopeless.  Rule induction on
a non-variable term discards information, and usually fails.
How to deal with such situations
in general is described in {\S}\ref{sec:ind-var-in-prems} below.
In the current case the solution is easy because
we have the necessary inverse, subtraction:
*}
(*<*)oops(*>*)
lemma even_imp_even_minus_2: "n \<in> even \<Longrightarrow> n - 2 \<in> even"
apply (erule even.induct)
 apply auto
done
(*<*)
lemma "n \<in>  even \<Longrightarrow> n - 2 \<in> even"
apply (erule even.induct)
(*>*)
txt {*
This lemma is trivially inductive.  Here are the subgoals:
@{subgoals[display,indent=0]}
The first is trivial because @{text "0 - 2"} simplifies to @{text 0}, which is
even.  The second is trivial too: @{term "Suc (Suc n) - 2"} simplifies to
@{term n}, matching the assumption.%
\index{rule induction|)}  %the sequel isn't really about induction

\medskip
Using our lemma, we can easily prove the result we originally wanted:
*}
(*<*)oops(*>*)
lemma Suc_Suc_even_imp_even: "Suc (Suc n) \<in> even \<Longrightarrow> n \<in> even"
by (drule even_imp_even_minus_2, simp)

text {*
We have just proved the converse of the introduction rule @{text even.step}.
This suggests proving the following equivalence.  We give it the
\attrdx{iff} attribute because of its obvious value for simplification.
*}

subsection{* Rule Inversion \label{sec:rule-inversion} *}

text {*
\index{rule inversion|(}%
Case analysis on an inductive definition is called \textbf{rule
inversion}.  It is frequently used in proofs about operational
semantics.  It can be highly effective when it is applied
automatically.  Let us look at how rule inversion is done in
Isabelle/HOL\@.

Recall that @{term even} is the minimal set closed under these two rules:
@{thm [display,indent=0] even.intros [no_vars]}
Minimality means that @{term even} contains only the elements that these
rules force it to contain.  If we are told that @{term a}
belongs to
@{term even} then there are only two possibilities.  Either @{term a} is @{text 0}
or else @{term a} has the form @{term "Suc(Suc n)"}, for some suitable @{term n}
that belongs to
@{term even}.  That is the gist of the @{term cases} rule, which Isabelle proves
for us when it accepts an inductive definition:
@{named_thms [display,indent=0,margin=40] even.cases [no_vars] (even.cases)}
This general rule is less useful than instances of it for
specific patterns.  For example, if @{term a} has the form
@{term "Suc(Suc n)"} then the first case becomes irrelevant, while the second
case tells us that @{term n} belongs to @{term even}.  Isabelle will generate
this instance for us:
*}

inductive_cases Suc_Suc_cases [elim!]: "Suc(Suc n) \<in> even"

text {*
The \commdx{inductive\protect\_cases} command generates an instance of
the @{text cases} rule for the supplied pattern and gives it the supplied name:
@{named_thms [display,indent=0] Suc_Suc_cases [no_vars] (Suc_Suc_cases)}
Applying this as an elimination rule yields one case where @{text even.cases}
would yield two.  Rule inversion works well when the conclusions of the
introduction rules involve datatype constructors like @{term Suc} and @{text "#"}
(list ``cons''); freeness reasoning discards all but one or two cases.

In the \isacommand{inductive\_cases} command we supplied an
attribute, @{text "elim!"},
\index{elim"!@\isa {elim"!} (attribute)}%
indicating that this elimination rule can be
applied aggressively.  The original
@{term cases} rule would loop if used in that manner because the
pattern~@{term a} matches everything.

The rule @{text Suc_Suc_cases} is equivalent to the following implication:
@{term [display,indent=0] "Suc (Suc n) \<in> even \<Longrightarrow> n \<in> even"}
Just above we devoted some effort to reaching precisely
this result.  Yet we could have obtained it by a one-line declaration,
dispensing with the lemma @{text even_imp_even_minus_2}.
This example also justifies the terminology
\textbf{rule inversion}: the new rule inverts the introduction rule
@{text even.step}.  In general, a rule can be inverted when the set of elements
it introduces is disjoint from those of the other introduction rules.

For one-off applications of rule inversion, use the \methdx{ind_cases} method.
Here is an example:
*}

(*<*)lemma "Suc(Suc n) \<in> even \<Longrightarrow> P"(*>*)
apply (ind_cases "Suc(Suc n) \<in> even")
(*<*)oops(*>*)

text {*
The specified instance of the @{text cases} rule is generated, then applied
as an elimination rule.

To summarize, every inductive definition produces a @{text cases} rule.  The
\commdx{inductive\protect\_cases} command stores an instance of the
@{text cases} rule for a given pattern.  Within a proof, the
@{text ind_cases} method applies an instance of the @{text cases}
rule.

The even numbers example has shown how inductive definitions can be
used.  Later examples will show that they are actually worth using.%
\index{rule inversion|)}%
\index{even numbers!defining inductively|)}
*}

(*<*)end(*>*)


(*  Author: Lukas Bulwahn <lukas.bulwahn-at-gmail.com> *)

section \<open>Proving Falling Factorial of a Sum with Induction\<close>

theory Falling_Factorial_Sum_Induction
imports
  Discrete_Summation.Factorials
begin

text \<open>Note the potentially special copyright license condition of the following proof.\<close>

lemma ffact_add_nat:
  "ffact n (x + y) = (\<Sum>k=0..n. (n choose k) * ffact k x * ffact (n - k) y)"
proof (induct n)
  case 0
  show ?case by simp
next
  case (Suc n)
  let ?s = "\<lambda>k. (n choose k) * ffact k x * ffact (n - k) y"
  let ?t = "\<lambda>k. ffact k x * ffact (Suc n - k) y"
  let ?u = "\<lambda>k. ffact (Suc k) x * ffact (n - k) y"
  have "ffact (Suc n) (x + y) = (x + y - n) * ffact n (x + y)"
    by (simp add: ffact_Suc_rev_nat)
  also have "\<dots> = (x + y - n) * (\<Sum>k = 0..n. (n choose k) * ffact k x * ffact (n - k) y)"
    using Suc.hyps by simp
  also have "\<dots> = (\<Sum>k = 0..n. ?s k * (x + y - n))"
    by (simp add: mult.commute sum_distrib_left)
  also have "\<dots> = (\<Sum>k = 0..n. ?s k * ((y + k - n) + (x - k)))"
  proof -
    have "?s k * (x + y - n) = ?s k * ((y + k - n) + (x - k))" for k
      by (cases "k \<le> x \<or> n - k \<le> y") (auto simp add: ffact_nat_triv)
    from this show ?thesis
      by (auto intro: sum.cong simp only: refl)
  qed
  also have "\<dots> = (\<Sum>k = 0..n. (n choose k) * (?t k + ?u k))"
    by (auto intro!: sum.cong simp add: Suc_diff_le ffact_Suc_rev_nat) algebra
  also have "\<dots> = (\<Sum>k = 0..n. (n choose k) * ?t k) + (\<Sum>k = 0..n. (n choose k) * ?u k)"
    by (simp add: sum.distrib add_mult_distrib2 mult.commute mult.left_commute)
  also have "\<dots> = ?t 0 + (\<Sum>k = 0..n. (n choose k + (n choose Suc k)) * ?u k)"
  proof -
    have "\<dots> = (?t 0 + (\<Sum>k = 0..n. (n choose Suc k) * ?u k)) + (\<Sum>k = 0..n. (n choose k) * ?u k)"
    proof -
      have "(\<Sum>k = Suc 0..n. (n choose k) * ?t k) = (\<Sum>k = 0..n. (n choose Suc k) * ?u k)"
      proof -
        have "(\<Sum>k = Suc 0..n. (n choose k) * ?t k) = (\<Sum>k = Suc 0..Suc n. (n choose k) * ?t k)"
          by simp
        also have "\<dots> = (sum ((\<lambda>k. (n choose k) * ?t k) o Suc) {0..n})"
          by (simp only: sum.reindex[symmetric, of Suc] inj_Suc image_Suc_atLeastAtMost)
        also have "\<dots> = (\<Sum>k = 0..n. (n choose Suc k) * ?u k)"
          by simp
        finally show ?thesis .
      qed
      from this show ?thesis
        by (simp add: sum.atLeast_Suc_atMost[of _ _ "\<lambda>k. (n choose k) * ?t k"])
    qed
    also have "\<dots> = ?t 0 + (\<Sum>k = 0..n. (n choose k + (n choose Suc k)) * ?u k)"
      by (simp add: distrib_right sum.distrib)
    finally show ?thesis .
  qed
  also have "\<dots> = (\<Sum>k = 0..Suc n. (Suc n choose k) * ffact k x * ffact (Suc n - k) y)"
  proof -
    let ?v = "\<lambda>k. (Suc n choose k) * ffact k x * ffact (Suc n - k) y"
    have "\<dots> = ?v 0 + (\<Sum>k = 0..n. (Suc n choose (Suc k)) * ?u k)"
      by simp
    also have "\<dots> = ?v 0 + (\<Sum>k = Suc 0..Suc n. ?v k)"
      by (simp only: sum.shift_bounds_cl_Suc_ivl diff_Suc_Suc mult.assoc)
    also have "\<dots> = (\<Sum>k = 0..Suc n. (Suc n choose k) * ffact k x * ffact (Suc n - k) y)"
      by (simp add: sum.atLeast_Suc_atMost)
    finally show ?thesis .
  qed
  finally show ?case .
qed

(* TODO: what's the right class here? *)
lemma ffact_add:
  fixes x y :: "'a::{ab_group_add, comm_semiring_1_cancel, ring_1}"
  shows "ffact n (x + y) = (\<Sum>k=0..n. of_nat (n choose k) * ffact k x * ffact (n - k) y)"
proof (induct n)
  case 0
  show ?case by simp
next
  case (Suc n)
  let ?s = "\<lambda>k. of_nat (n choose k) * ffact k x * ffact (n - k) y"
  let ?t = "\<lambda>k. ffact k x * ffact (Suc n - k) y"
  let ?u = "\<lambda>k. ffact (Suc k) x * ffact (n - k) y"
  have "ffact (Suc n) (x + y) = (x + y - of_nat n) * ffact n (x + y)"
    by (simp add: ffact_Suc_rev)
  also have "\<dots> = (x + y - of_nat n) * (\<Sum>k = 0..n. of_nat (n choose k) * ffact k x * ffact (n - k) y)"
    using Suc.hyps by simp
  also have "\<dots> = (\<Sum>k = 0..n. ?s k * (x + y - of_nat n))"
    by (simp add: mult.commute sum_distrib_left)
  also have "\<dots> = (\<Sum>k = 0..n. ?s k * ((y + of_nat k - of_nat n) + (x - of_nat k)))"
    by (auto intro: sum.cong simp add: diff_add_eq add_diff_eq add.commute)
  also have "\<dots> = (\<Sum>k = 0..n. of_nat (n choose k) * (?t k + ?u k))"
  proof -
    {
      fix k
      assume "k \<le> n"
      have "?u k = ffact k x * ffact (n - k) y * (x - of_nat k)"
        by (simp add: ffact_Suc_rev Suc_diff_le of_nat_diff mult.commute mult.left_commute)
      moreover from \<open>k \<le> n\<close> have "?t k = ffact k x * ffact (n - k) y * (y + of_nat k - of_nat n)"
        by (simp add: ffact_Suc_rev Suc_diff_le of_nat_diff diff_diff_eq2 mult.commute mult.left_commute)
      ultimately have
        "?s k * ((y + of_nat k - of_nat n) + (x - of_nat k)) = of_nat (n choose k) * (?t k + ?u k)"
        by (metis (no_types, lifting) distrib_left mult.assoc)
    }
    from this show ?thesis by (auto intro: sum.cong)
  qed
  also have "\<dots> = (\<Sum>k = 0..n. of_nat (n choose k) * ?t k) + (\<Sum>k = 0..n. of_nat (n choose k) * ?u k)"
    by (simp add: sum.distrib distrib_left mult.commute mult.left_commute)
  also have "\<dots> = ?t 0 + (\<Sum>k = 0..n. of_nat (n choose k + (n choose Suc k)) * ?u k)"
  proof -
    have "\<dots> = (?t 0 + (\<Sum>k = 0..n. of_nat (n choose Suc k) * ?u k)) + (\<Sum>k = 0..n. of_nat (n choose k) * ?u k)"
    proof -
      have "(\<Sum>k = Suc 0..n. of_nat (n choose k) * ?t k) = (\<Sum>k = 0..n. of_nat (n choose Suc k) * ?u k)"
      proof -
        have "(\<Sum>k = Suc 0..n. of_nat (n choose k) * ?t k) = (\<Sum>k = Suc 0..Suc n. of_nat (n choose k) * ?t k)"
          by (simp add: binomial_eq_0)
        also have "\<dots> = (sum ((\<lambda>k. of_nat (n choose k) * ?t k) o Suc) {0..n})"
          by (simp only: sum.reindex[symmetric, of Suc] inj_Suc image_Suc_atLeastAtMost)
        also have "\<dots> = (\<Sum>k = 0..n. of_nat (n choose Suc k) * ?u k)"
          by simp
        finally show ?thesis .
      qed
      from this show ?thesis
        by (simp add: sum.atLeast_Suc_atMost[of _ _ "\<lambda>k. of_nat (n choose k) * ?t k"])
    qed
    also have "\<dots> = ?t 0 + (\<Sum>k = 0..n. of_nat (n choose k + (n choose Suc k)) * ?u k)"
      by (simp add: distrib_right sum.distrib)
    finally show ?thesis .
  qed
  also have "\<dots> = (\<Sum>k = 0..Suc n. of_nat (Suc n choose k) * ffact k x * ffact (Suc n - k) y)"
  proof -
    let ?v = "\<lambda>k. of_nat (Suc n choose k) * ffact k x * ffact (Suc n - k) y"
    have "\<dots> = ?v 0 + (\<Sum>k = 0..n. of_nat (Suc n choose (Suc k)) * ?u k)"
      by simp
    also have "\<dots> = ?v 0 + (\<Sum>k = Suc 0..Suc n. ?v k)"
      by (simp only: sum.shift_bounds_cl_Suc_ivl diff_Suc_Suc mult.assoc)
    also have "\<dots> = (\<Sum>k = 0..Suc n. of_nat (Suc n choose k) * ffact k x * ffact (Suc n - k) y)"
      by (simp add: sum.atLeast_Suc_atMost)
    finally show ?thesis .
  qed
  finally show ?case .
qed

end


(*
    File:      Moebius_Mu.thy
    Author:    Manuel Eberl, TU München
*)
section \<open>The M\"{o}bius $\mu$ function\<close>
theory Moebius_Mu
imports
  Main
  "HOL-Number_Theory.Number_Theory"
  "HOL-Computational_Algebra.Squarefree"
  Dirichlet_Series
  Dirichlet_Misc
begin

definition moebius_mu :: "nat \<Rightarrow> 'a :: comm_ring_1" where
  "moebius_mu n =
     (if squarefree n then (-1) ^ card (prime_factors n) else 0)"

lemma abs_moebius_mu_le: "abs (moebius_mu n :: 'a :: {linordered_idom}) \<le> 1"
  by (auto simp add: moebius_mu_def)

lemma of_int_moebius_mu [simp]: "of_int (moebius_mu n) = moebius_mu n"
  by (simp add: moebius_mu_def)

lemma minus_1_power_ring_neq_zero [simp]: "(- 1 :: 'a :: ring_1) ^ n \<noteq> 0"
  by (cases "even n") simp_all

lemma moebius_mu_0 [simp]: "moebius_mu 0 = 0"
  by (simp add: moebius_mu_def)

lemma fds_nth_fds_moebius_mu [simp]: "fds_nth (fds moebius_mu) = moebius_mu"
  by (simp add: fun_eq_iff fds_nth_fds)

lemma prime_factors_Suc_0 [simp]: "prime_factors (Suc 0) = {}"
  by simp

lemma moebius_mu_Suc_0 [simp]: "moebius_mu (Suc 0) = 1"
  by (simp add: moebius_mu_def)

lemma moebius_mu_1 [simp]: "moebius_mu 1 = 1"
  by (simp add: moebius_mu_def)

lemma moebius_mu_eq_zero_iff: "moebius_mu n = 0 \<longleftrightarrow> \<not>squarefree n"
  by (simp add: moebius_mu_def)

lemma moebius_mu_not_squarefree [simp]: "\<not>squarefree n \<Longrightarrow> moebius_mu n = 0"
  by (simp add: moebius_mu_def)

lemma moebius_mu_power:
  assumes "a > 1" "n > 1"
  shows   "moebius_mu (a ^ n) = 0"
proof -
  from assms have "a ^ 2 dvd a ^ n" by (simp add: le_imp_power_dvd)
  with moebius_mu_eq_zero_iff[of "a ^ n"] and \<open>a > 1\<close> show ?thesis by (auto simp: squarefree_def)
qed

lemma moebius_mu_power':
  "moebius_mu (a ^ n) = (if a = 1 \<or> n = 0 then 1 else if n = 1 then moebius_mu a else 0)"
  by (simp add: squarefree_power_iff)

lemma moebius_mu_squarefree_eq:
  "squarefree n \<Longrightarrow> moebius_mu n = (-1) ^ card (prime_factors n)"
  by (simp add: moebius_mu_def split: if_splits)

lemma moebius_mu_squarefree_eq':
  assumes "squarefree n"
  shows   "moebius_mu n = (-1) ^ size (prime_factorization n)"
proof -
  let ?P = "prime_factorization n"
  from assms have [simp]: "n > 0" by (auto intro!: Nat.gr0I)
  have "size ?P = sum (count ?P) (set_mset ?P)" by (rule size_multiset_overloaded_eq)
  also from assms have "\<dots> = sum (\<lambda>_. 1) (set_mset ?P)"
    by (intro sum.cong refl, subst count_prime_factorization_prime)
       (auto simp: moebius_mu_eq_zero_iff squarefree_factorial_semiring')
  also have "\<dots> = card (set_mset ?P)" by simp
  finally show ?thesis by (simp add: moebius_mu_squarefree_eq[OF assms])
qed

lemma sum_moebius_mu_divisors:
  assumes "n > 1"
  shows   "(\<Sum>d | d dvd n. moebius_mu d) = (0 :: 'a :: comm_ring_1)"
proof -
  have "(\<Sum>d | d dvd n. moebius_mu d :: int) =
          (\<Sum>d \<in> Prod ` {P. P \<subseteq> prime_factors n}. moebius_mu d)"
  proof (rule sum.mono_neutral_right; safe?)
    fix A assume A: "A \<subseteq> prime_factors n"
    from A have [simp]: "finite A" by (rule finite_subset) auto
    from A have A': "x > 0" "prime x" if "x \<in> A" for x using that
      by (auto simp: prime_factors_multiplicity prime_gt_0_nat)
    from A' have A_nz: "\<Prod>A \<noteq> 0" by (intro notI) auto
    from A' have "prime_factorization (\<Prod>A) = sum prime_factorization A"
      by (subst prime_factorization_prod) (auto dest: finite_subset)
    also from A' have "\<dots> = sum (\<lambda>x. {#x#}) A"
      by (intro sum.cong refl) (auto simp: prime_factorization_prime)
    also have "\<dots> = mset_set A" by simp
    also from A have "\<dots> \<subseteq># mset_set (prime_factors n)"
      by (rule subset_imp_msubset_mset_set) simp_all
    also have "\<dots> \<subseteq># prime_factorization n" by (rule mset_set_set_mset_msubset)
    finally show "\<Prod>A dvd n" using A_nz
      by (intro prime_factorization_subset_imp_dvd) auto
  next
    fix x assume x: "x \<notin> Prod ` {P. P \<subseteq> prime_factors n}" "x dvd n"
    from x assms have [simp]: "x > 0" by (auto intro!: Nat.gr0I)
    {
      assume nz: "moebius_mu x \<noteq> 0"
      have "(\<Prod>(set_mset (prime_factorization x))) = (\<Prod>p\<in>prime_factors x. p ^ multiplicity p x)"
        using nz by (intro prod.cong refl)
                    (auto simp: moebius_mu_eq_zero_iff squarefree_factorial_semiring')
      also have "\<dots> = x" by (intro Primes.prime_factorization_nat [symmetric]) auto
      finally have "x = \<Prod>(prime_factors x)" "prime_factors x \<subseteq> prime_factors n"
        using dvd_prime_factors[of n x] assms \<open>x dvd n\<close> by auto
      hence "x \<in> Prod ` {P. P \<subseteq> prime_factors n}" by blast
      with x(1) have False by contradiction
    }
    thus "moebius_mu x = 0" by blast
  qed (insert assms, auto)
  also have "\<dots> = (\<Sum>P | P \<subseteq> prime_factors n. moebius_mu (\<Prod>P))"
    by (subst sum.reindex) (auto intro!: inj_on_Prod_primes dest: finite_subset)
  also have "\<dots> = (\<Sum>P | P \<subseteq> prime_factors n. (-1) ^ card P)"
  proof (intro sum.cong refl)
    fix P assume P: "P \<in> {P. P \<subseteq> prime_factors n}"
    hence [simp]: "finite P" by (auto dest: finite_subset)
    from P have prime: "prime p" if "p \<in> P" for p using that by (auto simp: prime_factors_dvd)
    hence "squarefree (\<Prod>P)"
      by (intro squarefree_prod_coprime prime_imp_coprime squarefree_prime)
         (auto simp: primes_dvd_imp_eq)
    hence "moebius_mu (\<Prod>P) = (-1) ^ card (prime_factors (\<Prod>P))"
      by (rule moebius_mu_squarefree_eq)
    also from P have "prime_factors (\<Prod>P) = P"
      by (subst prime_factors_prod) (auto simp: prime_factorization_prime prime)
    finally show  "moebius_mu (\<Prod>P) = (-1) ^ card P" .
  qed
  also have "{P. P \<subseteq> prime_factors n} =
               {P. P \<subseteq> prime_factors n \<and> even (card P)} \<union> {P. P \<subseteq> prime_factors n \<and> odd (card P)}"
    (is "_ = ?A \<union> ?B") by blast
  also have "(\<Sum>P \<in> \<dots>. (-1) ^ card P) = (\<Sum>P \<in> ?A. (-1) ^ card P) + (\<Sum>P \<in> ?B. (-1) ^ card P)"
    by (intro sum.union_disjoint) auto
  also have "(\<Sum>P \<in> ?A. (-1) ^ card P :: int) = (\<Sum>P \<in> ?A. 1)" by (intro sum.cong refl) auto
  also have "\<dots> = int (card ?A)" by simp
  also have "(\<Sum>P \<in> ?B. (-1) ^ card P :: int) = (\<Sum>P \<in> ?B. -1)" by (intro sum.cong refl) auto
  also have "\<dots> = -int (card ?B)" by simp
  also have "card ?B = card ?A"
    by (rule card_even_odd_subset [symmetric])
       (insert assms, auto simp: prime_factorization_empty_iff)
  also have "int (card ?A) + (- int (card ?A)) = 0" by simp
  finally have "(\<Sum>d | d dvd n. of_int (moebius_mu d) :: 'a) = 0"
    unfolding of_int_sum [symmetric] by (simp only: of_int_0)
  thus ?thesis by simp
qed

lemma sum_moebius_mu_divisors':
  "(\<Sum>d | d dvd n. moebius_mu d) = (if n = 1 then 1 else 0)"
proof -
  have "n = 0 \<or> n = 1 \<or> n > 1" by force
  thus ?thesis using sum_moebius_mu_divisors[of n] by auto
qed

lemma fds_zeta_times_moebius_mu: "fds_zeta * fds moebius_mu = 1"
proof
  fix n :: nat assume n: "n > 0"
  from n have "fds_nth (fds_zeta * fds moebius_mu :: 'a fds) n = (\<Sum>d | d dvd n. moebius_mu d)"
    unfolding fds_nth_mult dirichlet_prod_altdef1
    by (intro sum.cong refl) (auto simp: fds_nth_fds elim: dvdE)
  also have "\<dots> = fds_nth 1 n" by (simp add: sum_moebius_mu_divisors')
  finally show "fds_nth (fds_zeta * fds moebius_mu :: 'a fds) n = fds_nth 1 n" .
qed

lemma fds_moebius_inverse_zeta:
  "fds moebius_mu = inverse (fds_zeta :: 'a :: field fds)"
  using fds_right_inverse_unique fds_zeta_times_moebius_mu by blast

lemma moebius_mu_formula_real: "(moebius_mu n :: real) = dirichlet_inverse (\<lambda>_. 1) 1 n"
proof -
  have "moebius_mu n = (fds_nth (fds moebius_mu) n :: real)" by simp
  also have "fds moebius_mu = (inverse fds_zeta :: real fds)" by (fact fds_moebius_inverse_zeta)
  also have "fds_nth \<dots> n = dirichlet_inverse (fds_nth fds_zeta) 1 n"
    unfolding fds_nth_inverse by simp
  also have "\<dots> = dirichlet_inverse (\<lambda>_. 1) 1 n" by (rule dirichlet_inverse_cong) simp_all
  finally show ?thesis .
qed

lemma moebius_mu_formula_int: "moebius_mu n = dirichlet_inverse (\<lambda>_. 1 :: int) 1 n"
proof -
  have "real_of_int (moebius_mu n) = moebius_mu n" by simp
  also have "\<dots> = dirichlet_inverse (\<lambda>_. 1) 1 n" by (fact moebius_mu_formula_real)
  also have "\<dots> = real_of_int (dirichlet_inverse (\<lambda>_. 1) 1 n)"
    by (induction n rule: dirichlet_inverse_induct) (simp_all add: dirichlet_inverse_gt_1)
  finally show ?thesis by (subst (asm) of_int_eq_iff)
qed

lemma moebius_mu_formula: "moebius_mu n = dirichlet_inverse (\<lambda>_. 1) 1 n"
  by (subst of_int_moebius_mu [symmetric], subst moebius_mu_formula_int)
     (simp add: of_int_dirichlet_inverse)

interpretation moebius_mu: multiplicative_function moebius_mu
proof -
  have "multiplicative_function (dirichlet_inverse (\<lambda>n. if n = 0 then 0 else 1 :: 'a) 1)"
    by (rule multiplicative_dirichlet_inverse, standard) simp_all
  also have "dirichlet_inverse (\<lambda>n. if n = 0 then 0 else 1 :: 'a) 1 = moebius_mu"
    by (auto simp: fun_eq_iff moebius_mu_formula)
  finally show "multiplicative_function (moebius_mu :: nat \<Rightarrow> 'a)" .
qed

interpretation moebius_mu:
  multiplicative_function' moebius_mu "\<lambda>p k. if k = 1 then -1 else 0" "\<lambda>_. -1"
proof
  fix p k :: nat assume "prime p" "k > 0"
  moreover from this have "moebius_mu p = -1"
    by (simp add: moebius_mu_def prime_factorization_prime squarefree_prime)
  ultimately show "moebius_mu (p ^ k) = (if k = 1 then - 1 else 0)"
    by (auto simp: moebius_mu_power')
qed auto

lemma moebius_mu_2 [simp]: "moebius_mu 2 = -1"
  and moebius_mu_3 [simp]: "moebius_mu 3 = -1"
  by (rule moebius_mu.prime; simp)+

lemma moebius_mu_code [code]:
  "moebius_mu n = of_int (dirichlet_inverse (\<lambda>_. 1 :: int) 1 n)"
  by (subst moebius_mu_formula_int [symmetric]) simp

lemma fds_moebius_inversion: "f = fds moebius_mu * g \<longleftrightarrow> g = f * fds_zeta"
  by (metis fds_zeta_times_moebius_mu mult.commute mult.left_commute mult.right_neutral)

lemma moebius_inversion:
  assumes "\<And>n. n > 0 \<Longrightarrow> g n = (\<Sum>d | d dvd n. f d)" "n > 0"
  shows   "f n = dirichlet_prod moebius_mu g n"
proof -
  from assms have "fds g = fds f * fds_zeta"
    by (intro fds_eqI) (simp add: fds_nth_mult dirichlet_prod_def)
  thus ?thesis using assms
    by (subst (asm) fds_moebius_inversion [symmetric]) (simp add: fds_eq_iff fds_nth_mult)
qed

lemma fds_mangoldt: "fds mangoldt = fds moebius_mu * fds (\<lambda>n. of_real (ln (real n)))"
  by (subst fds_moebius_inversion) (rule fds_mangoldt_times_zeta [symmetric])

(* 2.18 *)
lemma sum_divisors_moebius_mu_times_multiplicative:
  fixes f :: "nat \<Rightarrow> 'a :: {comm_ring_1}"
  assumes "multiplicative_function f" "n > 0"
  shows   "(\<Sum>d | d dvd n. moebius_mu d * f d) = (\<Prod>p\<in>prime_factors n. 1 - f p)"
proof -
  define g where "g = (\<lambda>n. \<Sum>d | d dvd n. moebius_mu d * f d)"
  define g' where "g' = dirichlet_prod (\<lambda>n. moebius_mu n * f n) (\<lambda>n. if n = 0 then 0 else 1)"
  interpret f: multiplicative_function f by fact
  have "multiplicative_function (\<lambda>n. if n = 0 then 0 else 1 :: 'a)"
    by standard auto
  interpret multiplicative_function g' unfolding g'_def
    by (intro multiplicative_dirichlet_prod multiplicative_function_mult
              moebius_mu.multiplicative_function_axioms assms) fact+

  have g'_primepow: "g' (p ^ k) = 1 - f p" if "prime p" "k > 0" for p k
  proof -
    have "g' (p ^ k) = (\<Sum>i\<le>k. moebius_mu (p ^ i) * f (p ^ i))"
      using that by (simp add: g'_def dirichlet_prod_prime_power)
    also have "\<dots> = (\<Sum>i\<in>{0, 1}. moebius_mu (p ^ i) * f (p ^ i))"
      using that by (intro sum.mono_neutral_right) (auto simp: moebius_mu_power')
    also have "\<dots> = 1 - f p"
      using that by (simp add: moebius_mu.prime)
    finally show ?thesis .
  qed

  have "g' n = g n"
    by (simp add: g_def g'_def dirichlet_prod_def)
  also from assms have "g' n = (\<Prod>p\<in>prime_factors n. g' (p ^ multiplicity p n))"
      by (intro prod_prime_factors) auto
  also have "\<dots> = (\<Prod>p\<in>prime_factors n. 1 - f p)"
    by (intro prod.cong) (auto simp: g'_primepow prime_factors_multiplicity)
  finally show ?thesis by (simp add: g_def)
qed

(* Theorem 2.17 *)
lemma completely_multiplicative_iff_inverse_moebius_mu:
  fixes f :: "nat \<Rightarrow> 'a :: {comm_ring_1, ring_no_zero_divisors}"
  assumes "multiplicative_function f"
  defines "g \<equiv> dirichlet_inverse f 1"
  shows   "completely_multiplicative_function f \<longleftrightarrow>
             (\<forall>n. g n = moebius_mu n * f n)"
proof -
  interpret multiplicative_function f by fact
  show ?thesis
  proof safe
    assume "completely_multiplicative_function f"
    then interpret completely_multiplicative_function f .
    have [simp]: "fds f \<noteq> 0" by (auto simp: fds_eq_iff)

    have "fds (\<lambda>n. moebius_mu n * f n) * fds f = 1"
    proof
      fix n :: nat
      have "fds_nth (fds (\<lambda>n. moebius_mu n * f n) * fds f) n =
              (\<Sum>(r, d) | r * d = n. moebius_mu r * f (r * d))"
        by (simp add: fds_eq_iff fds_nth_mult fds_nth_fds dirichlet_prod_altdef2 mult mult.assoc)
      also have "\<dots> = (\<Sum>(r, d) | r * d = n. moebius_mu r * f n)"
        by (intro sum.cong) auto
      also have "\<dots> = dirichlet_prod moebius_mu (\<lambda>_. 1) n * f n"
        by (simp add: dirichlet_prod_altdef2 sum_distrib_right case_prod_unfold mult)
      also have "dirichlet_prod moebius_mu (\<lambda>_. 1) n = fds_nth (fds moebius_mu * fds_zeta) n"
        by (simp add: fds_nth_mult)
      also have "fds moebius_mu * fds_zeta = 1"
        by (simp add: mult_ac fds_zeta_times_moebius_mu)
      also have "fds_nth 1 n * f n = fds_nth 1 n"
        by (auto simp: fds_eq_iff fds_nth_one)
      finally show "fds_nth (fds (\<lambda>n. moebius_mu n * f n) * fds f) n = fds_nth 1 n" .
    qed
    also have "1 = fds g * fds f"
      by (auto simp: fds_eq_iff g_def fds_nth_mult dirichlet_prod_inverse')
    finally have "fds g = fds (\<lambda>n. moebius_mu n * f n)"
      by (subst (asm) mult_cancel_right) auto
    thus "g n = moebius_mu n * f n" for n
      by (cases "n = 0") (auto simp: fds_eq_iff g_def)
  next
    assume g: "\<forall>n. g n = moebius_mu n * f n"
    show "completely_multiplicative_function f"
    proof (rule completely_multiplicativeI)
      fix p k :: nat assume pk: "prime p" "k > 0"
      show "f (p ^ k) = f p ^ k"
      proof (induction k)
        case (Suc k)
        have eq: "dirichlet_prod g f n = 0" if "n \<noteq> 1" for n
          unfolding g_def using dirichlet_prod_inverse'[of f 1] that by auto
        have "dirichlet_prod g f (p ^ Suc k) = 0"
          using pk by (intro eq) auto
        also have "dirichlet_prod g f (p ^ Suc k) = (\<Sum>i\<le>Suc k. g (p ^ i) * f (p ^ (Suc k - i)))"
          by (intro dirichlet_prod_prime_power) fact+
        also have "\<dots> = (\<Sum>i\<le>Suc k. moebius_mu (p ^ i) * f (p ^ i) * f (p ^ (Suc k - i)))"
          by (intro sum.cong refl, subst g) auto
        also have "\<dots> = (\<Sum>i\<in>{0, 1}. moebius_mu (p ^ i) * f (p ^ i) * f (p ^ (Suc k - i)))"
          using pk by (intro sum.mono_neutral_right) (auto simp: moebius_mu_power')
        also have "\<dots> = f (p ^ Suc k) - f p ^ Suc k"
          using pk Suc.IH by (auto simp: moebius_mu.prime)
        finally show "f (p ^ Suc k) = f p ^ Suc k" by simp
      qed auto
    qed
  qed
qed

lemma completely_multiplicative_fds_inverse:
  fixes f :: "nat \<Rightarrow> 'a :: field"
  assumes "completely_multiplicative_function f"
  shows   "inverse (fds f) = fds (\<lambda>n. moebius_mu n * f n)"
proof -
  interpret completely_multiplicative_function f by fact
  from assms show ?thesis
    by (subst (asm) completely_multiplicative_iff_inverse_moebius_mu)
       (auto simp: inverse_fds_def multiplicative_function_axioms)
qed

lemma completely_multiplicative_fds_inverse':
  fixes f :: "'a :: field fds"
  assumes "completely_multiplicative_function (fds_nth f)"
  shows   "inverse f = fds (\<lambda>n. moebius_mu n * fds_nth f n)"
  by (metis assms completely_multiplicative_fds_inverse fds_fds_nth)

context
  includes fds_syntax
begin

lemma selberg_aux:
  "(\<chi> n. of_real ((ln n)\<^sup>2)) * fds moebius_mu =
     (fds mangoldt)\<^sup>2 - fds_deriv (fds mangoldt :: 'a :: {comm_ring_1,real_algebra_1} fds)"
proof -
  have "(\<chi> n. of_real (ln (real n) ^ 2)) = fds_deriv (fds_deriv fds_zeta :: 'a fds)"
    by (rule fds_eqI) (simp add: fds_nth_fds fds_nth_deriv power2_eq_square scaleR_conv_of_real)
  also have "\<dots> = (fds mangoldt ^ 2 - fds_deriv (fds mangoldt)) * fds_zeta"
    by (simp add: fds_deriv_zeta algebra_simps power2_eq_square)
  also have "\<dots> * fds moebius_mu = ((fds mangoldt)\<^sup>2 - fds_deriv (fds mangoldt)) *
                                      (fds_zeta * fds moebius_mu)" by (simp add: mult_ac)
  also have "fds_zeta * fds moebius_mu = (1 :: 'a fds)" by (fact fds_zeta_times_moebius_mu)
  finally show ?thesis by simp
qed

lemma selberg_aux':
  "mangoldt n * of_real (ln n) + (mangoldt \<star> mangoldt) n =
     ((moebius_mu \<star> (\<lambda>b. of_real (ln b) ^ 2)) n
         :: 'a :: {comm_ring_1,real_algebra_1})" if "n > 0"
  using selberg_aux [symmetric] that
  by (auto simp add: fds_eq_iff fds_nth_mult power2_eq_square fds_nth_deriv
        dirichlet_prod_commutes algebra_simps scaleR_conv_of_real)

end

end


(*  Title:      HOL/Examples/Ackermann.thy
    Author:     Larry Paulson
*)

section \<open>A Tail-Recursive, Stack-Based Ackermann's Function\<close>

theory Ackermann imports "HOL-Library.Multiset_Order" "HOL-Library.Product_Lexorder"

begin

text\<open>This theory investigates a stack-based implementation of Ackermann's function.
Let's recall the traditional definition,
as modified by R{\'o}zsa P\'eter and Raphael Robinson.\<close>

fun ack :: "[nat,nat] \<Rightarrow> nat" where
  "ack 0 n             = Suc n"
| "ack (Suc m) 0       = ack m 1"
| "ack (Suc m) (Suc n) = ack m (ack (Suc m) n)"

subsection \<open>Example of proving termination by reasoning about the domain\<close>

text\<open>The stack-based version uses lists.\<close>

function (domintros) ackloop :: "nat list \<Rightarrow> nat" where
  "ackloop (n # 0 # l)         = ackloop (Suc n # l)"
| "ackloop (0 # Suc m # l)     = ackloop (1 # m # l)"
| "ackloop (Suc n # Suc m # l) = ackloop (n # Suc m # m # l)"
| "ackloop [m] = m"
| "ackloop [] =  0"
  by pat_completeness auto

text\<open>
The key task is to prove termination. In the first recursive call, the head of the list gets bigger
while the list gets shorter, suggesting that the length of the list should be the primary
termination criterion. But in the third recursive call, the list gets longer. The idea of trying
a multiset-based termination argument is frustrated by the second recursive call when m = 0:
the list elements are simply permuted.

Fortunately, the function definition package allows us to define a function and only later identify its domain of termination.
Instead, it makes all the recursion equations conditional on satisfying
the function's domain predicate. Here we shall eventually be able
to show that the predicate is always satisfied.\<close>

text\<open>@{thm [display] ackloop.domintros[no_vars]}\<close>
declare ackloop.domintros [simp]

text \<open>Termination is trivial if the length of the list is less then two.
The following lemma is the key to proving termination for longer lists.\<close>
lemma "ackloop_dom (ack m n # l) \<Longrightarrow> ackloop_dom (n # m # l)"
proof (induction m arbitrary: n l)
  case 0
  then show ?case
    by auto
next
  case (Suc m)
  show ?case
    using Suc.prems
    by (induction n arbitrary: l) (simp_all add: Suc)
qed

text \<open>The proof above (which actually is unused) can be expressed concisely as follows.\<close>
lemma ackloop_dom_longer:
  "ackloop_dom (ack m n # l) \<Longrightarrow> ackloop_dom (n # m # l)"
  by (induction m n arbitrary: l rule: ack.induct) auto

text\<open>This function codifies what @{term ackloop} is designed to do.
Proving the two functions equivalent also shows that @{term ackloop} can be used
to compute Ackermann's function.\<close>
fun acklist :: "nat list \<Rightarrow> nat" where
  "acklist (n#m#l) = acklist (ack m n # l)"
| "acklist [m] = m"
| "acklist [] =  0"

text\<open>The induction rule for @{term acklist} is @{thm [display] acklist.induct[no_vars]}.\<close>

lemma ackloop_dom: "ackloop_dom l"
  by (induction l rule: acklist.induct) (auto simp: ackloop_dom_longer)

termination ackloop
  by (simp add: ackloop_dom)

text\<open>This result is trivial even by inspection of the function definitions
(which faithfully follow the definition of Ackermann's function).
All that we needed was termination.\<close>
lemma ackloop_acklist: "ackloop l = acklist l"
  by (induction l rule: ackloop.induct) auto

theorem ack: "ack m n = ackloop [n,m]"
  by (simp add: ackloop_acklist)

subsection \<open>Example of proving termination using a multiset ordering\<close>

text \<open>This termination proof uses the argument from
Nachum Dershowitz and Zohar Manna. Proving termination with multiset orderings.
Communications of the ACM 22 (8) 1979, 465--476.\<close>

text\<open>Setting up the termination proof. Note that Dershowitz had @{term z} as a global variable.
The top two stack elements are treated differently from the rest.\<close>

fun ack_mset :: "nat list \<Rightarrow> (nat\<times>nat) multiset" where
  "ack_mset [] = {#}"
| "ack_mset [x] = {#}"
| "ack_mset (z#y#l) = mset ((y,z) # map (\<lambda>x. (Suc x, 0)) l)"

lemma case1: "ack_mset (Suc n # l) < add_mset (0,n) {# (Suc x, 0). x \<in># mset l #}"
proof (cases l)
  case (Cons m list)
  have "{#(m, Suc n)#} < {#(Suc m, 0)#}"
    by auto
  also have "\<dots> \<le> {#(Suc m, 0), (0,n)#}"
    by auto
  finally show ?thesis
    by (simp add: Cons)
qed auto

text\<open>The stack-based version again. We need a fresh copy because
  we've already proved the termination of @{term ackloop}.\<close>

function Ackloop :: "nat list \<Rightarrow> nat" where
  "Ackloop (n # 0 # l)         = Ackloop (Suc n # l)"
| "Ackloop (0 # Suc m # l)     = Ackloop (1 # m # l)"
| "Ackloop (Suc n # Suc m # l) = Ackloop (n # Suc m # m # l)"
| "Ackloop [m] = m"
| "Ackloop [] =  0"
  by pat_completeness auto

text \<open>In each recursive call, the function @{term ack_mset} decreases according to the multiset
ordering.\<close>
termination
  by (relation "inv_image {(x,y). x<y} ack_mset") (auto simp: wf case1)

text \<open>Another shortcut compared with before: equivalence follows directly from this lemma.\<close>
lemma Ackloop_ack: "Ackloop (n # m # l) = Ackloop (ack m n # l)"
  by (induction m n arbitrary: l rule: ack.induct) auto

theorem "ack m n = Ackloop [n,m]"
  by (simp add: Ackloop_ack)

end


section "Weak Integer Compositions"

theory Weak_Integer_Compositions
  imports
    "HOL-Combinatorics.Multiset_Permutations"
    Common_Lemmas
begin

subsection"Definition"

definition weak_integer_compositions :: "nat \<Rightarrow> nat \<Rightarrow> nat list set" where
  "weak_integer_compositions i l = {xs. length xs = l \<and> sum_list xs = i}"
text "Weak integer compositions are similar to integer compositions, with the trade-off that 0 is
  allowed but the composition must have a fixed length."
text "Cardinality: \<open>binomial (i + n - 1) i\<close>"
text "Example: \<open>weak_integer_compositions 2 2 = {[2,0], [1,1], [0,2]}\<close>"

subsection"Algorithm"

fun weak_integer_composition_enum :: "nat \<Rightarrow> nat \<Rightarrow> nat list list" where
  "weak_integer_composition_enum i 0 = (if i = 0 then [[]] else [])"
| "weak_integer_composition_enum i (Suc 0) = [[i]]"
| "weak_integer_composition_enum i l =
  [h#r . h \<leftarrow> [0..< Suc i], r \<leftarrow> weak_integer_composition_enum (i-h) (l-1)]"

subsection"Verification"

subsubsection"Correctness"

lemma weak_integer_composition_enum_length:
  "xs \<in> set (weak_integer_composition_enum i l) \<Longrightarrow> length xs = l"
proof(induct l arbitrary: xs i)
  case 0
  then show ?case by simp
next
  case (Suc l)
  then show ?case by(cases l) auto
qed

lemma weak_integer_composition_enum_sum_list:
  "xs \<in> set (weak_integer_composition_enum i l) \<Longrightarrow> sum_list xs = i"
proof(induct l arbitrary: xs i)
  case 0
  then show ?case by simp
next
  case (Suc l)
  then show ?case by(cases l) auto
qed

lemma weak_integer_composition_enum_head:
  assumes "xs \<in> set (weak_integer_composition_enum (sum_list xs) (length xs))"
  shows "x # xs \<in> set (weak_integer_composition_enum (x + sum_list xs) (Suc (length xs)))"
proof(cases "length xs")
  case 0
  then show ?thesis by simp
next
  case (Suc y)

  (*maybe this should be proven elsewhere*)
  have 1: "\<lbrakk>n \<in> set xs; 0 < n\<rbrakk> \<Longrightarrow> 0 < sum_list xs" for n
    using sum_list_eq_0_iff by fast

  have 2: "xs \<notin> set (weak_integer_composition_enum 0 (Suc y)) \<Longrightarrow> 0 < sum_list xs"
    using Suc assms not_gr0 by fastforce

  have "x # xs \<notin> (#) (x + sum_list xs) ` set (weak_integer_composition_enum 0 (Suc y))
    \<Longrightarrow> \<exists>xa\<in>{0..<x + sum_list xs}. x # xs \<in> (#) xa ` set (weak_integer_composition_enum (x + sum_list xs - xa) (Suc y))"
   unfolding image_def using Suc assms 1 2 by auto

  from Suc this show ?thesis
    by auto
qed

lemma weak_integer_composition_enum_correct_aux:
  "xs \<in> set (weak_integer_composition_enum (sum_list xs) (length xs))"
  by (induct xs) (auto simp: weak_integer_composition_enum_head)

theorem weak_integer_composition_enum_correct:
  "set (weak_integer_composition_enum i l) = weak_integer_compositions i l"
proof standard
  show "set (weak_integer_composition_enum i l) \<subseteq> weak_integer_compositions i l"
    unfolding weak_integer_compositions_def
    using weak_integer_composition_enum_length weak_integer_composition_enum_sum_list
    by auto
next
  show "weak_integer_compositions i l \<subseteq> set (weak_integer_composition_enum i l)"
    unfolding weak_integer_compositions_def
    using weak_integer_composition_enum_correct_aux by auto
qed

subsubsection"Distinctness"

theorem weak_integer_composition_enum_distinct: "distinct (weak_integer_composition_enum i l)"
proof(induct rule: weak_integer_composition_enum.induct)
  case (1 i)
  then show ?case
    by simp
next
  case (2 i)
  then show ?case
    by simp
next
  case (3 i l)
  have "distinct [h#r . h \<leftarrow> [0..< Suc i], r \<leftarrow> weak_integer_composition_enum (i-h) (Suc l)]"
    apply(subst Cons_distinct_concat_map_function)
    using 3 by auto
  then show ?case by simp
qed

subsubsection"Cardinality"

text \<open>The following is a generalization of the binomial coefficient to multisets. Sometimes it
is called multiset coefficient. Here we call it "multichoose" \cite{stanleyenumerative}.\<close>

definition multichoose:: "nat \<Rightarrow> nat \<Rightarrow> nat" (infixl "multichoose" 65) where
  "n multichoose k = (n + k -1) choose k"

lemma weak_integer_composition_enum_zero: "length (weak_integer_composition_enum 0 (Suc n)) = 1"
  by(induct n) auto

lemma a_choose_equivalence: "Suc (\<Sum>x\<leftarrow>[0..<k]. n + (k - x) choose (k - x)) = Suc (n + k) choose k"
proof -
  have "m \<ge> k \<Longrightarrow> (\<Sum>x\<leftarrow>[0..< Suc k]. m - x choose (k - x)) = Suc m choose k" for m
    using sum_choose_diagonal leq_sum_to_sum_list by metis
  then have 1: "Suc (\<Sum>x\<leftarrow>[0..<k]. (n + k) - x choose (k - x)) = Suc (n + k) choose k"
    by simp

  have "Suc (\<Sum>x\<leftarrow>[0..<k]. (n + k) - x choose (k - x)) = Suc (\<Sum>x\<leftarrow>[0..<k]. n + (k - x) choose (k - x))"
    by (metis (no_types, opaque_lifting) Nat.diff_add_assoc2 add.commute binomial_n_0 diff_is_0_eq' nle_le)

  then show ?thesis using 1 by simp
qed

lemma composition_enum_length: "length (weak_integer_composition_enum i n) = n multichoose i"
  unfolding multichoose_def
proof(induct i n rule: weak_integer_composition_enum.induct)
  case (1 i)
  then show ?case by simp
next
  case (2 i)
  then show ?case by simp
next
  case (3 i n)

  then have "x \<in> set [0..< i] \<Longrightarrow>
    length (weak_integer_composition_enum (i - x) (Suc n)) = n + (i - x) choose (i - x)" for x
    by simp

  then have ev: "length [h#r . h \<leftarrow> [0..< i], r \<leftarrow> weak_integer_composition_enum (i-h) (Suc n)] =
     (\<Sum>x\<leftarrow>[0..< i]. n + (i - x) choose (i - x))"
    using length_concat_map_function_sum_list [of
      "[0..< i]"
      "\<lambda>x. (weak_integer_composition_enum (i-x) (Suc n))"
      "\<lambda>x. n + (i-x) choose (i-x)"
      "\<lambda>h r. h#r"
      ] by simp

  have "Suc (\<Sum>x\<leftarrow>[0..<i]. n + (i - x) choose (i - x)) = Suc (n + i) choose i"
    using a_choose_equivalence by simp

  then show ?case using weak_integer_composition_enum_zero ev by auto
qed

theorem weak_integer_compositions_cardinality: "card (weak_integer_compositions n k) = k multichoose n"
  using weak_integer_composition_enum_correct weak_integer_composition_enum_distinct composition_enum_length
  distinct_card by metis

end


theory Simp_Demo
imports Main
begin

section "How to simplify"

text \<open>No assumption:\<close>

lemma "ys @ [] = []"
apply(simp)
oops (* abandon proof *)

text \<open>Simplification in assumption:\<close>

lemma "\<lbrakk> xs @ zs = ys @ xs; [] @ xs = [] @ [] \<rbrakk> \<Longrightarrow> ys = zs"
apply(simp)
done

text \<open>Using additional rules:\<close>

lemma "(a+b)*(a-b) = a*a - b*(b::int)"
apply(simp add: algebra_simps)
done

text \<open>Giving a lemma the simp-attribute:\<close>

declare algebra_simps [simp]

subsection "Rewriting with definitions"

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

lemma "sq(n*n) = sq(n)*sq(n)"
apply(simp add: sq_def) (* Definition of function is implicitly called f_def *)
done

subsection "Case distinctions"

text \<open>Automatic:\<close>

lemma "(A & B) = (if A then B else False)"
apply(simp)
done

lemma "if A then B else C"
apply(simp)
oops

text \<open>By hand (for case):\<close>

lemma "1 \<le> (case ns of [] \<Rightarrow> 1 | n#_ \<Rightarrow> Suc n)"
apply(simp split: list.split)
done

subsection "Arithmetic"

text \<open>A bit of linear arithmetic (no multiplication) is automatic:\<close>

lemma "\<lbrakk> (x::nat) \<le> y+z;  z+x < y \<rbrakk> \<Longrightarrow> x < y"
apply(simp)
done

subsection "Tracing"

lemma "rev[x] = []"
using [[simp_trace]] apply(simp)
oops

text \<open>Method ``auto'' can be modified almost like ``simp'':
 instead of ``add'' use ``simp add''.\<close>

end


(*
  File:    IMO2019_Q1.thy
  Author:  Manuel Eberl, TU München
*)
section \<open>Q1\<close>
theory IMO2019_Q1
  imports Main
begin

text \<open>
  Consider a function \<open>f : \<int> \<rightarrow> \<int>\<close> that fulfils the functional equation
  \<open>f(2a) + 2f(b) = f(f(a+b))\<close> for all \<open>a, b \<in> \<int>\<close>.

  Then \<open>f\<close> is either identically 0 or of the form \<open>f(x) = 2x + c\<close> for some constant \<open>c \<in> \<int>\<close>.
\<close>

context
  fixes f :: "int \<Rightarrow> int" and m :: int
  assumes f_eq: "f (2 * a) + 2 * f b = f (f (a + b))"
  defines "m \<equiv> (f 0 - f (-2)) div 2"
begin

text \<open>
  We first show that \<open>f\<close> is affine with slope \<open>(f(0) - f(-2)) / 2\<close>.
  This follows from plugging in \<open>(0, b)\<close> and \<open>(-1, b + 1)\<close> into the functional equation.
\<close>
lemma f_eq': "f x = m * x + f 0"
proof -
  have rec: "f (b + 1) = f b + m" for b
    using f_eq[of 0 b] f_eq[of "-1" "b + 1"] by (simp add: m_def)
  moreover have "f (b - 1) = f b - m" for b
    using rec[of "b - 1"] by simp
  ultimately show ?thesis
    by (induction x rule: int_induct[of _ 0]) (auto simp: algebra_simps)
qed

text \<open>
  This version is better for the simplifier because it prevents it from looping.
\<close>
lemma f_eq'_aux [simp]: "NO_MATCH 0 x \<Longrightarrow> f x = m * x + f 0"
  by (rule f_eq')

text \<open>
  Plugging in \<open>(0, 0)\<close> and \<open>(0, 1)\<close>.
\<close>
lemma f_classification: "(\<forall>x. f x = 0) \<or> (\<forall>x. f x = 2 * x + f 0)"
  using f_eq[of 0 0] f_eq[of 0 1] by auto

end

text \<open>
  It is now easy to derive the full characterisation of the functions we considered:
\<close>
theorem
  fixes f :: "int \<Rightarrow> int"
  shows "(\<forall>a b. f (2 * a) + 2 * f b = f (f (a + b))) \<longleftrightarrow>
           (\<forall>x. f x = 0) \<or> (\<forall>x. f x = 2 * x + f 0)" (is "?lhs \<longleftrightarrow> ?rhs")
proof
  assume ?lhs
  thus ?rhs using f_classification[of f] by blast
next
  assume ?rhs
  thus ?lhs by smt
qed

end


theory reverse_even
imports Main
begin
datatype nat = zero | s nat
datatype lst = nil | cons nat lst

fun snoc :: "lst \<Rightarrow> nat \<Rightarrow> lst" where
"snoc nil x = cons x nil" |
"snoc (cons x xs) y = cons x (snoc xs y)"

fun reverse :: "lst \<Rightarrow> lst" where
"reverse nil = nil" |
"reverse (cons x xs) = snoc (reverse xs) x"

fun reverse_n :: "nat \<Rightarrow> lst \<Rightarrow> lst" where
"reverse_n zero xs = xs" |
"reverse_n (s n) xs = reverse (reverse_n n xs)"

fun even_fn :: "nat \<Rightarrow> bool" where
"even_fn zero = True" |
"even_fn (s zero) = False" |
"even_fn (s (s n)) = even_fn n"

inductive even :: "nat \<Rightarrow> bool" where
"even zero" |
"even n \<Longrightarrow> even (s (s n))"

lemma reverse_snoc: "\<And>xs. \<And>x. reverse (snoc xs x) = cons x (reverse xs)"
proof -
fix xs
show "\<And>x. reverse (snoc xs x) = cons x (reverse xs)"
proof(induct xs)
case nil
then show ?case by simp
next
case (cons x1 xs)
then show ?case by simp
qed
qed

lemma reverse_involution: "\<And>xs. reverse (reverse xs) = xs" proof -
fix xs
show "reverse (reverse xs) = xs" proof(induct xs)
case nil
then show ?case by simp
next
case (cons x1 xs)
then show ?case by (simp add: reverse_snoc)
qed
qed

theorem "\<And>n xs. (even n \<Longrightarrow> reverse_n n xs = xs)" proof (rule even.induct)
show "\<And>n xs. reverse_even.even n \<Longrightarrow> reverse_even.even n" by simp
next
show "\<And>n xs. reverse_even.even n \<Longrightarrow> reverse_n zero xs = xs" by simp
next
show
"\<And>n xs na.
reverse_even.even n
\<Longrightarrow> reverse_even.even na
\<Longrightarrow> reverse_n na xs = xs
\<Longrightarrow> reverse_n (s (s na)) xs = xs" by (simp add: reverse_involution)
qed

theorem "\<And>n xs. (even_fn n \<longrightarrow> reverse_n n xs = xs)" proof (rule even_fn.induct)
show "\<And>n xs. even_fn n \<longrightarrow> reverse_n zero xs = xs" by simp
next
show "\<And>n xs. even_fn (s zero) \<longrightarrow> reverse_n (s zero) xs = xs" by simp
next
show
"\<And>n xs na. even_fn na
\<longrightarrow> reverse_n na xs = xs
\<Longrightarrow> even_fn (s (s na))
\<longrightarrow> reverse_n (s (s na)) xs = xs" by (simp add: reverse_involution)
qed

end


theory Ex1_2
imports Main
begin

primrec replace :: "'a \<Rightarrow> 'a \<Rightarrow> 'a list \<Rightarrow> 'a list" where
"replace _  _ [] = []"|
"replace x  y (z # zs) = (if z = y then x else z) # replace x y zs"

theorem helper : "replace x y (ls @ xs) = replace x y ls @ replace x y xs"
proof (induct ls)
  case Nil
  show ?case by simp
 next
  fix a ls
  assume "replace x y (ls @ xs) = replace x y ls @ replace x y xs"
  thus "replace x y ((a # ls) @ xs) = replace x y (a # ls) @ replace x y xs " by simp
qed

theorem "rev(replace x y zs) = replace x y (rev zs)"
proof (induct zs)
  case Nil
  show ?case by simp
 next
  fix a zs
  assume "rev (replace x y zs) = replace x y (rev zs)"
  thus " rev (replace x y (a # zs)) = replace x y (rev (a # zs)) " by (simp add : helper)
qed