section \<open>Pratt's Primality Certificates\<close>
text_raw \<open>\label{sec:pratt}\<close>
theory Pratt_Certificate
imports
  Complex_Main
  Lehmer.Lehmer
begin

text \<open>
  This work formalizes Pratt's proof system as described in his article
  ``Every Prime has a Succinct Certificate''\cite{pratt1975certificate}.

  The proof system makes use of two types of predicates:
  \begin{itemize}
    \item $\text{Prime}(p)$: $p$ is a prime number
    \item $(p, a, x)$: \<open>\<forall>q \<in> prime_factors(x). [a^((p - 1) div q) \<noteq> 1] (mod p)\<close>
  \end{itemize}
  We represent these predicates with the following datatype:
\<close>

datatype pratt = Prime nat | Triple nat nat nat

text \<open>
  Pratt describes an inference system consisting of the axiom $(p, a, 1)$
  and the following inference rules:
  \begin{itemize}
  \item R1: If we know that $(p, a, x)$ and \<open>[a^((p - 1) div q) \<noteq> 1] (mod p)\<close> hold for some
              prime number $q$ we can conclude $(p, a, qx)$ from that.
  \item R2: If we know that $(p, a, p - 1)$ and  \<open>[a^(p - 1) = 1] (mod p)\<close> hold, we can
              infer $\text{Prime}(p)$.
  \end{itemize}
  Both rules follow from Lehmer's theorem as we will show later on.

  A list of predicates (i.e., values of type @{type pratt}) is a \emph{certificate}, if it is
  built according to the inference system described above. I.e., a list @{term "x # xs :: pratt list"}
  is a certificate if @{term "xs :: pratt list"} is a certificate and @{term "x :: pratt"} is
  either an axiom or all preconditions of @{term "x :: pratt"} occur in @{term "xs :: pratt list"}.

  We call a certificate @{term "xs :: pratt list"} a \emph{certificate for @{term p}},
  if @{term "Prime p"} occurs in @{term "xs :: pratt list"}.

  The function \<open>valid_cert\<close> checks whether a list is a certificate.
\<close>

fun valid_cert :: "pratt list \<Rightarrow> bool" where
  "valid_cert [] = True"
| R2: "valid_cert (Prime p#xs) \<longleftrightarrow> 1 < p \<and> valid_cert xs
    \<and> (\<exists> a . [a^(p - 1) = 1] (mod p) \<and> Triple p a (p - 1) \<in> set xs)"
| R1: "valid_cert (Triple p a x # xs) \<longleftrightarrow> p > 1 \<and> 0 < x  \<and> valid_cert xs \<and> (x=1 \<or>
    (\<exists>q y. x = q * y \<and> Prime q \<in> set xs \<and> Triple p a y \<in> set xs
      \<and> [a^((p - 1) div q) \<noteq> 1] (mod p)))"

text \<open>
  We define a function @{term size_cert} to measure the size of a certificate, assuming
  a binary encoding of numbers. We will use this to show that there is a certificate for a
  prime number $p$ such that the size of the certificate is polynomially bounded in the size
  of the binary representation of $p$.
\<close>
fun size_pratt :: "pratt \<Rightarrow> real" where
  "size_pratt (Prime p) = log 2 p" |
  "size_pratt (Triple p a x) = log 2 p + log 2 a + log 2 x"

fun size_cert :: "pratt list \<Rightarrow> real" where
  "size_cert [] = 0" |
  "size_cert (x # xs) = 1 + size_pratt x + size_cert xs"

subsection \<open>Soundness\<close>

text \<open>
  In Section \ref{sec:pratt} we introduced the predicates $\text{Prime}(p)$ and $(p, a, x)$.
  In this section we show that for a certificate every predicate occurring in this certificate
  holds. In particular, if $\text{Prime}(p)$ occurs in a certificate, $p$ is prime.
\<close>

lemma prime_factors_one [simp]: shows "prime_factors (Suc 0) = {}"
  using prime_factorization_1 [where ?'a = nat] by simp

lemma prime_factors_of_prime: fixes p :: nat assumes "prime p" shows "prime_factors p = {p}"
  using assms by (fact prime_prime_factors)

definition pratt_triple :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> bool" where
  "pratt_triple p a x \<longleftrightarrow> x > 0 \<and> (\<forall>q\<in>prime_factors x. [a ^ ((p - 1) div q) \<noteq> 1] (mod p))"

lemma pratt_triple_1: "p > 1 \<Longrightarrow> x = 1 \<Longrightarrow> pratt_triple p a x"
  by (auto simp: pratt_triple_def)

lemma pratt_triple_extend:
  assumes "prime q" "pratt_triple p a y"
          "p > 1" "x > 0" "x = q * y" "[a ^ ((p - 1) div q) \<noteq> 1] (mod p)"
  shows   "pratt_triple p a x"
proof -
  have "prime_factors x = insert q (prime_factors y)"
    using assms by (simp add: prime_factors_product prime_prime_factors)
  also have "\<forall>r\<in>\<dots>. [a ^ ((p - 1) div r) \<noteq> 1] (mod p)"
    using assms by (auto simp: pratt_triple_def)
  finally show ?thesis using assms
    unfolding pratt_triple_def by blast
qed

lemma pratt_triple_imp_prime:
  assumes "pratt_triple p a x" "p > 1" "x = p - 1" "[a ^ (p - 1) = 1] (mod p)"
  shows   "prime p"
  using lehmers_theorem[of p a] assms by (auto simp: pratt_triple_def)

theorem pratt_sound:
  assumes 1: "valid_cert c"
  assumes 2: "t \<in> set c"
  shows "(t = Prime p \<longrightarrow> prime p) \<and>
         (t = Triple p a x \<longrightarrow> ((\<forall>q \<in> prime_factors x . [a^((p - 1) div q) \<noteq> 1] (mod p)) \<and> 0<x))"
using assms
proof (induction c arbitrary: p a x t)
  case Nil then show ?case by force
  next
  case (Cons y ys)
  { assume "y=Triple p a x" "x=1"
    then have "(\<forall> q \<in> prime_factors x . [a^((p - 1) div q) \<noteq> 1] (mod p)) \<and> 0<x" by simp
    }
  moreover
  { assume x_y: "y=Triple p a x" "x~=1"
    hence "x>0" using Cons.prems by auto
    obtain q z where "x=q*z" "Prime q \<in> set ys \<and> Triple p a z \<in> set ys"
               and cong:"[a^((p - 1) div q) \<noteq> 1] (mod p)" using Cons.prems x_y by auto
    then have factors_IH:"(\<forall> r \<in> prime_factors z . [a^((p - 1) div r) \<noteq> 1] (mod p))" "prime q" "z>0"
      using Cons.IH Cons.prems \<open>x>0\<close> \<open>y=Triple p a x\<close>
      by force+
    then have "prime_factors x = prime_factors z \<union> {q}"  using \<open>x =q*z\<close> \<open>x>0\<close>
      by (simp add: prime_factors_product prime_factors_of_prime)
    then have "(\<forall> q \<in> prime_factors x . [a^((p - 1) div q) \<noteq> 1] (mod p)) \<and> 0 < x"
      using factors_IH cong by (simp add: \<open>x>0\<close>)
    }
  ultimately have y_Triple:"y=Triple p a x \<Longrightarrow> (\<forall> q \<in> prime_factors x .
                                                [a^((p - 1) div q) \<noteq> 1] (mod p)) \<and> 0<x" by linarith
  { assume y: "y=Prime p" "p>2" then
    obtain a where a:"[a^(p - 1) = 1] (mod p)" "Triple p a (p - 1) \<in> set ys"
      using Cons.prems by auto
    then have Bier:"(\<forall>q\<in>prime_factors (p - 1). [a^((p - 1) div q) \<noteq> 1] (mod p))"
      using Cons.IH Cons.prems(1) by (simp add:y(1))
    then have "prime p" using lehmers_theorem[OF _ _a(1)] \<open>p>2\<close> by fastforce
    }
  moreover
  { assume "y=Prime p" "p=2" hence "prime p" by simp }
  moreover
  { assume "y=Prime p" then have "p>1"  using Cons.prems  by simp }
  ultimately have y_Prime:"y = Prime p \<Longrightarrow> prime p" by linarith

  show ?case
  proof (cases "t \<in> set ys")
    case True
      show ?thesis using Cons.IH[OF _ True] Cons.prems(1) by (cases y) auto
    next
    case False
      thus ?thesis using Cons.prems(2) y_Prime y_Triple by force
  qed
qed

corollary pratt_primeI:
  assumes "valid_cert xs" "Prime p \<in> set xs"
  shows   "prime p"
  using pratt_sound[OF assms] by simp

subsection \<open>Completeness\<close>

text \<open>
  In this section we show completeness of Pratt's proof system, i.e., we show that for
  every prime number $p$ there exists a certificate for $p$. We also give an upper
  bound for the size of a minimal certificate

  The prove we give is constructive. We assume that we have certificates for all prime
  factors of $p - 1$ and use these to build a certificate for $p$ from that. It is
  important to note that certificates can be concatenated.
\<close>

lemma valid_cert_appendI:
  assumes "valid_cert r"
  assumes "valid_cert s"
  shows "valid_cert (r @ s)"
  using assms
proof (induction r)
  case (Cons y ys) then show ?case by (cases y) auto
qed simp

lemma valid_cert_concatI: "(\<forall>x \<in> set xs . valid_cert x) \<Longrightarrow> valid_cert (concat xs)"
  by (induction xs) (auto simp add: valid_cert_appendI)

lemma size_pratt_le:
 fixes d::real
 assumes "\<forall> x \<in> set c. size_pratt x \<le> d"
 shows "size_cert c \<le> length c * (1 + d)" using assms
 by (induction c) (simp_all add: algebra_simps)

fun build_fpc :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat list \<Rightarrow> pratt list" where
  "build_fpc p a r [] = [Triple p a r]" |
  "build_fpc p a r (y # ys) = Triple p a r # build_fpc p a (r div y) ys"

text \<open>
  The function @{term build_fpc} helps us to construct a certificate for $p$ from
  the certificates for the prime factors of $p - 1$. Called as
  @{term "build_fpc p a (p - 1) qs"} where $@{term "qs"} = q_1 \ldots q_n$
  is prime decomposition of $p - 1$ such that $q_1 \cdot \dotsb \cdot q_n = @{term "p - 1 :: nat"}$,
  it returns the following list of predicates:
  \[
  (p,a,p-1), (p,a,\frac{p - 1}{q_1}), (p,a,\frac{p - 1}{q_1 q_2}), \ldots, (p,a,\frac{p-1}{q_1 \ldots q_n}) = (p,a,1)
  \]

  I.e., if there is an appropriate $a$ and and a certificate @{term rs} for all
  prime factors of $p$, then we can construct a certificate for $p$ as
  @{term [display] "Prime p # build_fpc p a (p - 1) qs @ rs"}
\<close>

text \<open>
  The following lemma shows that \<open>build_fpc\<close> extends a certificate that
  satisfies the preconditions described before to a correct certificate.
\<close>

lemma correct_fpc:
  assumes "valid_cert xs" "p > 1"
  assumes "prod_list qs = r" "r \<noteq> 0"
  assumes "\<forall> q \<in> set qs . Prime q \<in> set xs"
  assumes "\<forall> q \<in> set qs . [a^((p - 1) div q) \<noteq> 1] (mod p)"
  shows "valid_cert (build_fpc p a r qs @ xs)"
  using assms
proof (induction qs arbitrary: r)
  case Nil thus ?case by auto
next
  case (Cons y ys)
  have "prod_list ys = r div y" using Cons.prems by auto
  then have T_in: "Triple p a (prod_list ys) \<in> set (build_fpc p a (r div y) ys @ xs)"
    by (cases ys) auto

  have "valid_cert (build_fpc p a (r div y) ys @ xs)"
    using Cons.prems by (intro Cons.IH) auto
  then have "valid_cert (Triple p a r # build_fpc p a (r div y) ys @ xs)"
    using \<open>r \<noteq> 0\<close> T_in Cons.prems by auto
  then show ?case by simp
qed

lemma length_fpc:
  "length (build_fpc p a r qs) = length qs + 1" by (induction qs arbitrary: r) auto

lemma div_gt_0:
  fixes m n :: nat assumes "m \<le> n" "0 < m" shows "0 < n div m"
proof -
  have "0 < m div m" using \<open>0 < m\<close> div_self by auto
  also have "m div m \<le> n div m" using \<open>m \<le> n\<close> by (rule div_le_mono)
  finally show ?thesis .
qed

lemma size_pratt_fpc:
  assumes "a \<le> p" "r \<le> p" "0 < a" "0 < r" "0 < p" "prod_list qs = r"
  shows "\<forall>x \<in> set (build_fpc p a r qs) . size_pratt x \<le> 3 * log 2 p" using assms
proof (induction qs arbitrary: r)
  case Nil
  then have "log 2 a \<le> log 2 p" "log 2 r \<le> log 2 p" by auto
  then show ?case by simp
next
  case (Cons q qs)
  then have "log 2 a \<le> log 2 p" "log 2 r \<le> log 2 p" by auto
  then have  "log 2 a + log 2 r \<le> 2 * log 2 p" by arith
  moreover have "r div q > 0" using Cons.prems by (fastforce intro: div_gt_0)
  moreover hence "prod_list qs = r div q" using Cons.prems(6) by auto
  moreover have "r div q \<le> p" using \<open>r\<le>p\<close> div_le_dividend[of r q] by linarith
  ultimately show ?case using Cons by simp
qed

lemma concat_set:
  assumes "\<forall> q \<in> qs . \<exists> c \<in> set cs . Prime q \<in> set c"
  shows "\<forall> q \<in> qs . Prime q \<in> set (concat cs)"
  using assms by (induction cs) auto

lemma p_in_prime_factorsE:
  fixes n :: nat
  assumes "p \<in> prime_factors n" "0 < n"
  obtains "2 \<le> p" "p \<le> n" "p dvd n" "prime p"
proof
  from assms show "prime p" by auto
  then show "2 \<le> p" by (auto dest: prime_gt_1_nat)

  from assms show "p dvd n" by auto
  then show "p \<le> n" using  \<open>0 < n\<close> by (rule dvd_imp_le)
qed

lemma prime_factors_list_prime:
  fixes n :: nat
  assumes "prime n"
  shows "\<exists> qs. prime_factors n = set qs \<and> prod_list qs = n \<and> length qs = 1"
  using assms by (auto simp add: prime_factorization_prime intro: exI [of _ "[n]"])

lemma prime_factors_list:
  fixes n :: nat assumes "3 < n" "\<not> prime n"
  shows "\<exists> qs. prime_factors n = set qs \<and> prod_list qs = n \<and> length qs \<ge> 2"
  using assms
