(*
   File:      Pi_Transcendental_Polynomial_Library
   Author:    Manuel Eberl, TU München

   Various facts about univariate polynomials and some other things that probably belong in
   the distribution.
*)
section \<open>Preliminary facts\<close>
theory Pi_Transcendental_Polynomial_Library
  imports "HOL-Computational_Algebra.Computational_Algebra"
begin

(* TODO: Move all this *)
lemma Ints_sum: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> \<int>) \<Longrightarrow> sum f A \<in> \<int>"
  by (induction A rule: infinite_finite_induct) auto

lemma Ints_prod: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> \<int>) \<Longrightarrow> prod f A \<in> \<int>"
  by (induction A rule: infinite_finite_induct) auto

lemma sum_in_Rats [intro]: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> \<rat>) \<Longrightarrow> sum f A \<in> \<rat>"
  by (induction A rule: infinite_finite_induct) auto

lemma prod_in_Rats [intro]: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> \<rat>) \<Longrightarrow> prod f A \<in> \<rat>"
  by (induction A rule: infinite_finite_induct) auto

lemma poly_cnj: "cnj (poly p z) = poly (map_poly cnj p) (cnj z)"
  by (simp add: poly_altdef degree_map_poly coeff_map_poly)

lemma poly_cnj_real:
  assumes "\<And>n. poly.coeff p n \<in> \<real>"
  shows   "cnj (poly p z) = poly p (cnj z)"
proof -
  from assms have "map_poly cnj p = p"
    by (intro poly_eqI) (auto simp: coeff_map_poly Reals_cnj_iff)
  with poly_cnj[of p z] show ?thesis by simp
qed

lemma real_poly_cnj_root_iff:
  assumes "\<And>n. poly.coeff p n \<in> \<real>"
  shows   "poly p (cnj z) = 0 \<longleftrightarrow> poly p z = 0"
proof -
  have "poly p (cnj z) = cnj (poly p z)"
    by (simp add: poly_cnj_real assms)
  also have "\<dots> = 0 \<longleftrightarrow> poly p z = 0" by simp
  finally show ?thesis .
qed

lemma coeff_pcompose_linear:
  fixes p :: "'a :: comm_semiring_1 poly"
  shows "coeff (pcompose p [:0, c:]) i = c ^ i * coeff p i"
  by (induction p arbitrary: i) (auto simp: pcompose_pCons coeff_pCons mult_ac split: nat.splits)

lemma coeff_pCons': "poly.coeff (pCons c p) n = (if n = 0 then c else poly.coeff p (n - 1))"
  by transfer'(auto split: nat.splits)

lemma prod_smult: "(\<Prod>x\<in>A. Polynomial.smult (c x) (p x)) = Polynomial.smult (prod c A) (prod p A)"
  by (induction A rule: infinite_finite_induct) (auto simp: mult_ac)

lemma degree_higher_pderiv: "Polynomial.degree ((pderiv ^^ n) p) = Polynomial.degree p - n"
  for p :: "'a::{comm_semiring_1,semiring_no_zero_divisors,semiring_char_0} poly"
  by (induction n) (auto simp: degree_pderiv)

lemma sum_to_poly: "(\<Sum>x\<in>A. [:f x:]) = [:\<Sum>x\<in>A. f x:]"
  by (induction A rule: infinite_finite_induct) auto

lemma diff_to_poly: "[:c:] - [:d:] = [:c - d:]"
  by (simp add: poly_eq_iff mult_ac)

lemma mult_to_poly: "[:c:] * [:d:] = [:c * d:]"
  by (simp add: poly_eq_iff mult_ac)

lemma prod_to_poly: "(\<Prod>x\<in>A. [:f x:]) = [:\<Prod>x\<in>A. f x:]"
  by (induction A rule: infinite_finite_induct) (auto simp: mult_to_poly mult_ac)

lemma coeff_mult_0: "poly.coeff (p * q) 0 = poly.coeff p 0 * poly.coeff q 0"
  by (simp add: coeff_mult)

lemma card_poly_roots_bound:
  fixes p :: "'a::{comm_ring_1,ring_no_zero_divisors} poly"
  assumes "p \<noteq> 0"
  shows   "card {x. poly p x = 0} \<le> degree p"
using assms
proof (induction "degree p" arbitrary: p rule: less_induct)
  case (less p)
  show ?case
  proof (cases "\<exists>x. poly p x = 0")
    case False
    hence "{x. poly p x = 0} = {}" by blast
    thus ?thesis by simp
  next
    case True
    then obtain x where x: "poly p x = 0" by blast
    hence "[:-x, 1:] dvd p" by (subst (asm) poly_eq_0_iff_dvd)
    then obtain q where q: "p = [:-x, 1:] * q" by (auto simp: dvd_def)
    with \<open>p \<noteq> 0\<close> have [simp]: "q \<noteq> 0" by auto
    have deg: "degree p = Suc (degree q)"
      by (subst q, subst degree_mult_eq) auto
    have "card {x. poly p x = 0} \<le> card (insert x {x. poly q x = 0})"
      by (intro card_mono) (auto intro: poly_roots_finite simp: q)
    also have "\<dots> \<le> Suc (card {x. poly q x = 0})"
      by (rule card_insert_le_m1) auto
    also from deg have  "card {x. poly q x = 0} \<le> degree q"
      using \<open>p \<noteq> 0\<close> and q by (intro less) auto
    also have "Suc \<dots> = degree p" by (simp add: deg)
    finally show ?thesis by - simp_all
  qed
qed

lemma poly_eqI_degree:
  fixes p q :: "'a :: {comm_ring_1, ring_no_zero_divisors} poly"
  assumes "\<And>x. x \<in> A \<Longrightarrow> poly p x = poly q x"
  assumes "card A > degree p" "card A > degree q"
  shows   "p = q"
proof (rule ccontr)
  assume neq: "p \<noteq> q"
  have "degree (p - q) \<le> max (degree p) (degree q)"
    by (rule degree_diff_le_max)
  also from assms have "\<dots> < card A" by linarith
  also have "\<dots> \<le> card {x. poly (p - q) x = 0}"
    using neq and assms by (intro card_mono poly_roots_finite) auto
  finally have "degree (p - q) < card {x. poly (p - q) x = 0}" .
  moreover have "degree (p - q) \<ge> card {x. poly (p - q) x = 0}"
    using neq by (intro card_poly_roots_bound) auto
  ultimately show False by linarith
qed

lemma poly_root_order_induct [case_names 0 no_roots root]:
  fixes p :: "'a :: idom poly"
  assumes "P 0" "\<And>p. (\<And>x. poly p x \<noteq> 0) \<Longrightarrow> P p"
          "\<And>p x n. n > 0 \<Longrightarrow> poly p x \<noteq> 0 \<Longrightarrow> P p \<Longrightarrow> P ([:-x, 1:] ^ n * p)"
  shows   "P p"
proof (induction "degree p" arbitrary: p rule: less_induct)
  case (less p)
  consider "p = 0" | "p \<noteq> 0" "\<exists>x. poly p x = 0" | "\<And>x. poly p x \<noteq> 0" by blast
  thus ?case
  proof cases
    case 3
    with assms(2)[of p] show ?thesis by simp
  next
    case 2
    then obtain x where x: "poly p x = 0" by auto
    have "[:-x, 1:] ^ order x p dvd p" by (intro order_1)
    then obtain q where q: "p = [:-x, 1:] ^ order x p * q" by (auto simp: dvd_def)
    with 2 have [simp]: "q \<noteq> 0" by auto
    have order_pos: "order x p > 0"
      using \<open>p \<noteq> 0\<close> and x by (auto simp: order_root)
    have "order x p = order x p + order x q"
      by (subst q, subst order_mult) (auto simp: order_power_n_n)
    hence [simp]: "order x q = 0" by simp
    have deg: "degree p = order x p + degree q"
      by (subst q, subst degree_mult_eq) (auto simp: degree_power_eq)
    with order_pos have "degree q < degree p" by simp
    hence "P q" by (rule less)
    with order_pos have "P ([:-x, 1:] ^ order x p * q)"
      by (intro assms(3)) (auto simp: order_root)
    with q show ?thesis by simp
  qed (simp_all add: assms(1))
qed

lemma complex_poly_decompose:
  "smult (lead_coeff p) (\<Prod>z|poly p z = 0. [:-z, 1:] ^ order z p) = (p :: complex poly)"
proof (induction p rule: poly_root_order_induct)
  case (no_roots p)
  show ?case
  proof (cases "degree p = 0")
    case False
    hence "\<not>constant (poly p)" by (subst constant_degree)
    with fundamental_theorem_of_algebra and no_roots show ?thesis by blast
  qed (auto elim!: degree_eq_zeroE)
next
  case (root p x n)
  from root have *: "{z. poly ([:- x, 1:] ^ n * p) z = 0} = insert x {z. poly p z = 0}"
    by auto
  have "smult (lead_coeff ([:-x, 1:] ^ n * p))
           (\<Prod>z|poly ([:-x,1:] ^ n * p) z = 0. [:-z, 1:] ^ order z ([:- x, 1:] ^ n * p)) =
        [:- x, 1:] ^ order x ([:- x, 1:] ^ n * p) *
          smult (lead_coeff p) (\<Prod>z\<in>{z. poly p z = 0}. [:- z, 1:] ^ order z ([:- x, 1:] ^ n * p))"
    by (subst *, subst prod.insert)
       (insert root, auto intro: poly_roots_finite simp: mult_ac lead_coeff_mult lead_coeff_power)
  also have "order x ([:- x, 1:] ^ n * p) = n"
    using root by (subst order_mult) (auto simp: order_power_n_n order_0I)
  also have "(\<Prod>z\<in>{z. poly p z = 0}. [:- z, 1:] ^ order z ([:- x, 1:] ^ n * p)) =
               (\<Prod>z\<in>{z. poly p z = 0}. [:- z, 1:] ^ order z p)"
  proof (intro prod.cong refl, goal_cases)
    case (1 y)
    with root have "order y ([:-x,1:] ^ n) = 0" by (intro order_0I) auto
    thus ?case using root by (subst order_mult) auto
  qed
  also note root.IH
  finally show ?case .
qed simp_all

lemma order_pos_iff: "p \<noteq> 0 \<Longrightarrow> order a p > 0 \<longleftrightarrow> poly p a = 0"
  using order_root[of p a] by auto

lift_definition poly_roots_mset :: "('a :: idom) poly \<Rightarrow> 'a multiset" is
  "\<lambda>p x. if p = 0 then 0 else Polynomial.order x p"
proof -
  fix p :: "'a poly"
  show "(\<lambda>x. if p = 0 then 0 else order x p) \<in> multiset"
    by (cases "p = 0")
       (auto simp: multiset_def order_pos_iff intro: finite_subset[OF _ poly_roots_finite[of p]])
qed

lemma poly_roots_mset_0 [simp]: "poly_roots_mset 0 = {#}"
  by transfer' auto

lemma count_poly_roots_mset [simp]:
  "p \<noteq> 0 \<Longrightarrow> count (poly_roots_mset p) a = order a p"
  by transfer' auto

lemma set_count_poly_roots_mset [simp]:
   "p \<noteq> 0 \<Longrightarrow> set_mset (poly_roots_mset p) = {x. poly p x = 0}"
  by (auto simp: set_mset_def order_pos_iff)

lemma image_prod_mset_multiplicity:
  "prod_mset (image_mset f M) = prod (\<lambda>x. f x ^ count M x) (set_mset M)"
proof (induction M)
  case (add x M)
  show ?case
  proof (cases "x \<in> set_mset M")
    case True
    have "(\<Prod>y\<in>set_mset (add_mset x M). f y ^ count (add_mset x M) y) =
            (\<Prod>y\<in>set_mset M. (if y = x then f x else 1) * f y ^ count M y)"
      using True add by (intro prod.cong) auto
    also have "\<dots> = f x * (\<Prod>y\<in>set_mset M. f y ^ count M y)"
      using True by (subst prod.distrib) auto
    also note add.IH [symmetric]
    finally show ?thesis using True by simp
  next
    case False
    hence "(\<Prod>y\<in>set_mset (add_mset x M). f y ^ count (add_mset x M) y) =
              f x * (\<Prod>y\<in>set_mset M. f y ^ count (add_mset x M) y)"
      by (auto simp: not_in_iff)
    also have "(\<Prod>y\<in>set_mset M. f y ^ count (add_mset x M) y) =
                 (\<Prod>y\<in>set_mset M. f y ^ count M y)"
      using False by (intro prod.cong) auto
    also note add.IH [symmetric]
    finally show ?thesis by simp
  qed
qed auto

lemma complex_poly_decompose_multiset:
  "smult (lead_coeff p) (\<Prod>x\<in>#poly_roots_mset p. [:-x, 1:]) = (p :: complex poly)"
proof (cases "p = 0")
  case False
  hence "(\<Prod>x\<in>#poly_roots_mset p. [:-x, 1:]) = (\<Prod>x | poly p x = 0. [:-x, 1:] ^ order x p)"
    by (subst image_prod_mset_multiplicity) simp_all
  also have "smult (lead_coeff p) \<dots> = p"
    by (rule complex_poly_decompose)
  finally show ?thesis .
qed auto

lemma (in monoid_add) prod_list_prod_nth:
  "prod_list xs = (\<Prod>i=0..<length xs. xs ! i)"
proof -
  have "xs = map (\<lambda>i. xs ! i) [0..<length xs]"
    by (simp add: map_nth)
  also have "prod_list \<dots> = (\<Prod>i=0..<length xs. xs ! i)"
    by (subst prod.distinct_set_conv_list [symmetric]) auto
  finally show ?thesis .
qed

lemma prod_zero_iff': "finite A \<Longrightarrow> prod f A = 0 \<longleftrightarrow> (\<exists>x\<in>A. f x = 0)"
  for f :: "'a \<Rightarrow> 'b :: {comm_semiring_1, semiring_no_zero_divisors}"
  by (induction A rule: infinite_finite_induct) auto