proof (induction n rule: less_induct)
  case (less n)
    obtain p where "p \<in> prime_factors n" using \<open>n > 3\<close> prime_factors_elem by force
    then have p':"2 \<le> p" "p \<le> n" "p dvd n" "prime p"
      using \<open>3 < n\<close> by (auto elim: p_in_prime_factorsE)
    { assume "n div p > 3" "\<not> prime (n div p)"
      then obtain qs
        where "prime_factors (n div p) = set qs" "prod_list qs = (n div p)" "length qs \<ge> 2"
        using p' by atomize_elim (auto intro: less simp: div_gt_0)
      moreover
      have "prime_factors (p * (n div p)) = insert p (prime_factors (n div p))"
        using \<open>3 < n\<close> \<open>2 \<le> p\<close> \<open>p \<le> n\<close> \<open>prime p\<close>
      by (auto simp: prime_factors_product div_gt_0 prime_factors_of_prime)
      ultimately
      have "prime_factors n = set (p # qs)" "prod_list (p # qs) = n" "length (p#qs) \<ge> 2"
        using \<open>p dvd n\<close> by simp_all
      hence ?case by blast
    }
    moreover
    { assume "prime (n div p)"
      then obtain qs
        where "prime_factors (n div p) = set qs" "prod_list qs = (n div p)" "length qs = 1"
        using prime_factors_list_prime by blast
      moreover
      have "prime_factors (p * (n div p)) = insert p (prime_factors (n div p))"
        using \<open>3 < n\<close> \<open>2 \<le> p\<close> \<open>p \<le> n\<close> \<open>prime p\<close>
      by (auto simp: prime_factors_product div_gt_0 prime_factors_of_prime)
      ultimately
      have "prime_factors n = set (p # qs)" "prod_list (p # qs) = n" "length (p#qs) \<ge> 2"
        using \<open>p dvd n\<close> by simp_all
      hence ?case by blast
    } note case_prime = this
    moreover
    { assume "n div p = 1"
      hence "n = p" using \<open>n>3\<close>  using One_leq_div[OF \<open>p dvd n\<close>] p'(2) by force
      hence ?case using \<open>prime p\<close> \<open>\<not> prime n\<close> by auto
    }
    moreover
    { assume "n div p = 2"
      hence ?case using case_prime by force
    }
    moreover
    { assume "n div p = 3"
      hence ?case using p' case_prime by force
    }
    ultimately show ?case using p' div_gt_0[of p n] case_prime by fastforce

qed

lemma prod_list_ge:
  fixes xs::"nat list"
  assumes "\<forall> x \<in> set xs . x \<ge> 1"
  shows "prod_list xs \<ge> 1" using assms by (induction xs) auto

lemma sum_list_log:
  fixes b::real
  fixes xs::"nat list"
  assumes b: "b > 0" "b \<noteq> 1"
  assumes xs:"\<forall> x \<in> set xs . x \<ge> b"
  shows "(\<Sum>x\<leftarrow>xs. log b x) = log b (prod_list xs)"
  using assms
proof (induction xs)
  case Nil
    thus ?case by simp
  next
  case (Cons y ys)
    have "real (prod_list ys) > 0" using prod_list_ge Cons.prems by fastforce
    thus ?case using log_mult[OF Cons.prems(1-2)] Cons by force
qed

lemma concat_length_le:
  fixes g :: "nat \<Rightarrow> real"
  assumes "\<forall> x \<in> set xs . real (length (f x)) \<le> g x"
  shows "length (concat (map f xs)) \<le> (\<Sum>x\<leftarrow>xs. g x)" using assms
  by (induction xs) force+

lemma prime_gt_3_impl_p_minus_one_not_prime:
  fixes p::nat
  assumes "prime p" "p>3"
  shows "\<not> prime (p - 1)"
proof
  assume "prime (p - 1)"
  have "\<not> even p" using assms by (simp add: prime_odd_nat)
  hence "2 dvd (p - 1)" by presburger
  then obtain q where "p - 1 = 2 * q" ..
  then have "2 \<in> prime_factors (p - 1)" using \<open>p>3\<close>
    by (auto simp: prime_factorization_times_prime)
  thus False using prime_factors_of_prime \<open>p>3\<close> \<open>prime (p - 1)\<close> by auto
qed

text \<open>
  We now prove that Pratt's proof system is complete and derive upper bounds for
  the length and the size of the entries of a minimal certificate.
\<close>

theorem pratt_complete':
  assumes "prime p"
  shows "\<exists>c. Prime p \<in> set c \<and> valid_cert c \<and> length c \<le> 6*log 2 p - 4 \<and> (\<forall> x \<in> set c. size_pratt x \<le> 3 * log 2 p)" using assms