lemma degree_prod_eq: "(\<And>x. x \<in> A \<Longrightarrow> f x \<noteq> 0) \<Longrightarrow> degree (prod f A) = (\<Sum>x\<in>A. degree (f x))"
  for f :: "'a \<Rightarrow> 'b::{comm_semiring_1, semiring_no_zero_divisors} poly"
  by (induction A rule: infinite_finite_induct) (auto simp: degree_mult_eq prod_zero_iff')

lemma lead_coeff_prod: "(\<And>x. x \<in> A \<Longrightarrow> f x \<noteq> 0) \<Longrightarrow> lead_coeff (prod f A) = (\<Prod>x\<in>A. lead_coeff (f x))"
  for f :: "'a \<Rightarrow> 'b :: {comm_semiring_1, semiring_no_zero_divisors} poly"
  by (induction A rule: infinite_finite_induct) (auto simp: lead_coeff_mult prod_zero_iff')

lemma complex_poly_decompose':
  obtains root where "smult (lead_coeff p) (\<Prod>i<degree p. [:-root i, 1:]) = (p :: complex poly)"
proof -
  obtain roots where roots: "mset roots = poly_roots_mset p"
    using ex_mset by blast

  have "p = smult (lead_coeff p) (\<Prod>x\<in>#poly_roots_mset p. [:-x, 1:])"
    by (rule complex_poly_decompose_multiset [symmetric])
  also have "(\<Prod>x\<in>#poly_roots_mset p. [:-x, 1:]) = (\<Prod>x\<leftarrow>roots. [:-x, 1:])"
    by (subst prod_mset_prod_list [symmetric]) (simp add: roots)
  also have "\<dots> = (\<Prod>i<length roots. [:-roots ! i, 1:])"
    by (subst prod_list_prod_nth) (auto simp: atLeast0LessThan)
  finally have eq: "p = smult (lead_coeff p) (\<Prod>i<length roots. [:-roots ! i, 1:])" .
  also have [simp]: "degree p = length roots"
    using roots by (subst eq) (auto simp: degree_prod_eq)
  finally show ?thesis by (intro that[of "\<lambda>i. roots ! i"]) auto
qed

lemma rsquarefree_root_order:
  assumes "rsquarefree p" "poly p z = 0" "p \<noteq> 0"
  shows   "order z p = 1"
proof -
  from assms have "order z p \<in> {0, 1}" by (auto simp: rsquarefree_def)
  moreover from assms have "order z p > 0" by (auto simp: order_root)
  ultimately show "order z p = 1" by auto
qed

lemma complex_poly_decompose_rsquarefree:
  assumes "rsquarefree p"
  shows   "smult (lead_coeff p) (\<Prod>z|poly p z = 0. [:-z, 1:]) = (p :: complex poly)"
proof (cases "p = 0")
  case False
  have "(\<Prod>z|poly p z = 0. [:-z, 1:]) = (\<Prod>z|poly p z = 0. [:-z, 1:] ^ order z p)"
    using assms False by (intro prod.cong) (auto simp: rsquarefree_root_order)
  also have "smult (lead_coeff p) \<dots> = p"
    by (rule complex_poly_decompose)
  finally show ?thesis .
qed auto

lemma pcompose_conjugates_integer:
  assumes "\<And>i. poly.coeff p i \<in> \<int>"
  shows   "poly.coeff (pcompose p [:0, \<i>:] * pcompose p [:0, -\<i>:]) i \<in> \<int>"
proof -
  let ?c = "\<lambda>i. poly.coeff p i :: complex"
  have "poly.coeff (pcompose p [:0, \<i>:] * pcompose p [:0, -\<i>:]) i =
          \<i> ^ i * (\<Sum>k\<le>i. (-1) ^ (i - k) * ?c k * ?c (i - k))"
    unfolding coeff_mult sum_distrib_left
    by (intro sum.cong) (auto simp: coeff_mult coeff_pcompose_linear power_minus'
                                    power_diff field_simps intro!: Ints_sum)
  also have "(\<Sum>k\<le>i. (-1) ^ (i - k) * ?c k * ?c (i - k)) =
          (\<Sum>k\<le>i. (-1) ^ k * ?c k * ?c (i - k))" (is "?S1 = ?S2")
    by (intro sum.reindex_bij_witness[of _ "\<lambda>k. i - k" "\<lambda>k. i - k"]) (auto simp: mult_ac)
  hence "?S1 = (?S1 + ?S2) / 2" by simp
  also have "\<dots> = (\<Sum>k\<le>i. ((-1) ^ k + (-1) ^ (i - k)) / 2 * ?c k * ?c (i - k))"
    by (simp add: ring_distribs sum.distrib sum_divide_distrib [symmetric])
  also have "\<dots> = (\<Sum>k\<le>i. (1 + (-1) ^ i) / 2 * (-1) ^ k * ?c k * ?c (i - k))"
    by (intro sum.cong) (auto simp: power_add power_diff field_simps)
  also have "\<i> ^ i * \<dots> \<in> \<int>"
  proof (cases "even i")
    case True
    thus ?thesis
      by (intro Ints_mult Ints_sum assms) (auto elim!: evenE simp: power_mult)
  next
    case False
    hence "1 + (-1) ^ i = (0 :: complex)" by (auto elim!: oddE simp: power_mult)
    thus ?thesis by simp
  qed
  finally show ?thesis .
qed

lemma algebraic_times_i:
  assumes "algebraic x"
  shows   "algebraic (\<i> * x)" "algebraic (-\<i> * x)"
proof -
  from assms obtain p where p: "poly p x = 0" "\<forall>i. coeff p i \<in> \<int>" "p \<noteq> 0"
    by (auto elim!: algebraicE)
  define p' where "p' = pcompose p [:0, \<i>:] * pcompose p [:0, -\<i>:]"
  have p': "poly p' (\<i> * x) = 0" "poly p' (-\<i> * x) = 0" "p' \<noteq> 0"
    by (auto simp: p'_def poly_pcompose algebra_simps p dest: pcompose_eq_0)
  moreover have "\<forall>i. poly.coeff p' i \<in> \<int>"
    using p unfolding p'_def by (intro allI pcompose_conjugates_integer) auto
  ultimately show "algebraic (\<i> * x)" "algebraic (-\<i> * x)" by (intro algebraicI[of p']; simp)+
qed

lemma algebraic_times_i_iff: "algebraic (\<i> * x) \<longleftrightarrow> algebraic x"
  using algebraic_times_i[of x] algebraic_times_i[of "\<i> * x"] by auto

lemma ratpolyE:
  assumes "\<forall>i. poly.coeff p i \<in> \<rat>"
  obtains q where "p = map_poly of_rat q"
proof -
  have "\<forall>i\<in>{..Polynomial.degree p}. \<exists>x. poly.coeff p i = of_rat x"
    using assms by (auto simp: Rats_def)
  from bchoice[OF this] obtain f
    where f: "\<And>i. i \<le> Polynomial.degree p \<Longrightarrow> poly.coeff p i = of_rat (f i)" by blast
  define q where "q = Poly (map f [0..<Suc (Polynomial.degree p)])"
  have "p = map_poly of_rat q"
    by (intro poly_eqI)
       (auto simp: coeff_map_poly q_def nth_default_def f coeff_eq_0 simp del: upt_Suc)
  with that show ?thesis by blast
qed

end


theory Safe_ChloeSunter180273436
    imports VDMToolkit
begin

(*-----------------------------------------------------------------------*)

section \<open> VDM values - part 1 \<close>

abbreviation
  MAX_WHEELS :: VDMNat1 where "MAX_WHEELS \<equiv> 4"
definition
  inv_MAX_WHEELS :: "\<bool>"
  where
  "inv_MAX_WHEELS \<equiv> inv_VDMNat1 MAX_WHEELS"

abbreviation
  MAX_SPOKES :: VDMNat1 where "MAX_SPOKES \<equiv> 16"
definition
  inv_MAX_SPOKES :: "\<bool>"
  where
  "inv_MAX_SPOKES \<equiv> inv_VDMNat1 MAX_SPOKES"

abbreviation
  MAX_RINGS :: VDMNat1 where "MAX_RINGS \<equiv> (MAX_WHEELS * 2) - 1"
definition
  inv_MAX_RINGS :: "\<bool>"
  where
  "inv_MAX_RINGS \<equiv> inv_VDMNat1 MAX_RINGS"

abbreviation
  SECRET_SUM :: VDMNat1 where "SECRET_SUM \<equiv> 40"
definition
  inv_SECRET_SUM :: "\<bool>"
  where
  "inv_SECRET_SUM \<equiv> inv_VDMNat1 SECRET_SUM"

(*-----------------------------------------------------------------------*)

section \<open> VDM types \<close>

type_synonym Value = "VDMNat"
definition
  inv_Value :: "VDMNat \<Rightarrow> \<bool>"
  where
  "inv_Value v \<equiv> inv_VDMNat v \<and> v \<le> SECRET_SUM - (MAX_WHEELS - 1)"
value "inv_Value 0"  (* true  *)
value "inv_Value 1"  (* true  *)
value "inv_Value 36" (* true  *)
value "inv_Value 37" (* true  *)
value "inv_Value 38" (* false *)
value "inv_Value 40" (* false *)

type_synonym Ring = "Value VDMSeq"
definition
  inv_Ring :: "(Value VDMSeq) \<Rightarrow> \<bool>"
  where
  "inv_Ring r \<equiv> inv_SeqElems inv_Value r \<and> len r \<le> MAX_SPOKES"
value "inv_Ring []"                                           (* true  *)
value "inv_Ring [1,2,3]"                                      (* true  *)
value "inv_Ring [1,2,3,37]"                                   (* true  *)
value "inv_Ring [1,2,3,38]"                                   (* false *)
value "inv_Ring [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16]"     (* true  *)
value "inv_Ring [1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,16,17]"  (* false *)

type_synonym Spoke = "Value VDMSeq"
definition
  inv_Spoke :: "(Value VDMSeq) \<Rightarrow> \<bool>"
  where
  "inv_Spoke s \<equiv> inv_SeqElems inv_Value s \<and> len s = MAX_WHEELS"
value "inv_Spoke []"           (* false *)
value "inv_Spoke [1,2,3]"      (* false *)
value "inv_Spoke [1,2,3,37]"   (* true  *)
value "inv_Spoke [1,2,3,38]"   (* false *)
value "inv_Spoke [1,2,3,4]"    (* true  *)
value "inv_Spoke [1,2,3,4,5]"  (* false *)

type_synonym Spokes = "Spoke VDMSeq"
definition
  inv_Spokes :: "(Spoke VDMSeq) \<Rightarrow> \<bool>"
  where
  "inv_Spokes ss \<equiv> inv_SeqElems inv_Spoke ss \<and> len ss \<le> MAX_SPOKES"
value "inv_Spokes []"                              (* true  *)
value "inv_Spokes [[1,2,3]]"                       (* false *)
value "inv_Spokes [[1,2,3,4]]"                     (* true  *)
value "inv_Spokes [[1,2,3,37]]"                    (* true  *)
value "inv_Spokes [[1,2,3,38]]"                    (* false *)
value "inv_Spokes [[1,2,3,4],[1,2,3,4],[1,2,3,4]]" (* true  *)

type_synonym Wheel = "Ring VDMSeq"
definition
  inv_Wheel :: "(Ring VDMSeq) \<Rightarrow> \<bool>"
  where
  "inv_Wheel w \<equiv> inv_SeqElems inv_Ring w \<and> len w \<le> 2"
value "inv_Wheel []"                        (* true  *)
value "inv_Wheel [[1,2,3]]"                 (* true  *)
value "inv_Wheel [[1,2,3],[1,2,3]]"         (* true  *)
value "inv_Wheel [[1,2,3],[1,2,3],[1,2,3]]" (* false *)

type_synonym Safe = "Wheel VDMSeq"
definition
  inv_Safe :: "(Wheel VDMSeq) \<Rightarrow> \<bool>"
  where
  "inv_Safe s \<equiv> inv_SeqElems inv_Wheel s \<and> len s \<le> MAX_WHEELS"
value "inv_Safe []"                                                  (* true  *)
value "inv_Safe [[[1,2,3]]]"                                         (* true  *)
value "inv_Safe [[[1,2,3]],[[1,2,3]]]"                               (* true  *)
value "inv_Safe [[[1,2,3]],[[1,2,3]],[[1,2,3]]]"                     (* true  *)
value "inv_Safe [[[1,2,3]],[[1,2,3]],[[1,2,3]],[[1,2,3]]]"           (* true  *)
value "inv_Safe [[[1,2,3]],[[1,2,3]],[[1,2,3]],[[1,2,3]],[[1,2,3]]]" (* false *)

type_synonym OverlaySafe = "Ring VDMSeq"
definition
  inv_OverlaySafe :: "(Ring VDMSeq) \<Rightarrow> \<bool>"
  where
  "inv_OverlaySafe os \<equiv> inv_SeqElems inv_Ring os \<and> len os \<le> MAX_WHEELS"
value "inv_OverlaySafe []"                                        (* true  *)
value "inv_OverlaySafe [[1,2,3]]"                                 (* true  *)
value "inv_OverlaySafe [[1,2,3],[1,2,3]]"                         (* true  *)
value "inv_OverlaySafe [[1,2,3],[1,2,3],[1,2,3]]"                 (* true  *)
value "inv_OverlaySafe [[1,2,3],[1,2,3],[1,2,3],[1,2,3]]"         (* true  *)
value "inv_OverlaySafe [[1,2,3],[1,2,3],[1,2,3],[1,2,3],[1,2,3]]" (* false *)

(*-----------------------------------------------------------------------*)

section \<open> VDM values - part 2 \<close>

abbreviation
  R1 :: Ring where "R1 \<equiv> [27,11,20,27,3,2,3,19,23,2,10,15,13,10,19,10]"
abbreviation
  R2 :: Ring where "R2 \<equiv> [5,9,10,2,6,1,27,10,10,6,6,9,3,3,8,3]"
abbreviation
  R3 :: Ring where "R3 \<equiv> [10,0,2,0,12,0,17,0,16,0,9,0,9,0,15,0]"
abbreviation
  R4 :: Ring where "R4 \<equiv> [10,17,5,19,4,3,15,13,17,10,2,20,15,6,2,10]"
abbreviation
  R5 :: Ring where "R5 \<equiv> [1,0,22,0,6,0,24,0,24,0,7,0,5,0,27,0]"
abbreviation
  R6 :: Ring where "R6 \<equiv> [10,1,10,12,10,10,3,17,3,10,13,1,6,8,10,24]"
abbreviation
  R7 :: Ring where "R7 \<equiv> [5,0,4,0,6,0,6,0,10,0,1,0,6,0,4,0]"

(*-----------------------------------------------------------------------*)

section \<open> VDM functions \<close>

    (*-----------------------------------------------------------------------*)

    subsection \<open> VDM sum_values \<close>

    fun
      sum_values :: "(Value VDMSeq) \<Rightarrow> VDMNat"
    where
       sum_values0 [intro!]: "sum_values [] = 0"
    |  sum_values1 [intro!]: "sum_values (x # xs) = x + (sum_values xs)"

    definition
      pre_sum_values :: "(Value VDMSeq) \<Rightarrow> \<bool>"
    where
      "pre_sum_values s \<equiv> inv_SeqElems inv_Value s"

    definition
      post_sum_values :: "(Value VDMSeq) \<Rightarrow> VDMNat \<Rightarrow> \<bool>"
    where
      "post_sum_values s RESULT \<equiv> pre_sum_values s \<longrightarrow> (inv_VDMNat RESULT)"

    definition
      sum_values_sat_obl :: "\<bool>"
    where
      "sum_values_sat_obl \<equiv> \<forall> s . inv_SeqElems inv_Value s \<longrightarrow>
          pre_sum_values s \<longrightarrow> (\<exists> r . post_sum_values s r)"

    (* lemma l_sum_values_nat:
      "inv_SeqElems inv_Value s \<Longrightarrow> 0 \<le> sum_values s"
      unfolding inv_SeqElems_def
      apply (induct s, simp_all)
      using l_inv_Value_nat1 by fastforce

    lemma l_pre_sum_values:
      "inv_SeqElems inv_Value s \<Longrightarrow> 0 < sum_values s \<longleftrightarrow> s \<noteq> []"
      using l_sum_values_nat1
      by auto

    theorem sum_values_sat_obl
      unfolding sum_values_sat_obl_def post_sum_values_def pre_sum_values_def
      apply safe
      apply (rule_tac x="sum_values s" in exI)
      apply safe
        apply (simp add: l_sum_values_nat inv_VDMNat_def)
      by (simp add: l_pre_sum_values)+
    *)

    (*-----------------------------------------------------------------------*)

    subsection \<open> VDM initial_safe \<close>

    definition
      initial_safe :: "Safe"
    where
      "initial_safe \<equiv> [[R1,R2],[R3,R4],[R5,R6],[R7]]"

    (*-----------------------------------------------------------------------*)

    subsection \<open> VDM initial_combinations \<close>

    definition
      initial_combinations :: "OverlaySafe"
    where
      "initial_combinations \<equiv> [[],[],[],[]]"

(*-----------------------------------------------------------------------*)

section \<open> VDM state \<close>

record State =
  safe:: "Safe"
	sum:: "Value"
	combination:: "OverlaySafe"
	successes:: "OverlaySafe VDMSet"
	temp:: "Value"

definition
  inv_State_flat :: "Safe \<Rightarrow> Value \<Rightarrow> OverlaySafe \<Rightarrow> (OverlaySafe VDMSet) \<Rightarrow> Value \<Rightarrow> \<bool>"
where
  "inv_State_flat sa su co suc te \<equiv>
    inv_Safe sa \<and>
    inv_Value su \<and>
    inv_OverlaySafe co \<and>
    inv_SetElems inv_OverlaySafe suc \<and>
    inv_Value te \<and>
    su \<le> SECRET_SUM \<and>
    (len sa) \<le> MAX_WHEELS \<and>
    (len co) \<le> MAX_WHEELS \<and>
    (card suc) \<ge>  0"

definition
  inv_State :: "State \<Rightarrow> \<bool>"
where
  "inv_State st \<equiv> inv_State_flat (safe st) (sum st) (combination st) (successes st) (temp st)"

definition
  init_State :: "State"
where
  "init_State \<equiv> \<lparr> safe = [], sum = 0, combination = [], successes = {}, temp = 0 \<rparr>"

definition
  state_init_sat_obl :: "\<bool>"
where
  "state_init_sat_obl \<equiv> inv_State init_State"

theorem state_init_sat_obl
  unfolding  state_init_sat_obl_def inv_State_def init_State_def inv_State_flat_def
  apply safe
  unfolding inv_Value_def inv_VDMNat_def inv_Safe_def inv_OverlaySafe_def
  apply auto
done

(*-----------------------------------------------------------------------*)

section \<open> VDM operations \<close>

    (*-----------------------------------------------------------------------*)

    subsection \<open> VDM resetSafe \<close>

    definition
      pre_resetSafe :: "State \<Rightarrow> \<bool>"
    where
      "pre_resetSafe bst \<equiv> inv_State bst"

    definition
      post_resetSafe ::  "State \<Rightarrow> State \<Rightarrow> \<bool>"
    where
      "post_resetSafe bst ast \<equiv>
         pre_resetSafe bst \<longrightarrow>
         inv_State ast \<and>
         (safe bst) \<noteq> (safe ast)"

    definition
      resetSafe :: "State \<Rightarrow> State"
    where
      "resetSafe bst \<equiv>
        let s' = initial_safe bst
          in (bst(safe := s'))"

    (*-----------------------------------------------------------------------*)

    subsection \<open> VDM resetOverlaySafe \<close>

    definition
      pre_resetOverlaySafe :: "State \<Rightarrow> \<bool>"
    where
      "pre_resetOverlaySafe bst \<equiv> inv_State bst"

    definition
      post_resetOverlaySafe ::  "State \<Rightarrow> State \<Rightarrow> \<bool>"
    where
      "post_resetOverlaySafe bst ast \<equiv>
         (len (combination ast) = MAX_WHEELS)"

    definition
      resetOverlaySafe :: "State \<Rightarrow> State"
    where
      "resetOverlaySafe bst \<equiv> bst(combination := initial_combinations())"

    (*-----------------------------------------------------------------------*)

    subsection \<open> VDM sortOverlay \<close>

    definition
      pre_sortOverlay :: "State \<Rightarrow> \<bool>"
    where
      "pre_sortOverlay bst \<equiv> inv_State bst \<and> (len (safe bst) = MAX_WHEELS)"

    definition
      post_sortOverlay ::  "State \<Rightarrow> State \<Rightarrow> \<bool>"
    where
      "post_sortOverlay bst ast \<equiv>
         inv_State ast \<and>
         (safe bst) = (safe ast) \<and>
         (combination bst) \<noteq> (combination ast)"

    (*-----------------------------------------------------------------------*)

    subsection \<open> VDM shiftWheelRight \<close>

    definition
      pre_shiftWheelRight :: "Value \<Rightarrow> Value \<Rightarrow> State \<Rightarrow> \<bool>"
    where
      "pre_shiftWheelRight w r bst \<equiv>
        inv_State bst \<and> inv_Value w \<and> inv_Value r \<and>
        w > 0 \<and> w \<le> MAX_WHEELS \<and>
        r \<noteq> 0 \<and> r \<le> 2 \<and>
        len (safe bst) \<ge> w"

    definition
      post_shiftWheelRight ::  "Value \<Rightarrow> Value \<Rightarrow> State \<Rightarrow> State \<Rightarrow> \<bool>"
      where
      "post_shiftWheelRight w r bst ast \<equiv>
          inv_State ast \<and>
          (safe bst) \<noteq> (safe ast)"

    (*-----------------------------------------------------------------------*)

    subsection \<open> VDM shiftWheelLeft \<close>

    definition
      pre_shiftWheelLeft :: "Value \<Rightarrow> Value \<Rightarrow> State \<Rightarrow> \<bool>"
    where
      "pre_shiftWheelLeft w r bst \<equiv>
        inv_State bst \<and> inv_Value w \<and> inv_Value r \<and>
        w > 0 \<and> w \<le> MAX_WHEELS \<and>
        r \<noteq> 0 \<and> r \<le> 2 \<and>
        len (safe bst) \<ge> w"

    definition
      post_shiftWheelLeft ::  "Value \<Rightarrow> Value \<Rightarrow> State \<Rightarrow> State \<Rightarrow> \<bool>"
      where
      "post_shiftWheelLeft w r bst ast \<equiv>
          inv_State ast \<and>
          (safe bst) \<noteq> (safe ast)"

    (*-----------------------------------------------------------------------*)

    subsection \<open> VDM checkAllSpokes \<close>

    definition
      pre_checkAllSpokes :: "State \<Rightarrow> \<bool>"
    where
      "pre_checkAllSpokes bst \<equiv>
        inv_State bst \<and>
        len (combination bst) = MAX_WHEELS"

    definition
      post_checkAllSpokes ::  "\<bool> \<Rightarrow> State \<Rightarrow> State \<Rightarrow> \<bool>"
      where
      "post_checkAllSpokes r bst ast \<equiv>
          pre_checkAllSpokes bst \<longrightarrow>
          inv_State ast \<and>
          (sum ast) = 0 \<and>
          (combination bst) = (combination ast)"

    (*-----------------------------------------------------------------------*)

    subsection \<open> VDM crackSafe \<close>

    definition
      pre_crackSafe :: "State \<Rightarrow> \<bool>"
    where
      "pre_crackSafe bst \<equiv> inv_State bst"

    definition
      post_crackSafe ::  "State \<Rightarrow> State \<Rightarrow> \<bool>"
      where
      "post_crackSafe bst ast \<equiv>
          pre_crackSafe bst \<longrightarrow>
          inv_State ast \<and>
          (safe bst) = (safe ast)  \<and>
          (combination bst) = (combination ast)  \<and>
          (successes bst) = (successes ast)"

    (*-----------------------------------------------------------------------*)

    subsection \<open> VDM totalFoundCombinations \<close>

    definition
      pre_totalFoundCombinations :: "State \<Rightarrow> \<bool>"
    where
      "pre_totalFoundCombinations bst \<equiv> inv_State bst"

    definition
      post_totalFoundCombinations ::  "State \<Rightarrow> State \<Rightarrow> \<bool>"
    where
      "post_totalFoundCombinations bst ast \<equiv>
         inv_State ast \<and>
         (successes bst) = (successes ast)"

    definition
      totalFoundCombinations :: "State \<Rightarrow> VDMNat"
    where
      "totalFoundCombinations bst  \<equiv> (card (successes bst))"

(*-----------------------------------------------------------------------*)

end


(*  Title:      FOL/ex/Intuitionistic.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1991  University of Cambridge
*)

section \<open>Intuitionistic First-Order Logic\<close>

theory Intuitionistic
imports IFOL
begin

(*
Single-step ML commands:
by (IntPr.step_tac 1)
by (biresolve_tac safe_brls 1);
by (biresolve_tac haz_brls 1);
by (assume_tac 1);
by (IntPr.safe_tac 1);
by (IntPr.mp_tac 1);
by (IntPr.fast_tac @{context} 1);
*)

text\<open>Metatheorem (for \emph{propositional} formulae):
  $P$ is classically provable iff $\neg\neg P$ is intuitionistically provable.
  Therefore $\neg P$ is classically provable iff it is intuitionistically
  provable.

Proof: Let $Q$ be the conjuction of the propositions $A\vee\neg A$, one for
each atom $A$ in $P$.  Now $\neg\neg Q$ is intuitionistically provable because
$\neg\neg(A\vee\neg A)$ is and because double-negation distributes over
conjunction.  If $P$ is provable classically, then clearly $Q\rightarrow P$ is
provable intuitionistically, so $\neg\neg(Q\rightarrow P)$ is also provable
intuitionistically.  The latter is intuitionistically equivalent to $\neg\neg
Q\rightarrow\neg\neg P$, hence to $\neg\neg P$, since $\neg\neg Q$ is
intuitionistically provable.  Finally, if $P$ is a negation then $\neg\neg P$
is intuitionstically equivalent to $P$.  [Andy Pitts]\<close>

lemma "\<not> \<not> (P \<and> Q) \<longleftrightarrow> \<not> \<not> P \<and> \<not> \<not> Q"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma "\<not> \<not> ((\<not> P \<longrightarrow> Q) \<longrightarrow> (\<not> P \<longrightarrow> \<not> Q) \<longrightarrow> P)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text \<open>Double-negation does NOT distribute over disjunction.\<close>

lemma "\<not> \<not> (P \<longrightarrow> Q) \<longleftrightarrow> (\<not> \<not> P \<longrightarrow> \<not> \<not> Q)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma "\<not> \<not> \<not> P \<longleftrightarrow> \<not> P"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma "\<not> \<not> ((P \<longrightarrow> Q \<or> R) \<longrightarrow> (P \<longrightarrow> Q) \<or> (P \<longrightarrow> R))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma "(P \<longleftrightarrow> Q) \<longleftrightarrow> (Q \<longleftrightarrow> P)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma "((P \<longrightarrow> (Q \<or> (Q \<longrightarrow> R))) \<longrightarrow> R) \<longrightarrow> R"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma
  "(((G \<longrightarrow> A) \<longrightarrow> J) \<longrightarrow> D \<longrightarrow> E) \<longrightarrow> (((H \<longrightarrow> B) \<longrightarrow> I) \<longrightarrow> C \<longrightarrow> J)
    \<longrightarrow> (A \<longrightarrow> H) \<longrightarrow> F \<longrightarrow> G \<longrightarrow> (((C \<longrightarrow> B) \<longrightarrow> I) \<longrightarrow> D) \<longrightarrow> (A \<longrightarrow> C)
    \<longrightarrow> (((F \<longrightarrow> A) \<longrightarrow> B) \<longrightarrow> I) \<longrightarrow> E"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

subsection \<open>Lemmas for the propositional double-negation translation\<close>

lemma "P \<longrightarrow> \<not> \<not> P"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma "\<not> \<not> (\<not> \<not> P \<longrightarrow> P)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma "\<not> \<not> P \<and> \<not> \<not> (P \<longrightarrow> Q) \<longrightarrow> \<not> \<not> Q"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text \<open>The following are classically but not constructively valid.
  The attempt to prove them terminates quickly!\<close>
lemma "((P \<longrightarrow> Q) \<longrightarrow> P) \<longrightarrow> P"
apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
apply (rule asm_rl) \<comment>\<open>Checks that subgoals remain: proof failed.\<close>
oops

lemma "(P \<and> Q \<longrightarrow> R) \<longrightarrow> (P \<longrightarrow> R) \<or> (Q \<longrightarrow> R)"
apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
apply (rule asm_rl) \<comment>\<open>Checks that subgoals remain: proof failed.\<close>
oops

subsection \<open>de Bruijn formulae\<close>

text \<open>de Bruijn formula with three predicates\<close>
lemma
  "((P \<longleftrightarrow> Q) \<longrightarrow> P \<and> Q \<and> R) \<and>
    ((Q \<longleftrightarrow> R) \<longrightarrow> P \<and> Q \<and> R) \<and>
    ((R \<longleftrightarrow> P) \<longrightarrow> P \<and> Q \<and> R) \<longrightarrow> P \<and> Q \<and> R"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text \<open>de Bruijn formula with five predicates\<close>
lemma
  "((P \<longleftrightarrow> Q) \<longrightarrow> P \<and> Q \<and> R \<and> S \<and> T) \<and>
    ((Q \<longleftrightarrow> R) \<longrightarrow> P \<and> Q \<and> R \<and> S \<and> T) \<and>
    ((R \<longleftrightarrow> S) \<longrightarrow> P \<and> Q \<and> R \<and> S \<and> T) \<and>
    ((S \<longleftrightarrow> T) \<longrightarrow> P \<and> Q \<and> R \<and> S \<and> T) \<and>
    ((T \<longleftrightarrow> P) \<longrightarrow> P \<and> Q \<and> R \<and> S \<and> T) \<longrightarrow> P \<and> Q \<and> R \<and> S \<and> T"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text \<open>
  Problems from of Sahlin, Franzen and Haridi,
  An Intuitionistic Predicate Logic Theorem Prover.
  J. Logic and Comp. 2 (5), October 1992, 619-656.
\<close>

text\<open>Problem 1.1\<close>
lemma
  "(\<forall>x. \<exists>y. \<forall>z. p(x) \<and> q(y) \<and> r(z)) \<longleftrightarrow>
    (\<forall>z. \<exists>y. \<forall>x. p(x) \<and> q(y) \<and> r(z))"
  by (tactic \<open>IntPr.best_dup_tac @{context} 1\<close>)  \<comment>\<open>SLOW\<close>

text\<open>Problem 3.1\<close>
lemma "\<not> (\<exists>x. \<forall>y. mem(y,x) \<longleftrightarrow> \<not> mem(x,x))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>Problem 4.1: hopeless!\<close>
lemma
  "(\<forall>x. p(x) \<longrightarrow> p(h(x)) \<or> p(g(x))) \<and> (\<exists>x. p(x)) \<and> (\<forall>x. \<not> p(h(x)))
    \<longrightarrow> (\<exists>x. p(g(g(g(g(g(x)))))))"
  oops

subsection \<open>Intuitionistic FOL: propositional problems based on Pelletier.\<close>

text\<open>\<open>\<not>\<not>\<close>1\<close>
lemma "\<not> \<not> ((P \<longrightarrow> Q) \<longleftrightarrow> (\<not> Q \<longrightarrow> \<not> P))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>2\<close>
lemma "\<not> \<not> (\<not> \<not> P \<longleftrightarrow> P)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>3\<close>
lemma "\<not> (P \<longrightarrow> Q) \<longrightarrow> (Q \<longrightarrow> P)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>4\<close>
lemma "\<not> \<not> ((\<not> P \<longrightarrow> Q) \<longleftrightarrow> (\<not> Q \<longrightarrow> P))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>5\<close>
lemma "\<not> \<not> ((P \<or> Q \<longrightarrow> P \<or> R) \<longrightarrow> P \<or> (Q \<longrightarrow> R))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>6\<close>
lemma "\<not> \<not> (P \<or> \<not> P)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>7\<close>
lemma "\<not> \<not> (P \<or> \<not> \<not> \<not> P)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>8. Peirce's law\<close>
lemma "\<not> \<not> (((P \<longrightarrow> Q) \<longrightarrow> P) \<longrightarrow> P)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>9\<close>
lemma "((P \<or> Q) \<and> (\<not> P \<or> Q) \<and> (P \<or> \<not> Q)) \<longrightarrow> \<not> (\<not> P \<or> \<not> Q)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>10\<close>
lemma "(Q \<longrightarrow> R) \<longrightarrow> (R \<longrightarrow> P \<and> Q) \<longrightarrow> (P \<longrightarrow> (Q \<or> R)) \<longrightarrow> (P \<longleftrightarrow> Q)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

subsection\<open>11. Proved in each direction (incorrectly, says Pelletier!!)\<close>

lemma "P \<longleftrightarrow> P"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>12. Dijkstra's law\<close>
lemma "\<not> \<not> (((P \<longleftrightarrow> Q) \<longleftrightarrow> R) \<longleftrightarrow> (P \<longleftrightarrow> (Q \<longleftrightarrow> R)))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma "((P \<longleftrightarrow> Q) \<longleftrightarrow> R) \<longrightarrow> \<not> \<not> (P \<longleftrightarrow> (Q \<longleftrightarrow> R))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>13. Distributive law\<close>
lemma "P \<or> (Q \<and> R) \<longleftrightarrow> (P \<or> Q) \<and> (P \<or> R)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>14\<close>
lemma "\<not> \<not> ((P \<longleftrightarrow> Q) \<longleftrightarrow> ((Q \<or> \<not> P) \<and> (\<not> Q \<or> P)))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>15\<close>
lemma "\<not> \<not> ((P \<longrightarrow> Q) \<longleftrightarrow> (\<not> P \<or> Q))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>16\<close>
lemma "\<not> \<not> ((P \<longrightarrow> Q) \<or> (Q \<longrightarrow> P))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>17\<close>
lemma "\<not> \<not> (((P \<and> (Q \<longrightarrow> R)) \<longrightarrow> S) \<longleftrightarrow> ((\<not> P \<or> Q \<or> S) \<and> (\<not> P \<or> \<not> R \<or> S)))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text \<open>Dijkstra's ``Golden Rule''\<close>
lemma "(P \<and> Q) \<longleftrightarrow> P \<longleftrightarrow> Q \<longleftrightarrow> (P \<or> Q)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

section \<open>Examples with quantifiers\<close>

subsection \<open>The converse is classical in the following implications \dots\<close>

lemma "(\<exists>x. P(x) \<longrightarrow> Q) \<longrightarrow> (\<forall>x. P(x)) \<longrightarrow> Q"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma "((\<forall>x. P(x)) \<longrightarrow> Q) \<longrightarrow> \<not> (\<forall>x. P(x) \<and> \<not> Q)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma "((\<forall>x. \<not> P(x)) \<longrightarrow> Q) \<longrightarrow> \<not> (\<forall>x. \<not> (P(x) \<or> Q))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma "(\<forall>x. P(x)) \<or> Q \<longrightarrow> (\<forall>x. P(x) \<or> Q)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

lemma "(\<exists>x. P \<longrightarrow> Q(x)) \<longrightarrow> (P \<longrightarrow> (\<exists>x. Q(x)))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

subsection \<open>The following are not constructively valid!\<close>
text \<open>The attempt to prove them terminates quickly!\<close>

lemma "((\<forall>x. P(x)) \<longrightarrow> Q) \<longrightarrow> (\<exists>x. P(x) \<longrightarrow> Q)"
  apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
  apply (rule asm_rl) \<comment>\<open>Checks that subgoals remain: proof failed.\<close>
  oops

lemma "(P \<longrightarrow> (\<exists>x. Q(x))) \<longrightarrow> (\<exists>x. P \<longrightarrow> Q(x))"
  apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
  apply (rule asm_rl) \<comment>\<open>Checks that subgoals remain: proof failed.\<close>
  oops

lemma "(\<forall>x. P(x) \<or> Q) \<longrightarrow> ((\<forall>x. P(x)) \<or> Q)"
  apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
  apply (rule asm_rl) \<comment>\<open>Checks that subgoals remain: proof failed.\<close>
  oops

lemma "(\<forall>x. \<not> \<not> P(x)) \<longrightarrow> \<not> \<not> (\<forall>x. P(x))"
  apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
  apply (rule asm_rl) \<comment>\<open>Checks that subgoals remain: proof failed.\<close>
  oops

text \<open>Classically but not intuitionistically valid.  Proved by a bug in 1986!\<close>
lemma "\<exists>x. Q(x) \<longrightarrow> (\<forall>x. Q(x))"
  apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)?
  apply (rule asm_rl) \<comment>\<open>Checks that subgoals remain: proof failed.\<close>
  oops

subsection \<open>Hard examples with quantifiers\<close>

text \<open>
  The ones that have not been proved are not known to be valid! Some will
  require quantifier duplication -- not currently available.
\<close>

text\<open>\<open>\<not>\<not>\<close>18\<close>
lemma "\<not> \<not> (\<exists>y. \<forall>x. P(y) \<longrightarrow> P(x))"
  oops  \<comment> \<open>NOT PROVED\<close>

text\<open>\<open>\<not>\<not>\<close>19\<close>
lemma "\<not> \<not> (\<exists>x. \<forall>y z. (P(y) \<longrightarrow> Q(z)) \<longrightarrow> (P(x) \<longrightarrow> Q(x)))"
  oops  \<comment> \<open>NOT PROVED\<close>

text\<open>20\<close>
lemma
  "(\<forall>x y. \<exists>z. \<forall>w. (P(x) \<and> Q(y) \<longrightarrow> R(z) \<and> S(w)))
    \<longrightarrow> (\<exists>x y. P(x) \<and> Q(y)) \<longrightarrow> (\<exists>z. R(z))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>21\<close>
lemma "(\<exists>x. P \<longrightarrow> Q(x)) \<and> (\<exists>x. Q(x) \<longrightarrow> P) \<longrightarrow> \<not> \<not> (\<exists>x. P \<longleftrightarrow> Q(x))"
  oops \<comment> \<open>NOT PROVED; needs quantifier duplication\<close>

text\<open>22\<close>
lemma "(\<forall>x. P \<longleftrightarrow> Q(x)) \<longrightarrow> (P \<longleftrightarrow> (\<forall>x. Q(x)))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>23\<close>
lemma "\<not> \<not> ((\<forall>x. P \<or> Q(x)) \<longleftrightarrow> (P \<or> (\<forall>x. Q(x))))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>24\<close>
lemma
  "\<not> (\<exists>x. S(x) \<and> Q(x)) \<and> (\<forall>x. P(x) \<longrightarrow> Q(x) \<or> R(x)) \<and>
    (\<not> (\<exists>x. P(x)) \<longrightarrow> (\<exists>x. Q(x))) \<and> (\<forall>x. Q(x) \<or> R(x) \<longrightarrow> S(x))
    \<longrightarrow> \<not> \<not> (\<exists>x. P(x) \<and> R(x))"
text \<open>
  Not clear why \<open>fast_tac\<close>, \<open>best_tac\<close>, \<open>ASTAR\<close> and
  \<open>ITER_DEEPEN\<close> all take forever.
\<close>
  apply (tactic \<open>IntPr.safe_tac @{context}\<close>)
  apply (erule impE)
  apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
  apply (tactic \<open>IntPr.fast_tac @{context} 1\<close>)
  done

text\<open>25\<close>
lemma
  "(\<exists>x. P(x)) \<and>
      (\<forall>x. L(x) \<longrightarrow> \<not> (M(x) \<and> R(x))) \<and>
      (\<forall>x. P(x) \<longrightarrow> (M(x) \<and> L(x))) \<and>
      ((\<forall>x. P(x) \<longrightarrow> Q(x)) \<or> (\<exists>x. P(x) \<and> R(x)))
    \<longrightarrow> (\<exists>x. Q(x) \<and> P(x))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>26\<close>
lemma
  "(\<not> \<not> (\<exists>x. p(x)) \<longleftrightarrow> \<not> \<not> (\<exists>x. q(x))) \<and>
    (\<forall>x. \<forall>y. p(x) \<and> q(y) \<longrightarrow> (r(x) \<longleftrightarrow> s(y)))
  \<longrightarrow> ((\<forall>x. p(x) \<longrightarrow> r(x)) \<longleftrightarrow> (\<forall>x. q(x) \<longrightarrow> s(x)))"
  oops  \<comment>\<open>NOT PROVED\<close>

text\<open>27\<close>
lemma
  "(\<exists>x. P(x) \<and> \<not> Q(x)) \<and>
    (\<forall>x. P(x) \<longrightarrow> R(x)) \<and>
    (\<forall>x. M(x) \<and> L(x) \<longrightarrow> P(x)) \<and>
    ((\<exists>x. R(x) \<and> \<not> Q(x)) \<longrightarrow> (\<forall>x. L(x) \<longrightarrow> \<not> R(x)))
  \<longrightarrow> (\<forall>x. M(x) \<longrightarrow> \<not> L(x))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>28. AMENDED\<close>
lemma
  "(\<forall>x. P(x) \<longrightarrow> (\<forall>x. Q(x))) \<and>
      (\<not> \<not> (\<forall>x. Q(x) \<or> R(x)) \<longrightarrow> (\<exists>x. Q(x) \<and> S(x))) \<and>
      (\<not> \<not> (\<exists>x. S(x)) \<longrightarrow> (\<forall>x. L(x) \<longrightarrow> M(x)))
    \<longrightarrow> (\<forall>x. P(x) \<and> L(x) \<longrightarrow> M(x))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>29. Essentially the same as Principia Mathematica *11.71\<close>
lemma
  "(\<exists>x. P(x)) \<and> (\<exists>y. Q(y))
    \<longrightarrow> ((\<forall>x. P(x) \<longrightarrow> R(x)) \<and> (\<forall>y. Q(y) \<longrightarrow> S(y)) \<longleftrightarrow>
      (\<forall>x y. P(x) \<and> Q(y) \<longrightarrow> R(x) \<and> S(y)))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>30\<close>
lemma
  "(\<forall>x. (P(x) \<or> Q(x)) \<longrightarrow> \<not> R(x)) \<and>
      (\<forall>x. (Q(x) \<longrightarrow> \<not> S(x)) \<longrightarrow> P(x) \<and> R(x))
    \<longrightarrow> (\<forall>x. \<not> \<not> S(x))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>31\<close>
lemma
  "\<not> (\<exists>x. P(x) \<and> (Q(x) \<or> R(x))) \<and>
      (\<exists>x. L(x) \<and> P(x)) \<and>
      (\<forall>x. \<not> R(x) \<longrightarrow> M(x))
  \<longrightarrow> (\<exists>x. L(x) \<and> M(x))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>32\<close>
lemma
  "(\<forall>x. P(x) \<and> (Q(x) \<or> R(x)) \<longrightarrow> S(x)) \<and>
    (\<forall>x. S(x) \<and> R(x) \<longrightarrow> L(x)) \<and>
    (\<forall>x. M(x) \<longrightarrow> R(x))
  \<longrightarrow> (\<forall>x. P(x) \<and> M(x) \<longrightarrow> L(x))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>\<open>\<not>\<not>\<close>33\<close>
lemma
  "(\<forall>x. \<not> \<not> (P(a) \<and> (P(x) \<longrightarrow> P(b)) \<longrightarrow> P(c))) \<longleftrightarrow>
    (\<forall>x. \<not> \<not> ((\<not> P(a) \<or> P(x) \<or> P(c)) \<and> (\<not> P(a) \<or> \<not> P(b) \<or> P(c))))"
  apply (tactic \<open>IntPr.best_tac @{context} 1\<close>)
  done

text\<open>36\<close>
lemma
  "(\<forall>x. \<exists>y. J(x,y)) \<and>
    (\<forall>x. \<exists>y. G(x,y)) \<and>
    (\<forall>x y. J(x,y) \<or> G(x,y) \<longrightarrow> (\<forall>z. J(y,z) \<or> G(y,z) \<longrightarrow> H(x,z)))
  \<longrightarrow> (\<forall>x. \<exists>y. H(x,y))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>37\<close>
lemma
  "(\<forall>z. \<exists>w. \<forall>x. \<exists>y.
      \<not> \<not> (P(x,z) \<longrightarrow> P(y,w)) \<and> P(y,z) \<and> (P(y,w) \<longrightarrow> (\<exists>u. Q(u,w)))) \<and>
        (\<forall>x z. \<not> P(x,z) \<longrightarrow> (\<exists>y. Q(y,z))) \<and>
        (\<not> \<not> (\<exists>x y. Q(x,y)) \<longrightarrow> (\<forall>x. R(x,x)))
    \<longrightarrow> \<not> \<not> (\<forall>x. \<exists>y. R(x,y))"
  oops  \<comment>\<open>NOT PROVED\<close>

text\<open>39\<close>
lemma "\<not> (\<exists>x. \<forall>y. F(y,x) \<longleftrightarrow> \<not> F(y,y))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>40. AMENDED\<close>
lemma
  "(\<exists>y. \<forall>x. F(x,y) \<longleftrightarrow> F(x,x)) \<longrightarrow>
    \<not> (\<forall>x. \<exists>y. \<forall>z. F(z,y) \<longleftrightarrow> \<not> F(z,x))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>44\<close>
lemma
  "(\<forall>x. f(x) \<longrightarrow>
    (\<exists>y. g(y) \<and> h(x,y) \<and> (\<exists>y. g(y) \<and> \<not> h(x,y)))) \<and>
    (\<exists>x. j(x) \<and> (\<forall>y. g(y) \<longrightarrow> h(x,y)))
    \<longrightarrow> (\<exists>x. j(x) \<and> \<not> f(x))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>48\<close>
lemma "(a = b \<or> c = d) \<and> (a = c \<or> b = d) \<longrightarrow> a = d \<or> b = c"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>51\<close>
lemma
  "(\<exists>z w. \<forall>x y. P(x,y) \<longleftrightarrow> (x = z \<and> y = w)) \<longrightarrow>
    (\<exists>z. \<forall>x. \<exists>w. (\<forall>y. P(x,y) \<longleftrightarrow> y = w) \<longleftrightarrow> x = z)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>52\<close>
text \<open>Almost the same as 51.\<close>
lemma
  "(\<exists>z w. \<forall>x y. P(x,y) \<longleftrightarrow> (x = z \<and> y = w)) \<longrightarrow>
    (\<exists>w. \<forall>y. \<exists>z. (\<forall>x. P(x,y) \<longleftrightarrow> x = z) \<longleftrightarrow> y = w)"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>56\<close>
lemma "(\<forall>x. (\<exists>y. P(y) \<and> x = f(y)) \<longrightarrow> P(x)) \<longleftrightarrow> (\<forall>x. P(x) \<longrightarrow> P(f(x)))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>57\<close>
lemma
  "P(f(a,b), f(b,c)) \<and> P(f(b,c), f(a,c)) \<and>
    (\<forall>x y z. P(x,y) \<and> P(y,z) \<longrightarrow> P(x,z)) \<longrightarrow> P(f(a,b), f(a,c))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

text\<open>60\<close>
lemma "\<forall>x. P(x,f(x)) \<longleftrightarrow> (\<exists>y. (\<forall>z. P(z,y) \<longrightarrow> P(z,f(x))) \<and> P(x,y))"
  by (tactic \<open>IntPr.fast_tac @{context} 1\<close>)

end


(*  Title:      HOL/ex/Sqrt_Script.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   2001  University of Cambridge
*)

section \<open>Square roots of primes are irrational (script version)\<close>

theory Sqrt_Script
imports Complex_Main "~~/src/HOL/Number_Theory/Primes"
begin

text \<open>
  \medskip Contrast this linear Isabelle/Isar script with Markus
  Wenzel's more mathematical version.
\<close>

subsection \<open>Preliminaries\<close>

lemma prime_nonzero:  "prime (p::nat) \<Longrightarrow> p \<noteq> 0"
  by (force simp add: prime_nat_iff)

lemma prime_dvd_other_side:
    "(n::nat) * n = p * (k * k) \<Longrightarrow> prime p \<Longrightarrow> p dvd n"
  apply (subgoal_tac "p dvd n * n", blast dest: prime_dvd_mult_nat)
  apply auto
  done

lemma reduction: "prime (p::nat) \<Longrightarrow>
    0 < k \<Longrightarrow> k * k = p * (j * j) \<Longrightarrow> k < p * j \<and> 0 < j"
  apply (rule ccontr)
  apply (simp add: linorder_not_less)
  apply (erule disjE)
   apply (frule mult_le_mono, assumption)
   apply auto
  apply (force simp add: prime_nat_iff)
  done

lemma rearrange: "(j::nat) * (p * j) = k * k \<Longrightarrow> k * k = p * (j * j)"
  by (simp add: ac_simps)

lemma prime_not_square:
    "prime (p::nat) \<Longrightarrow> (\<And>k. 0 < k \<Longrightarrow> m * m \<noteq> p * (k * k))"
  apply (induct m rule: nat_less_induct)
  apply clarify
  apply (frule prime_dvd_other_side, assumption)
  apply (erule dvdE)
  apply (simp add: nat_mult_eq_cancel_disj prime_nonzero)
  apply (blast dest: rearrange reduction)
  done

subsection \<open>Main theorem\<close>

text \<open>
  The square root of any prime number (including \<open>2\<close>) is
  irrational.
\<close>

theorem prime_sqrt_irrational:
    "prime (p::nat) \<Longrightarrow> x * x = real p \<Longrightarrow> 0 \<le> x \<Longrightarrow> x \<notin> \<rat>"
  apply (rule notI)
  apply (erule Rats_abs_nat_div_natE)
  apply (simp del: of_nat_mult
              add: abs_if divide_eq_eq prime_not_square of_nat_mult [symmetric])
  done

lemmas two_sqrt_irrational =
  prime_sqrt_irrational [OF two_is_prime_nat]

end