proof (induction p rule: less_induct)
  case (less p)
  from \<open>prime p\<close> have "p > 1" by (rule prime_gt_1_nat)
  then consider "p = 2" | " p = 3" | "p > 3" by force
  thus ?case
  proof cases
    assume [simp]: "p = 2"
    have "Prime p \<in> set [Prime 2, Triple 2 1 1]" by simp
    thus ?case by fastforce
  next
    assume [simp]: "p = 3"
    let ?cert = "[Prime 3, Triple 3 2 2, Triple 3 2 1, Prime 2, Triple 2 1 1]"

    have "length ?cert \<le> 6*log 2 p - 4 \<longleftrightarrow> 3 \<le> 2 * log 2 3" by simp
    also have "2 * log 2 3 = log 2 (3 ^ 2 :: real)" by (subst log_nat_power) simp_all
    also have "\<dots> = log 2 9" by simp
    also have "3 \<le> log 2 9 \<longleftrightarrow> True" by (subst le_log_iff) simp_all
    finally show ?case
      by (intro exI[where x = "?cert"]) (simp add: cong_def)
  next
    assume "p > 3"
    have qlp: "\<forall>q \<in> prime_factors (p - 1) . q < p" using \<open>prime p\<close>
      by (metis One_nat_def Suc_pred le_imp_less_Suc lessI less_trans p_in_prime_factorsE prime_gt_1_nat zero_less_diff)
    hence factor_certs:"\<forall>q \<in> prime_factors (p - 1) . (\<exists>c . ((Prime q \<in> set c) \<and> (valid_cert c)
                                                      \<and> length c \<le> 6*log 2 q - 4) \<and> (\<forall> x \<in> set c. size_pratt x \<le> 3 * log 2 q))"
      by (auto intro: less.IH)
    obtain a where a:"[a^(p - 1) = 1] (mod p) \<and> (\<forall> q. q \<in> prime_factors (p - 1)
              \<longrightarrow> [a^((p - 1) div q) \<noteq> 1] (mod p))" and a_size: "a > 0" "a < p"
      using converse_lehmer[OF \<open>prime p\<close>] by blast

    have "\<not> prime (p - 1)" using \<open>p>3\<close> prime_gt_3_impl_p_minus_one_not_prime \<open>prime p\<close> by auto
    have "p \<noteq> 4" using \<open>prime p\<close> by auto
    hence "p - 1 > 3" using \<open>p > 3\<close> by auto

    then obtain qs where prod_qs_eq:"prod_list qs = p - 1"
        and qs_eq:"set qs = prime_factors (p - 1)" and qs_length_eq: "length qs \<ge> 2"
      using prime_factors_list[OF _ \<open>\<not> prime (p - 1)\<close>] by auto
    obtain f where f:"\<forall>q \<in> prime_factors (p - 1) . \<exists> c. f q = c
                     \<and> ((Prime q \<in> set c) \<and> (valid_cert c) \<and> length c \<le> 6*log 2 q - 4)
                     \<and> (\<forall> x \<in> set c. size_pratt x \<le> 3 * log 2 q)"
      using factor_certs by metis
    let ?cs = "map f qs"
    have cs: "\<forall>q \<in> prime_factors (p - 1) . (\<exists>c \<in> set ?cs . (Prime q \<in> set c) \<and> (valid_cert c)
                                           \<and> length c \<le> 6*log 2 q - 4
                                           \<and> (\<forall> x \<in> set c. size_pratt x \<le> 3 * log 2 q))"
      using f qs_eq by auto

    have cs_cert_size: "\<forall>c \<in> set ?cs . \<forall> x \<in> set c. size_pratt x \<le> 3 * log 2 p"
    proof
      fix c assume "c \<in> set (map f qs)"
      then obtain q where "c = f q" and "q \<in> set qs" by auto
      hence *:"\<forall> x \<in> set c. size_pratt x \<le> 3 * log 2 q" using f qs_eq by blast
      have "q < p" "q > 0" using qlp \<open>q \<in> set qs\<close> qs_eq prime_factors_gt_0_nat by auto
      show "\<forall> x \<in> set c. size_pratt x \<le> 3 * log 2 p"
      proof
        fix x assume "x \<in> set c"
        hence "size_pratt x \<le> 3 * log 2 q" using * by fastforce
        also have "\<dots> \<le> 3 * log 2 p" using \<open>q < p\<close> \<open>q > 0\<close> \<open>p > 3\<close> by simp
        finally show "size_pratt x \<le> 3 * log 2 p" .
      qed
    qed

    have cs_valid_all: "\<forall>c \<in> set ?cs . valid_cert c"
      using f qs_eq by fastforce

    have "\<forall>x \<in> set (build_fpc p a (p - 1) qs). size_pratt x \<le> 3 * log 2 p"
      using cs_cert_size a_size \<open>p > 3\<close> prod_qs_eq by (intro size_pratt_fpc) auto
    hence "\<forall>x \<in> set (build_fpc p a (p - 1) qs @ concat ?cs) . size_pratt x \<le> 3 * log 2 p"
      using cs_cert_size by auto
    moreover
    have "Triple p a (p - 1) \<in> set (build_fpc p a (p - 1) qs @ concat ?cs)" by (cases qs) auto
    moreover
    have "valid_cert ((build_fpc p a (p - 1) qs)@ concat ?cs)"
    proof (rule correct_fpc)
      show "valid_cert (concat ?cs)"
        using cs_valid_all by (auto simp: valid_cert_concatI)
      show "prod_list qs = p - 1" by (rule prod_qs_eq)
      show "p - 1 \<noteq> 0" using prime_gt_1_nat[OF \<open>prime p\<close>] by arith
      show "\<forall> q \<in> set qs . Prime q \<in> set (concat ?cs)"
        using concat_set[of "prime_factors (p - 1)"] cs qs_eq by blast
      show "\<forall> q \<in> set qs . [a^((p - 1) div q) \<noteq> 1] (mod p)" using qs_eq a by auto
    qed (insert \<open>p > 3\<close>, simp_all)
    moreover
    { let ?k = "length qs"

      have qs_ge_2:"\<forall>q \<in> set qs . q \<ge> 2" using qs_eq
        by (auto intro: prime_ge_2_nat)

      have "\<forall>x\<in>set qs. real (length (f x)) \<le> 6 * log 2 (real x) - 4" using f qs_eq by blast
      hence "length (concat ?cs) \<le> (\<Sum>q\<leftarrow>qs. 6*log 2 q - 4)" using concat_length_le
        by fast
      hence "length (Prime p # ((build_fpc p a (p - 1) qs)@ concat ?cs))
            \<le> ((\<Sum>q\<leftarrow>(map real qs). 6*log 2 q - 4) + ?k + 2)"
            by (simp add: o_def length_fpc)
      also have "\<dots> = (6*(\<Sum>q\<leftarrow>(map real qs). log 2 q) + (-4 * real ?k) + ?k + 2)"
        by (simp add: o_def sum_list_subtractf sum_list_triv sum_list_const_mult)
      also have "\<dots> \<le> 6*log 2 (p - 1) - 4" using \<open>?k\<ge>2\<close> prod_qs_eq sum_list_log[of 2 qs] qs_ge_2
        by force
      also have "\<dots> \<le> 6*log 2 p - 4" using log_le_cancel_iff[of 2 "p - 1" p] \<open>p>3\<close> by force
      ultimately have "length (Prime p # ((build_fpc p a (p - 1) qs)@ concat ?cs))
                       \<le> 6*log 2 p - 4" by linarith }
    ultimately obtain c where c:"Triple p a (p - 1) \<in> set c" "valid_cert c"
                               "length (Prime p #c) \<le> 6*log 2 p - 4"
                               "(\<forall> x \<in> set c. size_pratt x \<le> 3 * log 2 p)" by blast
    hence "Prime p \<in> set (Prime p # c)" "valid_cert (Prime p # c)"
         "(\<forall> x \<in> set (Prime p # c). size_pratt x \<le> 3 * log 2 p)"
    using a \<open>prime p\<close> by (auto simp: Primes.prime_gt_Suc_0_nat)
    thus ?case using c by blast
  qed
qed

text \<open>
  We now recapitulate our results. A number $p$ is prime if and only if there
  is a certificate for $p$. Moreover, for a prime $p$ there always is a certificate
  whose size is polynomially bounded in the logarithm of $p$.
\<close>

corollary pratt:
  "prime p \<longleftrightarrow> (\<exists>c. Prime p \<in> set c \<and> valid_cert c)"
  using pratt_complete' pratt_sound(1) by blast

corollary pratt_size:
  assumes "prime p"
  shows "\<exists>c. Prime p \<in> set c \<and> valid_cert c \<and> size_cert c \<le> (6 * log 2 p - 4) * (1 + 3 * log 2 p)"
proof -
  obtain c where c: "Prime p \<in> set c" "valid_cert c"
      and len: "length c \<le> 6*log 2 p - 4" and "(\<forall> x \<in> set c. size_pratt x \<le> 3 * log 2 p)"
    using pratt_complete' assms by blast
  hence "size_cert c \<le> length c * (1 + 3 * log 2 p)" by (simp add: size_pratt_le)
  also have "\<dots> \<le> (6*log 2 p - 4) * (1 + 3 * log 2 p)" using len by simp
  finally show ?thesis using c by blast
qed

subsection \<open>Efficient modular exponentiation\<close>

locale efficient_power =
  fixes f :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
  assumes f_assoc: "\<And>x z. f x (f x z) = f (f x x) z"
begin

function efficient_power :: "'a \<Rightarrow> 'a \<Rightarrow> nat \<Rightarrow> 'a" where
  "efficient_power y x 0 = y"
| "efficient_power y x (Suc 0) = f x y"
| "n \<noteq> 0 \<Longrightarrow> even n \<Longrightarrow> efficient_power y x n = efficient_power y (f x x) (n div 2)"
| "n \<noteq> 1 \<Longrightarrow> odd n \<Longrightarrow> efficient_power y x n = efficient_power (f x y) (f x x) (n div 2)"
  by force+
termination by (relation "measure (snd \<circ> snd)") (auto elim: oddE)

lemma efficient_power_code:
  "efficient_power y x n =
     (if n = 0 then y
      else if n = 1 then f x y
      else if even n then efficient_power y (f x x) (n div 2)
      else efficient_power (f x y) (f x x) (n div 2))"
  by (induction y x n rule: efficient_power.induct) auto

lemma efficient_power_correct: "efficient_power y x n = (f x ^^ n) y"
proof -
  have [simp]: "f ^^ 2 = (\<lambda>x. f (f x))" for f :: "'a \<Rightarrow> 'a"
    by (simp add: eval_nat_numeral o_def)
  show ?thesis
    by (induction y x n rule: efficient_power.induct)
       (auto elim!: evenE oddE simp: funpow_mult [symmetric] funpow_Suc_right f_assoc
             simp del: funpow.simps(2))
qed

end

interpretation mod_exp_nat: efficient_power "\<lambda>x y :: nat. (x * y) mod m"
  by standard (simp add: mod_mult_left_eq mod_mult_right_eq mult_ac)

definition mod_exp_nat_aux where "mod_exp_nat_aux = mod_exp_nat.efficient_power"

lemma mod_exp_nat_aux_code [code]:
  "mod_exp_nat_aux m y x n =
     (if n = 0 then y
      else if n = 1 then (x * y) mod m
      else if even n then mod_exp_nat_aux m y ((x * x) mod m) (n div 2)
      else mod_exp_nat_aux m ((x * y) mod m) ((x * x) mod m) (n div 2))"
  unfolding mod_exp_nat_aux_def by (rule mod_exp_nat.efficient_power_code)

lemma mod_exp_nat_aux_correct:
  "mod_exp_nat_aux m y x n mod m = (x ^ n * y) mod m"
proof -
  have "mod_exp_nat_aux m y x n = ((\<lambda>y. x * y mod m) ^^ n) y"
    by (simp add: mod_exp_nat_aux_def mod_exp_nat.efficient_power_correct)
  also have "((\<lambda>y. x * y mod m) ^^ n) y mod m = (x ^ n * y) mod m"
  proof (induction n)
    case (Suc n)
    hence "x * ((\<lambda>y. x * y mod m) ^^ n) y mod m = x * x ^ n * y mod m"
      by (metis mod_mult_right_eq mult.assoc)
    thus ?case by auto
  qed auto
  finally show ?thesis .
qed

definition mod_exp_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat \<Rightarrow> nat"
  where [code_abbrev]: "mod_exp_nat b e m = (b ^ e) mod m"

lemma mod_exp_nat_code [code]: "mod_exp_nat b e m = mod_exp_nat_aux m 1 b e mod m"
  by (simp add: mod_exp_nat_def mod_exp_nat_aux_correct)

lemmas [code_unfold] = cong_def

lemma eval_mod_exp_nat_aux [simp]:
  "mod_exp_nat_aux m y x 0 = y"
  "mod_exp_nat_aux m y x (Suc 0) = (x * y) mod m"
  "mod_exp_nat_aux m y x (numeral (num.Bit0 n)) =
     mod_exp_nat_aux m y (x\<^sup>2 mod m) (numeral n)"
  "mod_exp_nat_aux m y x (numeral (num.Bit1 n)) =
     mod_exp_nat_aux m ((x * y) mod m) (x\<^sup>2 mod m) (numeral n)"
proof -
  define n' where "n' = (numeral n :: nat)"
  have [simp]: "n' \<noteq> 0" by (auto simp: n'_def)

  show "mod_exp_nat_aux m y x 0 = y" and "mod_exp_nat_aux m y x (Suc 0) = (x * y) mod m"
    by (simp_all add: mod_exp_nat_aux_def)

  have "numeral (num.Bit0 n) = (2 * n')"
    by (subst numeral.numeral_Bit0) (simp del: arith_simps add: n'_def)
  also have "mod_exp_nat_aux m y x \<dots> = mod_exp_nat_aux m y (x^2 mod m) n'"
    by (subst mod_exp_nat_aux_code) (simp_all add: power2_eq_square)
  finally show "mod_exp_nat_aux m y x (numeral (num.Bit0 n)) =
                  mod_exp_nat_aux m y (x\<^sup>2 mod m) (numeral n)"
    by (simp add: n'_def)

  have "numeral (num.Bit1 n) = Suc (2 * n')"
    by (subst numeral.numeral_Bit1) (simp del: arith_simps add: n'_def)
  also have "mod_exp_nat_aux m y x \<dots> = mod_exp_nat_aux m ((x * y) mod m) (x^2 mod m) n'"
    by (subst mod_exp_nat_aux_code) (simp_all add: power2_eq_square)
  finally show "mod_exp_nat_aux m y x (numeral (num.Bit1 n)) =
                  mod_exp_nat_aux m ((x * y) mod m) (x\<^sup>2 mod m) (numeral n)"
    by (simp add: n'_def)
qed

lemma eval_mod_exp [simp]:
  "mod_exp_nat b' 0 m' = 1 mod m'"
  "mod_exp_nat b' 1 m' = b' mod m'"
  "mod_exp_nat b' (Suc 0) m' = b' mod m'"
  "mod_exp_nat b' e' 0 = b' ^ e'"
  "mod_exp_nat b' e' 1 = 0"
  "mod_exp_nat b' e' (Suc 0) = 0"
  "mod_exp_nat 0 1 m' = 0"
  "mod_exp_nat 0 (Suc 0) m' = 0"
  "mod_exp_nat 0 (numeral e) m' = 0"
  "mod_exp_nat 1 e' m' = 1 mod m'"
  "mod_exp_nat (Suc 0) e' m' = 1 mod m'"
  "mod_exp_nat (numeral b) (numeral e) (numeral m) =
     mod_exp_nat_aux (numeral m) 1 (numeral b) (numeral e) mod numeral m"
  by (simp_all add: mod_exp_nat_def mod_exp_nat_aux_correct)

subsection \<open>Executable certificate checker\<close>

lemmas [code] = valid_cert.simps(1)

context
begin

lemma valid_cert_Cons1 [code]:
  "valid_cert (Prime p # xs) \<longleftrightarrow>
     p > 1 \<and> (\<exists>t\<in>set xs. case t of Prime _ \<Rightarrow> False |
     Triple p' a x \<Rightarrow> p' = p \<and> x = p - 1 \<and> mod_exp_nat a (p-1) p = 1 ) \<and> valid_cert xs"
  (is "?lhs = ?rhs")
proof
  assume ?lhs thus ?rhs by (auto simp: mod_exp_nat_def cong_def split: pratt.splits)
next
  assume ?rhs
  hence "p > 1" "valid_cert xs" by blast+
  moreover from \<open>?rhs\<close> obtain t where "t \<in> set xs" "case t of Prime _ \<Rightarrow> False |
     Triple p' a x \<Rightarrow> p' = p \<and> x = p - 1 \<and> [a^(p-1) = 1] (mod p)"
     by (auto simp: cong_def mod_exp_nat_def cong: pratt.case_cong)
  ultimately show ?lhs by (cases t) auto
qed

private lemma Suc_0_mod_eq_Suc_0_iff:
  "Suc 0 mod n = Suc 0 \<longleftrightarrow> n \<noteq> Suc 0"
proof -
  consider "n = 0" | "n = Suc 0" | "n > 1" by (cases n) auto
  thus ?thesis by cases auto
qed

private lemma Suc_0_eq_Suc_0_mod_iff:
  "Suc 0 = Suc 0 mod n \<longleftrightarrow> n \<noteq> Suc 0"
  using Suc_0_mod_eq_Suc_0_iff by (simp add: eq_commute)

lemma valid_cert_Cons2 [code]:
  "valid_cert (Triple p a x # xs) \<longleftrightarrow> x > 0 \<and> p > 1 \<and> (x = 1 \<or> (
     (\<exists>t\<in>set xs. case t of Prime _ \<Rightarrow> False |
        Triple p' a' y \<Rightarrow> p' = p \<and> a' = a \<and> y dvd x \<and>
        (let q = x div y in Prime q \<in> set xs \<and> mod_exp_nat a ((p-1) div q) p \<noteq> 1)))) \<and> valid_cert xs"
  (is "?lhs = ?rhs")
proof
  assume ?lhs
  from \<open>?lhs\<close> have pos: "x > 0" and gt_1: "p > 1" and valid: "valid_cert xs" by simp_all
  show ?rhs
  proof (cases "x = 1")
    case True
    with \<open>?lhs\<close> show ?thesis by auto
  next
    case False
    with \<open>?lhs\<close> have "(\<exists>q y. x = q * y \<and> Prime q \<in> set xs \<and> Triple p a y \<in> set xs
      \<and> [a^((p - 1) div q) \<noteq> 1] (mod p))" by auto
    then guess q y by (elim exE conjE) note qy = this
    hence "(\<exists>t\<in>set xs. case t of Prime _ \<Rightarrow> False |
        Triple p' a' y \<Rightarrow> p' = p \<and> a' = a \<and> y dvd x \<and>
        (let q = x div y in Prime q \<in> set xs \<and> mod_exp_nat a ((p-1) div q) p \<noteq> 1))"
    using pos gt_1 by (intro bexI [of _ "Triple p a y"])
      (auto simp: Suc_0_mod_eq_Suc_0_iff Suc_0_eq_Suc_0_mod_iff cong_def mod_exp_nat_def)
    with pos gt_1 valid show ?thesis by blast
  qed
next
  assume ?rhs
  hence pos: "x > 0" and gt_1: "p > 1" and valid: "valid_cert xs" by simp_all
  show ?lhs
  proof (cases "x = 1")
    case True
    with \<open>?rhs\<close> show ?thesis by auto
  next
    case False
    with \<open>?rhs\<close> obtain t where t: "t \<in> set xs" "case t of Prime x \<Rightarrow> False
         | Triple p' a' y \<Rightarrow> p' = p \<and> a' = a \<and> y dvd x \<and> (let q = x div y
              in Prime q \<in> set xs \<and> mod_exp_nat a ((p - 1) div q) p \<noteq> 1)" by auto
    then obtain y where y: "t = Triple p a y" "y dvd x" "let q = x div y in Prime q \<in> set xs \<and>
                              mod_exp_nat a ((p - 1) div q) p \<noteq> 1"
      by (cases t rule: pratt.exhaust) auto
    with gt_1 have y': "let q = x div y in Prime q \<in> set xs \<and> [a^((p - 1) div q) \<noteq> 1] (mod p)"
      by (auto simp: cong_def Let_def mod_exp_nat_def Suc_0_mod_eq_Suc_0_iff Suc_0_eq_Suc_0_mod_iff)
    define q where "q = x div y"
    have "\<exists>q y. x = q * y \<and> Prime q \<in> set xs \<and> Triple p a y \<in> set xs
                     \<and> [a^((p - 1) div q) \<noteq> 1] (mod p)"
      by (rule exI[of _ q], rule exI[of _ y]) (insert t y y', auto simp: Let_def q_def)
    with pos gt_1 valid show ?thesis by simp
  qed
qed

declare valid_cert.simps(2,3) [simp del]

lemmas eval_valid_cert = valid_cert.simps(1) valid_cert_Cons1 valid_cert_Cons2

end

text \<open>
  The following alternative tree representation of certificates is better suited for
  efficient checking.
\<close>

datatype pratt_tree = Pratt_Node "nat \<times> nat \<times> pratt_tree list"

fun pratt_tree_number where
  "pratt_tree_number (Pratt_Node (n, _, _)) = n"

text \<open>
  The following function checks that a given list contains all the prime factors of the given
  number.
\<close>

fun check_prime_factors_subset :: "nat \<Rightarrow> nat list \<Rightarrow> bool" where
  "check_prime_factors_subset n [] \<longleftrightarrow> n = 1"
| "check_prime_factors_subset n (p # ps) \<longleftrightarrow> (if n = 0 then False else
     (if p > 1 \<and> p dvd n then check_prime_factors_subset (n div p) (p # ps)
                         else check_prime_factors_subset n ps))"

lemma check_prime_factors_subset_0 [simp]: "\<not>check_prime_factors_subset 0 ps"
  by (induction ps) auto

lemmas [simp del] = check_prime_factors_subset.simps(2)

lemma check_prime_factors_subset_Cons [simp]:
  "check_prime_factors_subset (Suc 0) (p # ps) \<longleftrightarrow> check_prime_factors_subset (Suc 0) ps"
  "check_prime_factors_subset 1 (p # ps) \<longleftrightarrow> check_prime_factors_subset 1 ps"
  "p > 1 \<Longrightarrow> p dvd numeral n \<Longrightarrow> check_prime_factors_subset (numeral n) (p # ps) \<longleftrightarrow>
                           check_prime_factors_subset (numeral n div p) (p # ps)"
  "p \<le> 1 \<or> \<not>p dvd numeral n \<Longrightarrow> check_prime_factors_subset (numeral n) (p # ps) \<longleftrightarrow>
                           check_prime_factors_subset (numeral n) ps"
 by (subst check_prime_factors_subset.simps; force)+

lemma check_prime_factors_subset_correct:
  assumes "check_prime_factors_subset n ps" "list_all prime ps"
  shows   "prime_factors n \<subseteq> set ps"
  using assms
proof (induction n ps rule: check_prime_factors_subset.induct)
  case (2 n p ps)
  note * = this
  from "2.prems" have "prime p" and "p > 1"
    by (auto simp: prime_gt_Suc_0_nat)

  consider "n = 0" | "n > 0" "p dvd n" | "n > 0" "\<not>(p dvd n)"
    by blast
  thus ?case
  proof cases
    case 2
    hence "n div p > 0" by auto
    hence "prime_factors ((n div p) * p) = insert p (prime_factors (n div p))"
      using \<open>p > 1\<close> \<open>prime p\<close> by (auto simp: prime_factors_product prime_prime_factors)
    also have "(n div p) * p = n"
      using 2 by auto
    finally show ?thesis using 2 \<open>p > 1\<close> *
      by (auto simp: check_prime_factors_subset.simps(2)[of n])
  next
    case 3
    with * and \<open>p > 1\<close> show ?thesis
      by (auto simp: check_prime_factors_subset.simps(2)[of n])
  qed auto
qed auto

fun valid_pratt_tree where
  "valid_pratt_tree (Pratt_Node (n, a, ts)) \<longleftrightarrow>
     n \<ge> 2 \<and>
     check_prime_factors_subset (n - 1) (map pratt_tree_number ts) \<and>
     [a ^ (n - 1) = 1] (mod n) \<and>
     (\<forall>t\<in>set ts. [a ^ ((n - 1) div pratt_tree_number t) \<noteq> 1] (mod n)) \<and>
     (\<forall>t\<in>set ts. valid_pratt_tree t)"

lemma valid_pratt_tree_code [code]:
  "valid_pratt_tree (Pratt_Node (n, a, ts)) \<longleftrightarrow>
     n \<ge> 2 \<and>
     check_prime_factors_subset (n - 1) (map pratt_tree_number ts) \<and>
     mod_exp_nat a (n - 1) n = 1 \<and>
     (\<forall>t\<in>set ts. mod_exp_nat a ((n - 1) div pratt_tree_number t) n \<noteq> 1) \<and>
     (\<forall>t\<in>set ts. valid_pratt_tree t)"
  by (simp add: mod_exp_nat_def cong_def)

lemma valid_pratt_tree_imp_prime:
  assumes "valid_pratt_tree t"
  shows   "prime (pratt_tree_number t)"
  using assms
proof (induction t rule: valid_pratt_tree.induct)
  case (1 n a ts)
  from 1 have "prime_factors (n - 1) \<subseteq> set (map pratt_tree_number ts)"
    by (intro check_prime_factors_subset_correct) (auto simp: list.pred_set)
  with 1 show ?case
    by (intro lehmers_theorem[where a = a]) auto
qed

lemma valid_pratt_tree_imp_prime':
  assumes "PROP (Trueprop (valid_pratt_tree (Pratt_Node (n, a, ts)))) \<equiv> PROP (Trueprop True)"
  shows   "prime n"
proof -
  have "valid_pratt_tree (Pratt_Node (n, a, ts))"
    by (subst assms) auto
  from valid_pratt_tree_imp_prime[OF this] show ?thesis by simp
qed

subsection \<open>Proof method setup\<close>

theorem lehmers_theorem':
  fixes p :: nat
  assumes "list_all prime ps" "a \<equiv> a" "n \<equiv> n"
  assumes "list_all (\<lambda>p. mod_exp_nat a ((n - 1) div p) n \<noteq> 1) ps" "mod_exp_nat a (n - 1) n = 1"
  assumes "check_prime_factors_subset (n - 1) ps" "2 \<le> n"
  shows "prime n"
  using assms check_prime_factors_subset_correct[OF assms(6,1)]
  by (intro lehmers_theorem[where a = a]) (auto simp: cong_def mod_exp_nat_def list.pred_set)

lemma list_all_ConsI: "P x \<Longrightarrow> list_all P xs \<Longrightarrow> list_all P (x # xs)"
  by simp

ML_file \<open>pratt.ML\<close>

method_setup pratt = \<open>
  Scan.lift (Pratt.tac_config_parser -- Scan.option Pratt.cert_cartouche) >>
    (fn (config, cert) => fn ctxt => SIMPLE_METHOD (HEADGOAL (Pratt.tac config cert ctxt)))
\<close> "Prove primality of natural numbers using Pratt certificates."

text \<open>
  The proof method replays a given Pratt certificate to prove the primality of a given number.
  If no certificate is given, the method attempts to compute one. The computed certificate is then
  also printed with a prompt to insert it into the proof document so that it does not have to
  be recomputed the next time.

  The format of the certificates is compatible with those generated by Mathematica. Therefore,
  for larger numbers, certificates generated by Mathematica can be used with this method directly.
\<close>
lemma "prime (47 :: nat)"
  by (pratt (silent))

lemma "prime (2503 :: nat)"
  by pratt

lemma "prime (7919 :: nat)"
  by pratt

lemma "prime (131059 :: nat)"
  by (pratt \<open>{131059, 2, {2, {3, 2, {2}}, {809, 3, {2, {101, 2, {2, {5, 2, {2}}}}}}}}\<close>)

end


section \<open>Landau Symbols\<close>

theory Landau_Ext
  imports
    "HOL-Library.Landau_Symbols"
    "HOL.Topological_Spaces"
begin

text \<open>This section contains results about Landau Symbols in addition to "HOL-Library.Landau".\<close>

lemma landau_sum:
  assumes "eventually (\<lambda>x. g1 x \<ge> (0::real)) F"
  assumes "eventually (\<lambda>x. g2 x \<ge> 0) F"
  assumes "f1 \<in> O[F](g1)"
  assumes "f2 \<in> O[F](g2)"
  shows "(\<lambda>x. f1 x + f2 x) \<in> O[F](\<lambda>x. g1 x + g2 x)"
proof -
  obtain c1 where a1: "c1 > 0" and b1: "eventually (\<lambda>x. abs (f1 x) \<le> c1 * abs (g1 x)) F"
    using assms(3) by (simp add:bigo_def, blast)
  obtain c2 where a2: "c2 > 0" and b2: "eventually (\<lambda>x. abs (f2 x) \<le> c2 * abs (g2 x)) F"
    using assms(4) by (simp add:bigo_def, blast)
  have "eventually (\<lambda>x. abs (f1 x + f2 x) \<le> (max c1 c2) * abs (g1 x + g2 x)) F"
  proof (rule eventually_mono[OF eventually_conj[OF b1 eventually_conj[OF b2 eventually_conj[OF assms(1,2)]]]])
    fix x
    assume a: "\<bar>f1 x\<bar> \<le> c1 * \<bar>g1 x\<bar> \<and> \<bar>f2 x\<bar> \<le> c2 * \<bar>g2 x\<bar> \<and> 0 \<le> g1 x \<and> 0 \<le> g2 x"
    have "\<bar>f1 x + f2 x\<bar> \<le> \<bar>f1 x \<bar> + \<bar>f2 x\<bar>" using abs_triangle_ineq by blast
    also have "... \<le> c1 *  \<bar>g1 x\<bar> + c2 * \<bar>g2 x\<bar>" using a add_mono by blast
    also have "... \<le> max c1 c2 * \<bar>g1 x\<bar> + max c1 c2 * \<bar>g2 x\<bar>"
      by (intro add_mono mult_right_mono) auto
    also have "... = max c1 c2 * (\<bar>g1 x\<bar> + \<bar>g2 x\<bar>)"
      by (simp add:algebra_simps)
    also have "... \<le> max c1 c2 * (\<bar>g1 x + g2 x\<bar>)"
      using a a1 a2 by (intro mult_left_mono) auto
    finally show "\<bar>f1 x + f2 x\<bar> \<le> max c1 c2 * \<bar>g1 x + g2 x\<bar>"
      by (simp add:algebra_simps)
  qed
  hence " 0 < max c1 c2 \<and> (\<forall>\<^sub>F x in F. \<bar>f1 x + f2 x\<bar> \<le> max c1 c2 * \<bar>g1 x + g2 x\<bar>)"
    using a1 a2 by linarith
  thus ?thesis
    by (simp add: bigo_def, blast)
qed

lemma landau_sum_1:
  assumes "eventually (\<lambda>x. g1 x \<ge> (0::real)) F"
  assumes "eventually (\<lambda>x. g2 x \<ge> 0) F"
  assumes "f \<in> O[F](g1)"
  shows "f \<in> O[F](\<lambda>x. g1 x + g2 x)"
proof -
  have "f = (\<lambda>x. f x + 0)" by simp
  also have "... \<in> O[F](\<lambda>x. g1 x + g2 x)"
    using assms zero_in_bigo by (intro landau_sum)
  finally show ?thesis by simp
qed

lemma landau_sum_2:
  assumes "eventually (\<lambda>x. g1 x \<ge> (0::real)) F"
  assumes "eventually (\<lambda>x. g2 x \<ge> 0) F"
  assumes "f \<in> O[F](g2)"
  shows "f \<in> O[F](\<lambda>x. g1 x + g2 x)"
proof -
  have "f = (\<lambda>x. 0 + f x)" by simp
  also have "... \<in> O[F](\<lambda>x. g1 x + g2 x)"
    using assms zero_in_bigo by (intro landau_sum)
  finally show ?thesis by simp
qed

lemma landau_ln_3:
  assumes "eventually (\<lambda>x. (1::real) \<le> f x) F"
  assumes "f \<in> O[F](g)"
  shows "(\<lambda>x. ln (f x)) \<in> O[F](g)"
proof -
  have "1 \<le> x \<Longrightarrow> \<bar>ln x\<bar> \<le> \<bar>x\<bar>" for x :: real
    using ln_bound by auto
  hence "(\<lambda>x. ln (f x)) \<in> O[F](f)"
    by (intro landau_o.big_mono eventually_mono[OF assms(1)]) simp
  thus ?thesis
    using assms(2) landau_o.big_trans by blast
qed

lemma landau_ln_2:
  assumes "a > (1::real)"
  assumes "eventually (\<lambda>x. 1 \<le> f x) F"
  assumes "eventually (\<lambda>x. a \<le> g x) F"
  assumes "f \<in> O[F](g)"
  shows "(\<lambda>x. ln (f x)) \<in> O[F](\<lambda>x. ln (g x))"
proof -
  obtain c where a: "c > 0" and b: "eventually (\<lambda>x. abs (f x) \<le> c * abs (g x)) F"
    using assms(4) by (simp add:bigo_def, blast)
  define d where "d = 1 + (max 0 (ln c)) / ln a"
  have d:"eventually (\<lambda>x. abs (ln (f x)) \<le> d * abs (ln (g x))) F"
  proof (rule eventually_mono[OF eventually_conj[OF b eventually_conj[OF assms(3,2)]]])
    fix x
    assume c:"\<bar>f x\<bar> \<le> c * \<bar>g x\<bar> \<and> a \<le> g x \<and> 1 \<le> f x"
    have "abs (ln (f x)) = ln (f x)"
      by (subst abs_of_nonneg, rule ln_ge_zero, metis c, simp)
    also have "... \<le> ln (c * abs (g x))"
      using c assms(1)  mult_pos_pos[OF a] by auto
    also have "... \<le> ln c + ln (abs (g x))"
      using c assms(1)
      by (simp add: ln_mult[OF a])
    also have "... \<le> (d-1)*ln a + ln (g x)"
      using assms(1) c
      by (intro add_mono iffD2[OF ln_le_cancel_iff], simp_all add:d_def)
    also have "... \<le> (d-1)* ln (g x) + ln (g x)"
      using assms(1) c
      by (intro add_mono mult_left_mono iffD2[OF ln_le_cancel_iff], simp_all add:d_def)
    also have "... = d * ln (g x)" by (simp add:algebra_simps)
    also have "... = d * abs (ln (g x))"
      using c assms(1) by auto
    finally show "abs (ln (f x)) \<le> d * abs (ln (g x))" by simp
  qed
  hence "\<forall>\<^sub>F x in F. \<bar>ln (f x)\<bar> \<le> d * \<bar>ln (g x)\<bar>"
    by simp
  moreover have "0 < d"
    unfolding d_def using assms(1)
    by (intro add_pos_nonneg divide_nonneg_pos, auto)
  ultimately show ?thesis
    by (auto simp:bigo_def)
qed

lemma landau_real_nat:
  fixes f :: "'a \<Rightarrow> int"
  assumes "(\<lambda>x. of_int (f x)) \<in> O[F](g)"
  shows "(\<lambda>x. real (nat (f x))) \<in> O[F](g)"
proof -
  obtain c where a: "c > 0" and b: "eventually (\<lambda>x. abs (of_int (f x)) \<le> c * abs (g x)) F"
    using assms(1) by (simp add:bigo_def, blast)
  have "\<forall>\<^sub>F x in F. real (nat (f x)) \<le> c * \<bar>g x\<bar>"
    by (rule eventually_mono[OF b],  simp)
  thus ?thesis using a
    by (auto simp:bigo_def)
qed

lemma landau_ceil:
  assumes "(\<lambda>_. 1) \<in> O[F'](g)"
  assumes "f \<in> O[F'](g)"
  shows "(\<lambda>x. real_of_int \<lceil>f x\<rceil>) \<in> O[F'](g)"
proof -
  have "(\<lambda>x. real_of_int \<lceil>f x\<rceil>) \<in> O[F'](\<lambda>x. 1 + abs (f x))"
    by (intro landau_o.big_mono always_eventually allI, simp, linarith)
  also have "(\<lambda>x. 1 + abs(f x)) \<in> O[F'](g)"
    using assms(2) by (intro sum_in_bigo assms(1), auto)
  finally show ?thesis by simp
qed

lemma landau_rat_ceil:
  assumes "(\<lambda>_. 1) \<in> O[F'](g)"
  assumes "(\<lambda>x. real_of_rat (f x)) \<in> O[F'](g)"
  shows "(\<lambda>x. real_of_int \<lceil>f x\<rceil>) \<in> O[F'](g)"
proof -
  have a:"\<bar>real_of_int \<lceil>x\<rceil>\<bar> \<le> 1 + real_of_rat \<bar>x\<bar>" for x :: rat
  proof (cases "x \<ge> 0")
    case True
    then show ?thesis
      by  (simp, metis  add.commute  of_int_ceiling_le_add_one of_rat_ceiling)
  next
    case False
    have "real_of_rat x - 1 \<le> real_of_rat x"
      by simp
    also have "... \<le> real_of_int \<lceil>x\<rceil>"
      by (metis ceiling_correct of_rat_ceiling)
    finally have " real_of_rat (x)-1 \<le> real_of_int \<lceil>x\<rceil>" by simp

    hence "- real_of_int \<lceil>x\<rceil> \<le> 1 + real_of_rat (- x)"
      by (simp add: of_rat_minus)
    then show ?thesis using False by simp
  qed
  have "(\<lambda>x. real_of_int \<lceil>f x\<rceil>) \<in> O[F'](\<lambda>x. 1 + abs (real_of_rat (f x)))"
    using a
    by (intro landau_o.big_mono always_eventually allI, simp)
  also have "(\<lambda>x. 1 + abs (real_of_rat (f x))) \<in> O[F'](g)"
    using assms
    by (intro sum_in_bigo assms(1), subst landau_o.big.abs_in_iff, simp)
  finally show ?thesis by simp
qed

lemma landau_nat_ceil:
  assumes "(\<lambda>_. 1) \<in> O[F'](g)"
  assumes "f \<in> O[F'](g)"
  shows "(\<lambda>x. real (nat \<lceil>f x\<rceil>)) \<in> O[F'](g)"
  using assms
  by (intro landau_real_nat landau_ceil, auto)

lemma eventually_prod1':
  assumes "B \<noteq> bot"
  assumes " (\<forall>\<^sub>F x in A. P x)"
  shows "(\<forall>\<^sub>F x in A \<times>\<^sub>F B. P (fst x))"
proof -
  have "(\<forall>\<^sub>F x in A \<times>\<^sub>F B. P (fst x)) = (\<forall>\<^sub>F (x,y) in A \<times>\<^sub>F B. P x)"
    by (simp add:case_prod_beta')
  also have "... = (\<forall>\<^sub>F x in A. P x)"
    by (subst eventually_prod1[OF assms(1)], simp)
  finally show ?thesis using assms(2) by simp
qed

lemma eventually_prod2':
  assumes "A \<noteq> bot"
  assumes " (\<forall>\<^sub>F x in B. P x)"
  shows "(\<forall>\<^sub>F x in A \<times>\<^sub>F B. P (snd x))"
proof -
  have "(\<forall>\<^sub>F x in A \<times>\<^sub>F B. P (snd x)) = (\<forall>\<^sub>F (x,y) in A \<times>\<^sub>F B. P y)"
    by (simp add:case_prod_beta')
  also have "... = (\<forall>\<^sub>F x in B. P x)"
    by (subst eventually_prod2[OF assms(1)], simp)
  finally show ?thesis using assms(2) by simp
qed

lemma sequentially_inf: "\<forall>\<^sub>F x in sequentially. n \<le> real x"
  by (meson eventually_at_top_linorder nat_ceiling_le_eq)

instantiation rat :: linorder_topology
begin

definition open_rat :: "rat set \<Rightarrow> bool"
  where "open_rat = generate_topology (range (\<lambda>a. {..< a}) \<union> range (\<lambda>a. {a <..}))"

instance
  by standard (rule open_rat_def)
end

lemma inv_at_right_0_inf:
  "\<forall>\<^sub>F x in at_right 0. c \<le> 1 / real_of_rat x"
proof -
  have a:" c \<le> 1 / real_of_rat x" if b:" x \<in> {0<..<1 / rat_of_int (max \<lceil>c\<rceil> 1)}" for x
  proof -
    have "c * real_of_rat x \<le> real_of_int (max \<lceil>c\<rceil> 1) * real_of_rat x"
      using b by (intro mult_right_mono, linarith, auto)
    also have "... < real_of_int (max \<lceil>c\<rceil> 1)  * real_of_rat (1/rat_of_int  (max \<lceil>c\<rceil> 1) )"
      using b by (intro mult_strict_left_mono iffD2[OF of_rat_less], auto)
    also have "... \<le> 1"
      by (simp add:of_rat_divide)
    finally have "c * real_of_rat x \<le> 1" by simp
    moreover have "0 < real_of_rat x"
      using b by simp
    ultimately show ?thesis by (subst pos_le_divide_eq, auto)
  qed

  show ?thesis
    using a
    by (intro eventually_at_rightI[where b="1/rat_of_int (max \<lceil>c\<rceil> 1)"], simp_all)
qed

end


(*  Author:     Gertrud Bauer, Tobias Nipkow
*)

section \<open>Basic Functions Old and New\<close>

theory ListAux
imports Main
begin

declare Let_def[simp]

subsection \<open>HOL\<close>

lemma pairD:  "(a,b) = p \<Longrightarrow> a = fst p \<and> b = snd p"
by auto

lemmas conj_aci = conj_comms conj_assoc conj_absorb conj_left_absorb

definition enum :: "nat \<Rightarrow> nat set" where
  [code_abbrev]: "enum n = {..<n}"

subsection \<open>Lists\<close>

declare List.member_def[simp] list_all_iff[simp] list_ex_iff[simp]

subsubsection\<open>\<open>length\<close>\<close>

notation length  ("|_|")

lemma length3D: "|xs| = 3 \<Longrightarrow> \<exists>x y z. xs = [x, y, z]"
apply (cases xs) apply simp
apply (case_tac list) apply simp
apply (case_tac lista) by simp_all

lemma length4D: "|xs| = 4 \<Longrightarrow> \<exists> a b c d. xs = [a, b, c, d]"
 apply (case_tac xs) apply simp
 apply (case_tac list) apply simp
 apply (case_tac lista) apply simp
 apply (case_tac listb) by simp_all

subsubsection \<open>@{const filter}\<close>

lemma filter_emptyE[dest]: "(filter P xs = []) \<Longrightarrow>  x \<in> set xs \<Longrightarrow>  \<not> P x"
  by (simp add: filter_empty_conv)

lemma filter_comm: "[x \<leftarrow> xs. P x \<and> Q x] = [x \<leftarrow> xs. Q x \<and> P x]"
  by (simp add: conj_aci)

lemma filter_prop: "x \<in> set [u\<leftarrow>ys . P u] \<Longrightarrow> P x"
proof (induct ys arbitrary: x)
  case Nil then show ?case by simp
next
  case Cons then show ?case by (auto split: if_split_asm)
qed

lemma filter_compl1:
 "([x\<leftarrow>xs. P x] = []) = ([x\<leftarrow>xs. \<not> P x] = xs)" (is "?lhs = ?rhs")
proof
  show "?rhs \<Longrightarrow> ?lhs"
  proof (induct xs)
    case Nil then show ?case by simp
  next
    case (Cons x xs)
    have "[u\<leftarrow>xs . \<not> P u] \<noteq> x # xs"
    proof
      assume "[u\<leftarrow>xs . \<not> P u] = x # xs"
      then have "|x # xs| = |[u\<leftarrow>xs . \<not> P u]|" by simp
      also have "... \<le> |xs|" by simp
      finally show False by simp
    qed
    with Cons show ?case by auto
  qed
next
  show "?lhs \<Longrightarrow> ?rhs"
    by (induct xs) (simp_all split: if_split_asm)
qed

lemma filter_eqI:
  "(\<And>v. v \<in> set vs \<Longrightarrow> P v = Q v) \<Longrightarrow> [v\<leftarrow>vs . P v] = [v\<leftarrow>vs . Q v]"
  by (induct vs) simp_all

lemma filter_simp: "(\<And>x. x \<in> set xs \<Longrightarrow> P x) \<Longrightarrow> [x\<leftarrow>xs. P x \<and> Q x] = [x\<leftarrow>xs. Q x]"
 by (induct xs) auto

lemma filter_True_eq1:
  "(length [y\<leftarrow>xs. P y] = length xs) \<Longrightarrow> (\<And>y. y \<in> set xs \<Longrightarrow> P y)"
proof (induct xs)
  case Nil then show ?case by simp
next
  case (Cons x xs)
  have l: "length (filter P xs) \<le> length xs"
    by (simp add: length_filter_le)
  have hyp: "length (filter P (x # xs)) = length (x # xs)" by fact
  then have "P x"  by (simp split: if_split_asm) (insert l, arith)
  moreover with hyp have "length (filter P xs) = length xs"
    by (simp split: if_split_asm)
  moreover have "y \<in> set (x#xs)" by fact
  ultimately show ?case by (auto dest: Cons(1))
qed

lemma [simp]: "[f x. x <- xs, P x] = [f x. x <- [x \<leftarrow> xs. P x]]"
  by (induct xs) auto

subsubsection \<open>@{const concat}\<close>

syntax
  "_concat" :: "idt \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list"  ("\<Squnion>\<^bsub>_\<in> _\<^esub> _" 10)
translations
  "\<Squnion>\<^bsub>x\<in>xs\<^esub> f" == "CONST concat [f. x <- xs]"

subsubsection \<open>List product\<close>

definition listProd1 :: "'a \<Rightarrow> 'b list \<Rightarrow> ('a \<times> 'b) list" where
 "listProd1 a bs \<equiv> [(a,b). b <- bs]"

definition listProd :: "'a list \<Rightarrow> 'b list \<Rightarrow> ('a \<times> 'b) list" (infix "\<times>" 50) where
 "as \<times> bs \<equiv> \<Squnion>\<^bsub>a \<in> as\<^esub> listProd1 a bs"

lemma(*<*)[simp]: (*>*) "set (xs \<times> ys) = (set xs) \<times> (set ys)"
  by (auto simp: listProd_def listProd1_def)

subsubsection \<open>Minimum and maximum\<close>

primrec minimal:: "('a \<Rightarrow> nat) \<Rightarrow> 'a list \<Rightarrow> 'a" where
 "minimal m (x#xs) =
  (if xs=[] then x else
   let mxs = minimal m xs in
   if m x \<le> m mxs then x else mxs)"

lemma minimal_in_set[simp]: "xs \<noteq> [] \<Longrightarrow> minimal f xs : set xs"
by(induct xs) auto

primrec min_list :: "nat list \<Rightarrow> nat" where
  "min_list (x#xs) = (if xs=[] then x else min x (min_list xs))"

primrec max_list :: "nat list \<Rightarrow> nat" where
  "max_list (x#xs) = (if xs=[] then x else max x (max_list xs))"

lemma min_list_conv_Min[simp]:
 "xs \<noteq> [] \<Longrightarrow> min_list xs = Min (set xs)"
by (induct xs) auto

lemma max_list_conv_Max[simp]:
 "xs \<noteq> [] \<Longrightarrow> max_list xs = Max (set xs)"
by (induct xs) auto

subsubsection \<open>replace\<close>

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

primrec mapAt :: "nat list \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> ('a list \<Rightarrow> 'a list)" where
  "mapAt [] f as = as"
| "mapAt (n#ns) f as =
     (if n < |as| then mapAt ns f (as[n:= f (as!n)])
     else mapAt ns f as)"

lemma length_mapAt[simp]: "\<And>xs. length(mapAt vs f xs) = length xs"
by(induct vs) auto

lemma length_replace1[simp]: "length(replace x [y] xs) = length xs"
by(induct xs) simp_all

lemma replace_id[simp]: "replace x [x] xs = xs"
by(induct xs) simp_all

lemma len_replace_ge_same:
"length ys \<ge> 1 \<Longrightarrow> length(replace x ys xs) \<ge> length xs"
by (induct xs) auto

lemma len_replace_ge[simp]:
"\<lbrakk> length ys \<ge> 1; length xs \<ge> length zs \<rbrakk> \<Longrightarrow>
 length(replace x ys xs) \<ge> length zs"
apply(drule len_replace_ge_same[where x = x and xs = xs])
apply arith
done

lemma replace_append[simp]:
  "replace x ys (as @ bs) =
   (if x \<in> set as then replace x ys as @ bs else as @ replace x ys bs)"
by(induct as) auto

lemma distinct_set_replace: "distinct xs \<Longrightarrow>
 set (replace x ys xs) =
 (if x \<in> set xs then (set xs - {x}) \<union> set ys else set xs)"
apply(induct xs)
 apply(simp)
apply simp
apply blast
done

lemma replace1:
 "f \<in> set (replace f' fs ls ) \<Longrightarrow> f \<notin> set ls \<Longrightarrow> f \<in> set fs"
proof (induct ls)
  case Nil then show ?case by simp
next
  case (Cons l ls) then show ?case by (simp split: if_split_asm)
qed

lemma replace2:
 "f' \<notin> set ls \<Longrightarrow> replace f' fs ls  = ls"
proof (induct ls)
  case Nil then show ?case by simp
next
  case (Cons l ls) then show ?case by (auto split: if_split_asm)
qed

lemma replace3[intro]:
  "f' \<in> set ls \<Longrightarrow> f \<in> set fs \<Longrightarrow> f \<in> set (replace f' fs ls)"
by (induct ls) auto

lemma replace4:
  "f \<in> set ls \<Longrightarrow> oldF \<noteq> f \<Longrightarrow> f \<in> set (replace oldF fs ls)"
by (induct ls) auto

lemma replace5: "f \<in> set (replace oldF newfs fs) \<Longrightarrow> f \<in> set fs \<or> f \<in> set newfs"
by (induct fs) (auto split: if_split_asm)

lemma replace6: "distinct oldfs \<Longrightarrow> x \<in> set (replace oldF newfs oldfs) =
  ((x \<noteq> oldF \<or> oldF \<in> set newfs) \<and> ((oldF \<in> set oldfs \<and> x \<in> set newfs) \<or> x \<in> set oldfs))"
by (induct oldfs) auto

lemma distinct_replace:
"distinct fs \<Longrightarrow> distinct newFs \<Longrightarrow> set fs \<inter> set newFs \<subseteq> {oldF} \<Longrightarrow>
 distinct (replace oldF newFs fs)"
proof (induct fs)
  case Nil then show ?case by simp
next
  case (Cons f fs)
  then show ?case
  proof (cases "f = oldF")
    case True with Cons show ?thesis by simp blast
  next
    case False
    moreover with Cons have "f \<notin> set newFs" by simp blast
    with Cons have "f \<notin> set (replace oldF newFs fs)"
     by simp (blast dest: replace1)
    moreover from Cons have "distinct (replace oldF newFs fs)"
      by (rule_tac Cons) auto
    ultimately show ?thesis by simp
  qed
qed

lemma replace_replace[simp]: "oldf \<notin> set newfs \<Longrightarrow> distinct xs \<Longrightarrow>
  replace oldf newfs (replace oldf newfs xs) = replace oldf newfs xs"
apply (induct xs) apply auto apply (rule replace2) by simp

lemma replace_distinct: "distinct fs \<Longrightarrow> distinct newfs \<Longrightarrow> oldf \<in> set fs \<longrightarrow> set newfs \<inter> set fs \<subseteq> {oldf} \<Longrightarrow>
  distinct (replace oldf newfs fs)"
apply (case_tac "oldf \<in> set fs") apply simp
apply (induct fs) apply simp
apply (auto simp: replace2) apply (drule replace1)
by auto

lemma filter_replace2:
 "\<lbrakk> \<not> P x; \<forall>y\<in> set ys. \<not> P y \<rbrakk> \<Longrightarrow>
  filter P (replace x ys xs) = filter P xs"
apply(cases "x \<in> set xs")
 prefer 2 apply(simp add:replace2)
apply(induct xs)
 apply simp
apply clarsimp
done

lemma length_filter_replace1:
 "\<lbrakk> x \<in> set xs; \<not> P x \<rbrakk> \<Longrightarrow>
  length(filter P (replace x ys xs)) =
  length(filter P xs) + length(filter P ys)"
apply(induct xs)
 apply simp
apply fastforce
done

lemma length_filter_replace2:
 "\<lbrakk> x \<in> set xs; P x \<rbrakk> \<Longrightarrow>
  length(filter P (replace x ys xs)) =
  length(filter P xs) + length(filter P ys) - 1"
apply(induct xs)
 apply simp
apply auto
apply(drule split_list)
apply clarsimp
done

subsubsection \<open>@{const"distinct"}\<close>

lemma dist_at: "distinct vs \<Longrightarrow> vs = a @ r # b \<Longrightarrow> vs = c @ r # d \<Longrightarrow> a = c \<and> b = d"
proof -
  assume dist: "distinct vs" and vs1: "vs = a @ r # b" and vs2: "vs = c @ r # d"
  then have "a = c" by (rule_tac dist_at1) auto
  with dist vs1 vs2 show ?thesis by simp
qed

lemma dist_at2: "distinct vs \<Longrightarrow> vs = a @ r # b \<Longrightarrow> vs = c @ r # d \<Longrightarrow> b = d"
proof -
  assume dist: "distinct vs" and vs1: "vs = a @ r # b" and vs2: "vs = c @ r # d"
  then have "a = c \<and> b = d" by (rule_tac dist_at) auto
  then show ?thesis by auto
qed

lemma distinct_split1: "distinct xs \<Longrightarrow> xs = y @ [r] @ z  \<Longrightarrow> r \<notin> set y"
  apply auto done

lemma distinct_split2: "distinct xs \<Longrightarrow> xs = y @ [r] @ z  \<Longrightarrow> r \<notin> set z" apply auto done

lemma distinct_hd_not_cons: "distinct vs \<Longrightarrow> \<exists> as bs. vs = as @ x # hd vs # bs \<Longrightarrow> False"
proof -
  assume d: "distinct vs" and ex: "\<exists> as bs. vs = as @ x # hd vs # bs"
  from ex have vsne: "vs \<noteq> []" by auto
  with d ex show ?thesis apply (elim exE) apply (case_tac "as")
    apply (subgoal_tac "hd vs = x") apply simp apply (rule sym)  apply simp
    apply (subgoal_tac "x = hd (x # (hd vs # bs))") apply simp apply (thin_tac "vs = x # hd vs # bs")
    apply auto
    apply (subgoal_tac "hd vs = a") apply simp
    apply (subgoal_tac "a = hd (a # list @ x # hd vs # bs)") apply simp
    apply (thin_tac "vs = a # list @ x # hd vs # bs") by auto
qed

subsubsection \<open>Misc\<close>

(* FIXME move to List *)
lemma drop_last_in: "\<And>n. n < length ls \<Longrightarrow> last ls \<in> set (drop n ls)"
apply (frule_tac last_drop) apply(erule subst)
apply (case_tac "drop n ls" rule: rev_exhaust) by simp_all

lemma nth_last_Suc_n: "distinct ls \<Longrightarrow> n < length ls \<Longrightarrow> last ls = ls ! n \<Longrightarrow> Suc n = length ls"
proof (rule ccontr)
  assume d: "distinct ls" and n: "n < length ls" and l: "last ls = ls ! n" and not: "Suc n \<noteq> length ls"
  then have s: "Suc n < length ls" by auto
  define lls where  "lls = ls!n"
  with n have "take (Suc n) ls = take n ls @ [lls]" apply simp by (rule take_Suc_conv_app_nth)
  then have "take (Suc n) ls @ drop (Suc n) ls = take n ls @ [lls] @ drop (Suc n) ls" by auto
  then have ls: "ls = take n ls @ [lls] @ drop (Suc n) ls" by auto
  with d have dls: "distinct (take n ls @ [lls] @ drop (Suc n) ls)" by auto
  from lls_def l have "lls = (last ls)" by auto
  with s have "lls \<in> set (drop (Suc n) ls)" apply simp by (rule_tac drop_last_in)
  with dls show False by auto
qed

(****************************** rotate *************************)

subsubsection \<open>@{const rotate}\<close>

lemma  plus_length1[simp]: "rotate (k+(length ls)) ls = rotate k ls "
proof -
  have "\<And> k ls. rotate k (rotate (length ls) ls) = rotate (k+(length ls)) ls"
    by (rule rotate_rotate)
  then have "\<And> k ls. rotate k ls =  rotate (k+(length ls)) ls" by auto
  then show ?thesis by (rule sym)
qed

lemma  plus_length2[simp]: "rotate ((length ls)+k) ls = rotate k ls "
proof -
  define x where "x = (length ls)+k"
  then have "x = k+(length ls)" by auto
  with x_def have "rotate x ls = rotate (k+(length ls)) ls" by simp
  then have "rotate x ls = rotate k ls" by simp
  with x_def show ?thesis by simp
qed

lemma rotate_minus1: "n > 0 \<Longrightarrow> m > 0 \<Longrightarrow>
 rotate n ls = rotate m ms \<Longrightarrow> rotate (n - 1) ls = rotate (m - 1) ms"
proof (cases "ls = []")
  assume r: "rotate n ls = rotate m ms"
  case True with r
  have "rotate m ms = []" by auto
  then have "ms = []" by auto
  with True show ?thesis by auto
next
  assume n: "n > 0" and m: "m > 0" and r: "rotate n ls = rotate m ms"
  case False
  then have lls: "length ls > 0" by auto
  with r have lms: "length ms > 0" by auto
  have mem1: "rotate (n - 1) ls = rotate ((n - 1) + length ls) ls" by auto
  from n lls have "(n - 1) + length ls = (length ls - 1) + n" by arith
  then have "rotate ((n - 1) + length ls) ls = rotate ((length ls - 1) + n) ls" by auto
  with mem1 have mem2: "rotate (n - 1) ls = rotate ((length ls - 1) + n) ls" by auto
  have "rotate ((length ls - 1) + n) ls = rotate (length ls - 1) (rotate n ls)" apply (rule sym)
    by (rule rotate_rotate)
  with mem2 have mem3: "rotate (n - 1) ls = rotate (length ls - 1) (rotate n ls)" by auto
  from r have "rotate (length ls - 1) (rotate n ls) = rotate (length ls - 1) (rotate m ms)" by auto
  with mem3 have mem4: "rotate (n - 1) ls = rotate (length ls - 1) (rotate m ms)" by auto
  have "rotate (length ls - 1) (rotate m ms) = rotate (length ls - 1 + m) ms"  by (rule rotate_rotate)
  with mem4 have mem5: "rotate (n - 1) ls = rotate (length ls - 1 + m) ms" by auto
  from r have "length (rotate n ls) = length (rotate m ms)" by simp
  then have "length ls = length ms" by auto
  with m lms have "length ls - 1 + m = (m - 1) + length ms" by arith
  with mem5 have mem6: "rotate (n - 1) ls = rotate ((m - 1) + length ms) ms" by auto
  have "rotate ((m - 1) + length ms) ms = rotate (m - 1) (rotate (length ms) ms)" by auto
  then have "rotate ((m - 1) + length ms) ms = rotate (m - 1) ms" by auto
  with mem6 show ?thesis by auto
qed

lemma rotate_minus1': "n > 0 \<Longrightarrow> rotate n ls = ms \<Longrightarrow>
  rotate (n - 1) ls = rotate (length ms - 1) ms"
proof (cases "ls = []")
  assume r: "rotate n ls = ms"
  case True with r show ?thesis by auto
next
  assume n: "n > 0" and r:"rotate n ls = ms"
  then have r': "rotate n ls = rotate (length ms) ms" by auto
  case False
  with n r' show ?thesis apply (rule_tac rotate_minus1) by auto
qed

lemma rotate_inv1: "\<And> ms. n < length ls \<Longrightarrow> rotate n ls = ms \<Longrightarrow>
  ls = rotate ((length ls) - n) ms"
proof (induct n)
  case 0 then show ?case by auto
next
  case (Suc n) then show ?case
  proof (cases "ls = []")
    case True with Suc
    show ?thesis by auto
  next
    case False
    then have ll: "length ls > 0" by auto
    from Suc have nl: "n < length ls" by auto
    from Suc have r: "rotate (Suc n) ls = ms" by auto
    then have "rotate (Suc n - 1) ls = rotate (length ms - 1) ms" apply (rule_tac rotate_minus1') by auto
    then have "rotate n ls = rotate (length ms - 1) ms" by auto
    then have mem: "ls = rotate (length ls - n) (rotate (length ms - 1) ms)"
      apply (rule_tac Suc) by (auto simp: nl)
    have " rotate (length ls - n) (rotate (length ms - 1) ms) = rotate (length ls - n + (length ms - 1)) ms"
      by (rule rotate_rotate)
    with mem have mem2: "ls =  rotate (length ls - n + (length ms - 1)) ms" by auto
    from r have leq: "length ms = length ls" by auto
    with False nl have "length ls - n + (length ms - 1) = length ms + (length ms - (Suc n))"
      by arith
    then have "rotate (length ls - n + (length ms - 1)) ms = rotate (length ms + (length ms - (Suc n))) ms"
      by auto
    with mem2 have mem3: "ls = rotate (length ms + (length ms - (Suc n))) ms" by auto
    have "rotate (length ms + (length ms - (Suc n))) ms = rotate (length ms - (Suc n)) ms" by simp
    with mem3 leq show ?thesis by auto
  qed
qed

lemma rotate_conv_mod'[simp]: "rotate (n mod length ls) ls = rotate n ls"
by(simp add:rotate_drop_take)

lemma rotate_inv2: "rotate n ls = ms \<Longrightarrow>
 ls = rotate ((length ls) - (n mod length ls)) ms"
proof (cases "ls  = []")
  assume r: "rotate n ls = ms"
  case True with r show ?thesis by auto
next
  assume r: "rotate n ls = ms"
  then have r': "rotate (n mod length ls) ls = ms" by auto
  case False
  then have "length ls > 0" by auto
  with r' show ?thesis apply (rule_tac rotate_inv1) by auto
qed

lemma rotate_id[simp]: "rotate ((length ls) - (n mod length ls)) (rotate n ls) = ls"
apply (rule sym) apply (rule rotate_inv2) by simp

lemma nth_rotate1_Suc: "Suc n < length ls \<Longrightarrow> ls!(Suc n) = (rotate1 ls)!n"
  apply (cases ls) apply auto
  by (simp add: nth_append)

lemma nth_rotate1_0: "ls!0 = (rotate1 ls)!(length ls - 1)" apply (cases ls)  by auto

lemma nth_rotate1: "0 < length ls \<Longrightarrow> ls!((Suc n) mod (length ls)) = (rotate1 ls)!(n mod (length ls))"
proof (cases "0 < (Suc n) mod (length ls)")
  assume lls: "0 < length ls"
  case True
  define m where "m = (Suc n) mod (length ls) - 1"
  with True have m: "Suc m = (Suc n) mod (length ls)" by auto
  with lls have a: "(Suc m) <   length ls" by auto
  from lls m have "m = n mod (length ls)" by (simp add: mod_Suc split:if_split_asm)
  with a m show ?thesis apply (drule_tac nth_rotate1_Suc) by auto
next
  assume lls: "0 < length ls"
  case False
  then have a: "(Suc n) mod (length ls) = 0" by auto
  with lls have "Suc (n mod (length ls)) = (length ls)" by (auto simp: mod_Suc split: if_split_asm)
  then have "(n mod (length ls)) = (length ls) - 1" by arith
  with a show ?thesis by (auto simp: nth_rotate1_0)
qed

lemma rotate_Suc2[simp]: "rotate n (rotate1 xs) = rotate (Suc n) xs"
apply (simp add:rotate_def) apply (induct n) by auto

lemma nth_rotate: "\<And> ls. 0 < length ls \<Longrightarrow> ls!((n+m) mod (length ls)) = (rotate m ls)!(n mod (length ls))"
proof (induct m)
  case 0 then show ?case by auto
next
  case (Suc m)
  define z where "z = n + m"
  then have "n + Suc m = Suc (z)" by auto
  with Suc have r1: "ls ! ((Suc z) mod length ls) = rotate1 ls ! (z mod length ls)"
    by (rule_tac nth_rotate1)
  from Suc have "0 < length (rotate1 ls)" by auto
  then have "(rotate1 ls) ! ((n + m) mod length (rotate1 ls))
    = rotate m (rotate1 ls) ! (n mod length (rotate1 ls))" by (rule Suc)
  with r1 z_def have "ls ! ((n + Suc m) mod length ls)
    = rotate m (rotate1 ls) ! (n mod length (rotate1 ls))" by auto
  then show ?case by auto
qed

(************************* SplitAt *******************************************)

subsection \<open>\<open>splitAt\<close>\<close>

primrec splitAtRec :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> 'a list \<times> 'a list" where
  "splitAtRec c bs [] = (bs,[])"
| "splitAtRec c bs (a#as) = (if a = c then (bs, as)
                              else splitAtRec c (bs@[a]) as)"

definition splitAt :: "'a \<Rightarrow> 'a list \<Rightarrow> 'a list \<times> 'a list" where
  "splitAt c as  \<equiv> splitAtRec c [] as"

subsubsection \<open>@{const splitAtRec}\<close>

lemma splitAtRec_conv: "\<And>bs.
 splitAtRec x bs xs =
 (bs @ takeWhile (\<lambda>y. y\<noteq>x) xs, tl(dropWhile (\<lambda>y. y\<noteq>x) xs))"
by(induct xs) auto

lemma splitAtRec_distinct_fst: "\<And> s. distinct vs \<Longrightarrow> distinct s \<Longrightarrow> (set s) \<inter>  (set vs) = {} \<Longrightarrow> distinct (fst (splitAtRec ram1 s vs))"
by (induct vs) auto

lemma splitAtRec_distinct_snd: "\<And> s. distinct vs \<Longrightarrow> distinct s \<Longrightarrow> (set s) \<inter>  (set vs) = {} \<Longrightarrow> distinct (snd (splitAtRec ram1 s vs))"
by (induct vs) auto

lemma splitAtRec_ram:
  "\<And> us a b. ram \<in> set vs \<Longrightarrow> (a, b) = splitAtRec ram us vs \<Longrightarrow>
  us @ vs = a @ [ram] @ b"
proof (induct vs)
case  Nil then show ?case by simp
next
case (Cons v vs) then show ?case by (auto dest: Cons(1) split: if_split_asm)
qed

lemma splitAtRec_notRam:
 "\<And> us. ram \<notin>  set vs \<Longrightarrow> splitAtRec ram us vs = (us @ vs, [])"
proof (induct vs)
case  Nil then show ?case by simp
next
case (Cons v vs) then show ?case by auto
qed

lemma splitAtRec_distinct: "\<And> s. distinct vs \<Longrightarrow>
  distinct s \<Longrightarrow> (set s) \<inter> (set vs) = {} \<Longrightarrow>
  set (fst (splitAtRec ram s vs)) \<inter> set (snd (splitAtRec ram s vs)) = {}"
by (induct vs) auto

subsubsection \<open>@{const splitAt}\<close>

lemma splitAt_conv:
 "splitAt x xs = (takeWhile (\<lambda>y. y\<noteq>x) xs, tl(dropWhile (\<lambda>y. y\<noteq>x) xs))"
by(simp add: splitAt_def splitAtRec_conv)

lemma splitAt_no_ram[simp]:
  "ram \<notin> set vs \<Longrightarrow> splitAt ram vs = (vs, [])"
  by (auto simp: splitAt_def splitAtRec_notRam)

lemma splitAt_split:
  "ram \<in> set vs \<Longrightarrow> (a,b) = splitAt ram vs \<Longrightarrow> vs = a @ ram # b"
  by (auto simp: splitAt_def dest: splitAtRec_ram)

lemma splitAt_ram:
  "ram \<in> set vs \<Longrightarrow> vs = fst (splitAt ram vs) @ ram # snd (splitAt ram vs)"
 by (rule_tac splitAt_split) auto

lemma fst_splitAt_last:
 "\<lbrakk> xs \<noteq> []; distinct xs \<rbrakk> \<Longrightarrow> fst (splitAt (last xs) xs) = butlast xs"
by(simp add:splitAt_conv takeWhile_not_last)

subsubsection \<open>Sets\<close>

lemma splitAtRec_union:
"\<And> a b s. (a,b) = splitAtRec ram s vs \<Longrightarrow> (set a \<union> set b) - {ram} = (set vs \<union> set s) - {ram}"
  apply (induct vs) by (auto split: if_split_asm)

lemma splitAt_subset_ab:
  "(a,b) = splitAt ram vs \<Longrightarrow> set a \<subseteq> set vs \<and> set b \<subseteq> set vs"
  apply (cases "ram \<in> set vs")
  by (auto dest: splitAt_split simp: splitAt_no_ram)

lemma splitAt_in_fst[dest]: "v \<in> set (fst (splitAt ram vs)) \<Longrightarrow> v \<in> set vs"
proof (cases "ram \<in> set vs")
  assume v: "v \<in> set (fst (splitAt ram vs))"
  define a where "a = fst (splitAt ram vs)"
  with v have vin: "v \<in> set a" by auto
  define b where "b = snd (splitAt ram vs)"
  case True with a_def b_def  have "vs = a @ ram # b" by (auto dest: splitAt_ram)
  with vin show "v \<in> set vs" by auto
next
  assume v: "v \<in> set (fst (splitAt ram vs))"
  case False with v show ?thesis by (auto dest: splitAt_no_ram del: notI)
qed

lemma splitAt_not1:
"v \<notin> set vs \<Longrightarrow> v \<notin> set (fst (splitAt ram vs))" by (auto dest: splitAt_in_fst)

lemma splitAt_in_snd[dest]: "v \<in> set (snd (splitAt ram vs)) \<Longrightarrow> v \<in> set vs"
proof (cases "ram \<in> set vs")
  assume v: "v \<in> set (snd (splitAt ram vs))"
  define a where "a = fst (splitAt ram vs)"
  define b where "b = snd (splitAt ram vs)"
  with v have vin: "v \<in> set b" by auto
  case True with a_def b_def  have "vs = a @ ram # b" by (auto dest: splitAt_ram)
  with vin show "v \<in> set vs" by auto
next
  assume v: "v \<in> set (snd (splitAt ram vs))"
  case False with v show ?thesis by (auto dest: splitAt_no_ram del: notI)
qed

subsubsection \<open>Distinctness\<close>

lemma splitAt_distinct_ab_aux:
 "distinct vs \<Longrightarrow> (a,b) = splitAt ram vs \<Longrightarrow> distinct a \<and> distinct b"
  by (cases "ram \<in> set vs") (auto dest: splitAt_split simp: splitAt_no_ram)

lemma splitAt_distinct_fst_aux[intro]:
 "distinct vs \<Longrightarrow> distinct (fst (splitAt ram vs))"
proof -
  assume d: "distinct vs"
  define b where "b = snd (splitAt ram vs)"
  define a where "a = fst (splitAt ram vs)"
  with b_def have "(a,b) = splitAt ram vs" by auto
  with a_def d show ?thesis  by (auto dest: splitAt_distinct_ab_aux)
qed

lemma splitAt_distinct_snd_aux[intro]:
 "distinct vs \<Longrightarrow> distinct (snd (splitAt ram vs))"
proof -
  assume d: "distinct vs"
  define b where "b = snd (splitAt ram vs)"
  define a where "a = fst (splitAt ram vs)"
  with b_def have "(a,b) = splitAt ram vs" by auto
  with b_def d show ?thesis  by (auto dest: splitAt_distinct_ab_aux)
qed

lemma splitAt_distinct_ab:
  "distinct vs \<Longrightarrow>  (a,b) = splitAt ram vs \<Longrightarrow> set a \<inter> set b = {}"
  apply (cases "ram \<in> set vs") apply (drule_tac splitAt_split)
  by (auto simp: splitAt_no_ram)

lemma splitAt_distinct_fst_snd:
    "distinct vs \<Longrightarrow>  set (fst (splitAt ram vs)) \<inter> set (snd (splitAt ram vs)) = {}"
  by (rule_tac splitAt_distinct_ab) simp_all

lemma splitAt_distinct_ram_fst[intro]:
  "distinct vs \<Longrightarrow> ram \<notin> set (fst (splitAt ram vs))"
  apply (case_tac "ram \<in> set vs") apply (drule_tac splitAt_ram)
  apply (rule distinct_split1) by (force dest: splitAt_in_fst)+
(*  apply (frule splitAt_no_ram) by auto  *)

lemma splitAt_distinct_ram_snd[intro]:
  "distinct vs \<Longrightarrow> ram \<notin> set (snd (splitAt ram vs))"
  apply (case_tac "ram \<in> set vs") apply (drule_tac splitAt_ram)
  apply (rule distinct_split2) by (force dest: splitAt_in_fst)+

lemma splitAt_1[simp]:
  "splitAt ram [] = ([],[])" by (simp add: splitAt_def)

lemma splitAt_2:
  "v \<in> set vs \<Longrightarrow> (a,b) = splitAt ram vs \<Longrightarrow> v \<in> set a \<or> v \<in> set b \<or> v = ram "
apply (cases "ram \<in> set vs")
 by (auto dest: splitAt_split simp: splitAt_no_ram)

lemma splitAt_distinct_fst: "distinct vs \<Longrightarrow> distinct (fst (splitAt ram1 vs))"
by (simp add: splitAt_def splitAtRec_distinct_fst)

lemma splitAt_distinct_a: "distinct vs \<Longrightarrow> (a,b) = splitAt ram vs \<Longrightarrow> distinct a"
by (auto dest: splitAt_distinct_fst pairD)

lemma splitAt_distinct_snd: "distinct vs \<Longrightarrow> distinct (snd (splitAt ram1 vs))"
by (simp add: splitAt_def splitAtRec_distinct_snd)

lemma splitAt_distinct_b: "distinct vs \<Longrightarrow> (a,b) = splitAt ram vs \<Longrightarrow> distinct b"
by (auto dest: splitAt_distinct_snd pairD)

lemma splitAt_distinct: "distinct vs \<Longrightarrow> set (fst (splitAt ram vs)) \<inter> set (snd (splitAt ram vs)) = {}"
by (simp add: splitAt_def splitAtRec_distinct)

lemma splitAt_subset: "(a,b) = splitAt ram vs \<Longrightarrow> (set a \<subseteq> set vs) \<and> (set b \<subseteq> set vs)"
apply (cases "ram \<in> set vs") by (auto dest: splitAt_split simp: splitAt_no_ram)

subsubsection \<open>@{const splitAt} composition\<close>

lemma set_help: "v \<in> set ( as @ bs) \<Longrightarrow> v \<in> set as \<or> v \<in> set bs" by auto

lemma splitAt_elements: "ram1 \<in> set vs \<Longrightarrow> ram2 \<in> set vs \<Longrightarrow> ram2 \<in> set( fst (splitAt ram1 vs)) \<or> ram2 \<in> set [ram1] \<or>  ram2 \<in> set( snd (splitAt ram1 vs))"
proof -
  assume r1: "ram1 \<in> set vs" and r2: "ram2 \<in> set vs"
  then have "ram2 \<in> set( fst (splitAt ram1 vs) @ [ram1]) \<or>  ram2 \<in> set( snd (splitAt ram1 vs))"
  apply (rule_tac set_help)
  apply (drule_tac splitAt_ram) by auto
  then show ?thesis by auto
qed

lemma splitAt_ram3: "ram2 \<notin>  set (fst (splitAt ram1 vs)) \<Longrightarrow>
  ram1 \<in> set vs \<Longrightarrow> ram2 \<in> set vs \<Longrightarrow> ram1 \<noteq> ram2 \<Longrightarrow>
  ram2 \<in> set (snd (splitAt ram1 vs))" by (auto dest: splitAt_elements)

lemma splitAt_dist_ram: "distinct vs \<Longrightarrow>
 vs = a @ ram # b \<Longrightarrow> (a,b) = splitAt ram vs"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram # b"
  from vs have r:"ram \<in> set vs" by auto
  with dist vs have "fst (splitAt ram vs) = a" apply (drule_tac splitAt_ram) by (rule_tac dist_at1)  auto
  then have first:"a = fst (splitAt ram vs)" by   auto
  from r dist have second: "b = snd (splitAt ram vs)" apply (drule_tac splitAt_ram) apply (rule dist_at2) apply simp
    by (auto simp: vs)
  show ?thesis by (auto simp: first second)
qed

lemma distinct_unique1: "distinct vs \<Longrightarrow> ram \<in> set vs \<Longrightarrow> \<exists>!s. vs = (fst s) @ ram # (snd s)"
proof
  assume d: "distinct vs" and r: "ram \<in> set vs"
  define s where "s = splitAt ram vs"
  with r show  "vs = (fst s) @ ram # (snd s)"
    by (auto intro: splitAt_ram)
next
  fix s
  assume d: "distinct vs" and vs1: "vs = fst s @ ram # snd s"
  from d vs1 show "s = splitAt ram vs" apply (drule_tac splitAt_dist_ram) apply simp by simp
qed

lemma splitAt_dist_ram2: "distinct vs \<Longrightarrow> vs = a @ ram1 # b @ ram2 # c \<Longrightarrow>
 (a @ ram1 # b, c) = splitAt ram2 vs"
by (auto intro: splitAt_dist_ram)

lemma splitAt_dist_ram20: "distinct vs \<Longrightarrow> vs = a @ ram1 # b @ ram2 # c \<Longrightarrow>
  c = snd (splitAt ram2 vs)"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
  then show "c = snd (splitAt ram2 vs)" apply (drule_tac splitAt_dist_ram2) by (auto dest: pairD)
qed

lemma splitAt_dist_ram21: "distinct vs \<Longrightarrow> vs = a @ ram1 # b @ ram2 # c \<Longrightarrow> (a, b) = splitAt ram1 (fst (splitAt ram2 vs))"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
  then have "fst (splitAt ram2 vs) = a @ ram1 # b" apply (drule_tac splitAt_dist_ram2) by (auto dest: pairD)
  with dist vs show ?thesis by (rule_tac splitAt_dist_ram) auto
qed

lemma splitAt_dist_ram22: "distinct vs \<Longrightarrow> vs = a @ ram1 # b @ ram2 # c \<Longrightarrow>  (c, []) = splitAt ram1 (snd (splitAt ram2 vs))"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
  then have "snd (splitAt ram2 vs) = c" apply (drule_tac splitAt_dist_ram2) by (auto dest: pairD)
  with dist vs have "splitAt ram1 (snd (splitAt ram2 vs)) = (c, [])" by (auto intro: splitAt_no_ram)
  then show ?thesis by auto
qed

lemma splitAt_dist_ram1: "distinct vs \<Longrightarrow> vs = a @ ram1 # b @ ram2 # c \<Longrightarrow> (a, b @ ram2 # c) = splitAt ram1 vs"
by (auto intro: splitAt_dist_ram)

lemma splitAt_dist_ram10: "distinct vs \<Longrightarrow> vs = a @ ram1 # b @ ram2 # c \<Longrightarrow> a = fst (splitAt ram1 vs)"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
  then show "a = fst (splitAt ram1 vs)" apply (drule_tac splitAt_dist_ram1) by (auto dest: pairD)
qed

lemma splitAt_dist_ram11: "distinct vs \<Longrightarrow> vs = a @ ram1 # b @ ram2 # c \<Longrightarrow> (a, []) = splitAt ram2 (fst (splitAt ram1 vs))"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
  then have "fst (splitAt ram1 vs) = a" apply (drule_tac splitAt_dist_ram1) by (auto dest: pairD)
  with dist vs have "splitAt ram2 (fst (splitAt ram1 vs)) = (a, [])" by (auto intro: splitAt_no_ram)
  then show ?thesis by auto
qed

lemma splitAt_dist_ram12: "distinct vs \<Longrightarrow> vs = a @ ram1 # b @ ram2 # c \<Longrightarrow>  (b, c) = splitAt ram2 (snd (splitAt ram1 vs))"
proof -
  assume dist: "distinct vs" and vs: "vs = a @ ram1 # b @ ram2 # c"
  then have "snd (splitAt ram1 vs) = b @ ram2 # c" apply (drule_tac splitAt_dist_ram1) by (auto dest: pairD)
  with dist vs show ?thesis by (rule_tac splitAt_dist_ram)  auto
qed

lemma splitAt_dist_ram_all:
  "distinct vs \<Longrightarrow> vs = a @ ram1 # b @ ram2 # c
  \<Longrightarrow> (a, b) = splitAt ram1 (fst (splitAt ram2 vs))
  \<and> (c, []) = splitAt ram1 (snd (splitAt ram2 vs))
  \<and> (a, []) = splitAt ram2 (fst (splitAt ram1 vs))
  \<and> (b, c) = splitAt ram2 (snd (splitAt ram1 vs))
  \<and>  c = snd (splitAt ram2 vs)
  \<and>  a = fst (splitAt ram1 vs)"
  apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram21) apply simp apply simp
  apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram22) apply simp apply simp
  apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram11 splitAt_dist_ram22) apply simp apply simp
  apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram12)apply simp apply simp
  apply (rule_tac conjI) apply (rule_tac splitAt_dist_ram20) apply simp apply simp
                            by (rule_tac splitAt_dist_ram10) auto

subsubsection \<open>Mixed\<close>

lemma fst_splitAt_rev:
 "distinct xs \<Longrightarrow> x \<in> set xs \<Longrightarrow>
  fst(splitAt x (rev xs)) = rev(snd(splitAt x xs))"
by(simp add:splitAt_conv takeWhile_neq_rev)

lemma snd_splitAt_rev:
 "distinct xs \<Longrightarrow> x \<in> set xs \<Longrightarrow>
  snd(splitAt x (rev xs)) = rev(fst(splitAt x xs))"
by(simp add:splitAt_conv dropWhile_neq_rev)

lemma splitAt_take[simp]: "distinct ls \<Longrightarrow> i < length ls \<Longrightarrow> fst (splitAt (ls!i) ls) = take i ls"
proof -
  assume d: "distinct ls" and si: "i < length ls"
  then have ls1: "ls = take i ls @ ls!i # drop (Suc i) ls" by (rule_tac id_take_nth_drop)
  from si have "ls!i \<in> set ls" by auto
  then have ls2: "ls = fst (splitAt (ls!i) ls) @ ls!i # snd (splitAt (ls!i) ls)" by (auto dest: splitAt_ram)
  from d ls2 ls1 have "fst (splitAt (ls!i) ls) = take i ls \<and> snd (splitAt (ls!i) ls) = drop (Suc i) ls" by (rule dist_at)
   then show ?thesis by auto
qed

lemma splitAt_drop[simp]: "distinct ls \<Longrightarrow>  i < length ls \<Longrightarrow> snd (splitAt (ls!i) ls) = drop (Suc i) ls"
proof -
  assume d: "distinct ls" and si: "i < length ls"
  then have ls1: "ls = take i ls @ ls!i # drop (Suc i) ls" by (rule_tac id_take_nth_drop)
  from si have "ls!i \<in> set ls" by auto
  then have ls2: "ls = fst (splitAt (ls!i) ls) @ ls!i # snd (splitAt (ls!i) ls)" by (auto dest: splitAt_ram)
  from d ls2 ls1 have "fst (splitAt (ls!i) ls) = take i ls \<and> snd (splitAt (ls!i) ls) = drop (Suc i) ls" by (rule dist_at)
   then show ?thesis by auto
qed

lemma fst_splitAt_upt:
 "j \<le> i \<Longrightarrow> i < k \<Longrightarrow> fst(splitAt i [j..<k]) = [j..<i]"
using splitAt_take[where ls = "[j..<k]" and i="i-j"]
apply (simp del:splitAt_take)
done

lemma snd_splitAt_upt:
 "j \<le> i \<Longrightarrow> i < k \<Longrightarrow> snd(splitAt i [j..<k]) = [i+1..<k]"
using splitAt_drop[where ls = "[j..<k]" and i="i-j"]
by simp

lemma local_help1: "\<And> a vs. vs = c @ r # d \<Longrightarrow> vs = a @ r # b \<Longrightarrow> r \<notin> set a \<Longrightarrow> r \<notin> set b \<Longrightarrow> a = c"
proof (induct c)
  case Nil
  then have ra: "r \<notin> set a" and vs1: "vs = a @ r # b" and vs2: "vs = [] @ r # d"
    by auto
  from vs1 vs2 have "a @ r # b = r # d" by auto
  then have "hd (a @ r # b) = r" by auto
  then have "a \<noteq> [] \<Longrightarrow> hd a = r" by auto
  then have "a \<noteq> [] \<Longrightarrow> r \<in> set a" by (induct a) auto
  with ra have a: "a = []" by auto
  then show ?case by auto
next
  case (Cons x xs) then show ?case by (induct a) auto
qed

lemma local_help': "a @ r # b = c @ r # d \<Longrightarrow> r \<notin> set a \<Longrightarrow> r \<notin> set b \<Longrightarrow> a = c \<and> b = d"
by (rule local_help) auto

lemma splitAt_simp1: "ram \<notin> set a \<Longrightarrow> ram \<notin> set b \<Longrightarrow> fst (splitAt ram (a @ ram # b)) = a "
proof -
  assume ramab: "ram \<notin> set a"  "ram \<notin> set b"
  define vs where "vs = a @ ram # b"
  then have vs: "vs = a @ ram # b" by auto
  then have "ram \<in> set vs" by auto
  then have "vs = fst (splitAt ram vs) @ ram # snd (splitAt ram vs)" by (auto dest: splitAt_ram)
  with  vs ramab show ?thesis apply simp apply (rule_tac sym)  apply (rule_tac local_help1) apply simp
    apply (rule sym) apply assumption by auto
qed

lemma help'''_in: "\<And> xs. ram \<in> set b \<Longrightarrow> fst (splitAtRec ram xs b) = xs @ fst (splitAtRec ram [] b)"
proof (induct b)
case Nil then show ?case by auto
next
case (Cons b bs) show ?case using Cons(2)
  apply (case_tac "b = ram") apply simp
  apply simp
  apply (subgoal_tac "fst (splitAtRec ram (xs @ [b]) bs) = (xs@[b]) @ fst (splitAtRec ram [] bs)") apply simp
  apply (subgoal_tac "fst (splitAtRec ram [b] bs) = [b] @ fst (splitAtRec ram [] bs)") apply simp
  apply (rule Cons) apply force
  apply (rule Cons) by force
qed

lemma help'''_notin: "\<And> xs. ram \<notin>  set b \<Longrightarrow> fst (splitAtRec ram xs b) = xs @ fst (splitAtRec ram [] b)"
proof (induct b)
case Nil then show ?case by auto
next
case (Cons b bs)
then have "ram \<notin> set bs" by auto
then show ?case
  apply (case_tac "b = ram") apply simp
  apply simp
  apply (subgoal_tac "fst (splitAtRec ram (xs @ [b]) bs) = (xs@[b]) @ fst (splitAtRec ram [] bs)") apply simp
  apply (subgoal_tac "fst (splitAtRec ram [b] bs) = [b] @ fst (splitAtRec ram [] bs)") apply simp
  apply (rule Cons) apply simp
  apply (rule Cons) by simp
qed

lemma help''': "fst (splitAtRec ram xs b) = xs @ fst (splitAtRec ram [] b)"
apply (cases "ram \<in> set b")
apply (rule_tac help'''_in) apply simp
apply (rule_tac help'''_notin) apply simp done

lemma splitAt_simpA[simp]: "fst (splitAt ram (ram # b)) = []" by (simp add: splitAt_def)
lemma splitAt_simpB[simp]: "ram \<noteq> a \<Longrightarrow> fst (splitAt ram (a # b)) = a # fst (splitAt ram b)" apply (simp add: splitAt_def)
  apply (subgoal_tac "fst (splitAtRec ram [a] b) = [a] @ fst (splitAtRec ram [] b)") apply simp by (rule help''')
lemma splitAt_simpB'[simp]: "a \<noteq> ram \<Longrightarrow> fst (splitAt ram (a # b)) = a # fst (splitAt ram b)" apply (rule splitAt_simpB) by auto
lemma splitAt_simpC[simp]: "ram \<notin> set a  \<Longrightarrow> fst (splitAt ram (a @ b)) = a @ fst (splitAt ram b)"
apply (induct a) by auto

lemma help'''': "\<And> xs ys. snd (splitAtRec ram xs b) = snd (splitAtRec ram ys b)"
apply (induct b) by auto

lemma splitAt_simpD[simp]: "\<And> a. ram \<noteq> a \<Longrightarrow> snd (splitAt ram (a # b)) = snd (splitAt ram b)" apply (simp add: splitAt_def)
by (rule help'''')
lemma splitAt_simpD'[simp]: "\<And> a. a \<noteq> ram \<Longrightarrow> snd (splitAt ram (a # b)) = snd (splitAt ram b)" apply (rule splitAt_simpD) by auto

lemma splitAt_simpE[simp]: "snd (splitAt ram (ram # b)) = b" by (simp add: splitAt_def)

lemma splitAt_simpF[simp]: "ram \<notin> set a  \<Longrightarrow> snd (splitAt ram (a @ b)) = snd (splitAt ram b) "
apply (induct a) by auto

lemma splitAt_rotate_pair_conv:
  "\<And>xs. \<lbrakk> distinct xs; x \<in> set xs \<rbrakk>
  \<Longrightarrow> snd (splitAt x (rotate n xs)) @ fst (splitAt x (rotate n xs)) =
      snd (splitAt x xs) @ fst (splitAt x xs)"
apply(induct n) apply simp
apply(simp del:rotate_Suc2 add:rotate1_rotate_swap)
apply(case_tac xs) apply clarsimp+
apply(erule disjE) apply simp
apply(drule split_list)
apply clarsimp
done

subsection \<open>\<open>between\<close>\<close>

definition between :: "'a list \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a list" where
 "between vs ram\<^sub>1 ram\<^sub>2 \<equiv>
     let (pre\<^sub>1, post\<^sub>1) = splitAt ram\<^sub>1 vs in
     if ram\<^sub>2 \<in> set post\<^sub>1
     then let (pre\<^sub>2, post\<^sub>2) = splitAt ram\<^sub>2 post\<^sub>1 in pre\<^sub>2
     else let (pre\<^sub>2, post\<^sub>2) = splitAt ram\<^sub>2 pre\<^sub>1 in post\<^sub>1 @ pre\<^sub>2"

lemma inbetween_inset:
 "x \<in> set(between xs a b) \<Longrightarrow> x \<in> set xs"
apply(simp add:between_def split_def split:if_split_asm)
 apply(blast dest:splitAt_in_snd)
apply(blast dest:splitAt_in_snd)
done

lemma notinset_notinbetween:
 "x \<notin> set xs \<Longrightarrow> x \<notin> set(between xs a b)"
by(blast dest:inbetween_inset)

lemma set_between_id:
 "distinct xs \<Longrightarrow> x \<in> set xs \<Longrightarrow>
  set(between xs x x) = set xs - {x}"
apply(drule split_list)
apply (clarsimp simp:between_def split_def Un_commute)
done

lemma split_between:
 "\<lbrakk> distinct vs; r \<in> set vs; v \<in> set vs; u \<in> set(between vs r v) \<rbrakk> \<Longrightarrow>
  between vs r v =
 (if r=u then [] else between vs r u @ [u]) @ between vs u v"
apply(cases  "r = v")
 apply(clarsimp)
 apply(frule split_list[of v])
 apply(clarsimp)
 apply(simp add:between_def split_def split:if_split_asm)
 apply(erule disjE)
  apply(frule split_list[of u])
  apply(clarsimp)
  apply(frule split_list[of u])
  apply(clarsimp)
 apply(clarsimp)
 apply(frule split_list[of r])
apply(clarsimp)
apply(rename_tac as bs)
apply(erule disjE)
 apply(frule split_list[of v])
 apply(clarsimp)
 apply(rename_tac cs ds)
 apply(subgoal_tac "between (cs @ v # ds @ r # bs) r v = bs @ cs")
  prefer 2 apply(simp add:between_def split_def split:if_split_asm)
 apply simp
 apply(erule disjE)
  apply(frule split_list[of u])
  apply(clarsimp simp:between_def split_def split:if_split_asm)
 apply(frule split_list[of u])
 apply(clarsimp simp:between_def split_def split:if_split_asm)
apply(frule split_list[of v])
apply(clarsimp)
apply(rename_tac cs ds)
apply(subgoal_tac "between (as @ r # cs @ v # ds) r v = cs")
 prefer 2 apply(simp add:between_def split_def split:if_split_asm)
apply simp
apply(frule split_list[of u])
apply(clarsimp simp:between_def split_def split:if_split_asm)
done

subsection \<open>Tables\<close>

type_synonym ('a, 'b) table = "('a \<times> 'b) list"

definition isTable :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a list \<Rightarrow> ('a, 'b) table \<Rightarrow> bool" where
  "isTable f vs t \<equiv> \<forall>p. p \<in> set t \<longrightarrow> snd p = f (fst p) \<and> fst p \<in> set vs"

lemma isTable_eq: "isTable E vs ((a,b)#ps) \<Longrightarrow> b = E a"
  by (auto simp add: isTable_def)

lemma isTable_subset:
  "set qs \<subseteq> set ps \<Longrightarrow> isTable E vs ps \<Longrightarrow> isTable E vs qs"
  by (unfold isTable_def) auto

lemma isTable_Cons: "isTable E vs ((a,b)#ps) \<Longrightarrow> isTable E vs ps"
  by (unfold isTable_def) auto

definition removeKey :: "'a \<Rightarrow> ('a \<times> 'b) list \<Rightarrow> ('a \<times> 'b) list" where
"removeKey a ps \<equiv> [p \<leftarrow> ps. a \<noteq> fst p]"

primrec removeKeyList :: "'a list \<Rightarrow> ('a \<times> 'b) list \<Rightarrow> ('a \<times> 'b) list" where
  "removeKeyList [] ps = ps"
| "removeKeyList (w#ws) ps = removeKey w (removeKeyList ws ps)"

lemma removeKey_subset[simp]: "set (removeKey a ps) \<subseteq> set ps"
  by (simp add: removeKey_def)

lemma length_removeKey[simp]: "|removeKey w ps| \<le> |ps|"
  by (simp add: removeKey_def)

lemma length_removeKeyList:
  "length (removeKeyList ws ps) \<le> length ps" (is "?P ws")
proof (induct ws)
    show "?P []" by simp
    fix w ws
    have "length (removeKey w (removeKeyList ws ps))
      \<le> length (removeKeyList ws ps)"
      by (rule length_removeKey)
    also assume "?P ws"
    finally show "?P (w#ws)" by simp
qed

lemma removeKeyList_subset[simp]: "set (removeKeyList ws ps) \<subseteq> set ps"
proof (induct ws)
  case Nil then show ?case by simp
next
  case (Cons w ws) then show ?case
    by (metis dual_order.trans removeKeyList.simps(2) removeKey_subset)
qed

lemma notin_removeKey1: "(a, b) \<notin> set (removeKey a ps)"
  by (induct ps) (auto simp add: removeKey_def)

lemma removeKeyList_eq:
  "removeKeyList as ps = [p \<leftarrow> ps. \<forall>a \<in> set as. a \<noteq> fst p]"
by (induct as) (simp_all add: filter_comm removeKey_def)

lemma removeKey_empty[simp]: "removeKey a [] = []"
  by (simp add: removeKey_def)
lemma removeKeyList_empty[simp]: "removeKeyList ps [] = []"
  by (induct ps) simp_all
lemma removeKeyList_cons[simp]:
  "removeKeyList ws (p#ps)
  = (if fst p \<in> set ws then removeKeyList ws ps else p#(removeKeyList ws ps))"
  by (induct ws) (simp_all split: if_split_asm add: removeKey_def)

end


(*  Title:      HOL/Examples/Induction_Schema.thy
    Author:     Alexander Krauss, TU Muenchen
*)

section \<open>Examples of automatically derived induction rules\<close>

theory Induction_Schema
imports MainRLT
begin

subsection \<open>Some simple induction principles on nat\<close>

lemma nat_standard_induct: (* cf. Nat.thy *)
  "\<lbrakk>P 0; \<And>n. P n \<Longrightarrow> P (Suc n)\<rbrakk> \<Longrightarrow> P x"
by induction_schema (pat_completeness, lexicographic_order)

lemma nat_induct2:
  "\<lbrakk> P 0; P (Suc 0); \<And>k. P k ==> P (Suc k) ==> P (Suc (Suc k)) \<rbrakk>
  \<Longrightarrow> P n"
by induction_schema (pat_completeness, lexicographic_order)

lemma minus_one_induct:
  "\<lbrakk>\<And>n::nat. (n \<noteq> 0 \<Longrightarrow> P (n - 1)) \<Longrightarrow> P n\<rbrakk> \<Longrightarrow> P x"
by induction_schema (pat_completeness, lexicographic_order)

theorem diff_induct: (* cf. Nat.thy *)
  "(!!x. P x 0) ==> (!!y. P 0 (Suc y)) ==>
    (!!x y. P x y ==> P (Suc x) (Suc y)) ==> P m n"
by induction_schema (pat_completeness, lexicographic_order)

lemma list_induct2': (* cf. List.thy *)
  "\<lbrakk> P [] [];
  \<And>x xs. P (x#xs) [];
  \<And>y ys. P [] (y#ys);
   \<And>x xs y ys. P xs ys  \<Longrightarrow> P (x#xs) (y#ys) \<rbrakk>
 \<Longrightarrow> P xs ys"
by induction_schema (pat_completeness, lexicographic_order)

theorem even_odd_induct:
  assumes "R 0"
  assumes "Q 0"
  assumes "\<And>n. Q n \<Longrightarrow> R (Suc n)"
  assumes "\<And>n. R n \<Longrightarrow> Q (Suc n)"
  shows "R n" "Q n"
  using assms
by induction_schema (pat_completeness+, lexicographic_order)

end