text \<open> Version 0.5, last changed 2019-02-01
  (C) fovefi ltd, www.fovefi.co
  (author: Lukas Bulwahn [lubu@fovefi.co] and Manfred Kerber with comments by Manfred Kerber [make@fovefi.co])

  Dually licenced under
  Creative Commons Attribution (CC-BY) 4.0 [https://creativecommons.org/licenses/by/4.0/]
  ISC License (1-clause BSD License)       [https://www.isc.org/downloads/software-support-policy/isc-license/]
  See LICENSE files for details.
  (Rationale for this dual licence: http://arxiv.org/abs/1107.3212)

  In this file, an abstract definition of the  percentile function in Isabelle is given.
  The percentile function is defined as a linear approximation between points defined for a partial
  function defined for finitely many elements.

  It is perhaps best been explained with the help of an example.
  Let us assume that you have a list of 5 real numbers xs = [8, 10, 1, 4, 5]. In order to compute a
  particular percentile, e.g., of 0.75, first you order the list and get sxs = [1, 4, 5, 8, 10]. Then you put 5 values
  (length of the list) on the unit interval [0;1] at equal distances of 1/5, staying away 1/10 from
  the left and right border, that is, you get [0.1, 0.3, 0.5, 0.7, 0.9]. For these values you take
  as percentile the corresponding value in the sorted list, that is, the percentile at 0.1 is  1, at
  0.3 is 4, at 0.5 is 5, at 0.7 is 8, and at 0.9 is 10. For values between any two values, the linear
  interpolation between the two neighbors are taken. That is, for x = 0.75, the two neighbors are
  a = 0.7 and b = 0.9 are taken and then the linear interpolation computed as f(a) + (f(b) - f(a))/(b - a) * (x - a).
  In the example, percentile at 0.75 it is 8 + (10 - 8)/(0.9 - 0.7) * (0.75 - 0.7)  = 8 + 2/0.2 * 0.05,
  that is, 8 + 10 * 0.05 = 8.5.

  Note that in this file an abstract definition as well as properties of the percentile
  function are given. This percentile function is not computational. In the sister document
  Percentile_Code.thy, a corresponding computational version is given and the equivalence of the
  two functions is shown.

  The documents is structured as follows, first in a section preliminaries, some properties are given
  that are needed later. In the next section, points are put on the unit interval in the way described
  above. The following section contains an abstract definition of the percentile function. Finally
  some important properties are proved:
  - boundedness (upper and lower bound)
  - monotonicity
  - Lipschitz continuity
 \<close>

theory Percentile
   imports Complex_Main Linear_Interpolation

begin

section \<open>Preliminaries\<close>

subsection \<open>Addition to List\<close>
text \<open> Sorting the empty list results in the empty list.\<close>
lemma sort_eq_Nil_iff:
  "sort xs = [] \<longleftrightarrow> xs = []"
by (cases xs) auto

text \<open> Every element in a sorted list is smaller than or equal to the last element. \<close>
lemma sorted_leq_last:
  assumes "sorted xs"
  assumes "x \<in> set xs"
  shows "x \<le> last xs"
using assms
  by (metis in_set_conv_decomp_last last.simps last_append last_in_set linorder_not_less
            list.simps(3) order_less_irrefl sorted.simps(2) sorted_append)

section \<open>From list of reals to @{typ "real \<Rightarrow> real option"}\<close>

text \<open> In order to define the percentile of a list of real numbers, the unit interval is sub-divided by
  putting a number of equidistantly distributed points on the line. The first point is put half
  a distance from 0, the last half a distance from 1. The distance is 1/(length list).
  real option means that the result is a partial function, that is, for a given value it will return either
  None (if the value is not in the domain) or Some with the position (if it is in the domain). \<close>
definition equidistant_points_on_unit_interval_of :: "real list \<Rightarrow> real \<Rightarrow> real option"
where
  "equidistant_points_on_unit_interval_of ys = (let xs = map (\<lambda>x. (1 / length ys) * (x + 0.5)) [0..<length ys]
     in map_of (zip xs ys))"

text \<open> Some examples to exemplify the definition \<close>
value "(\<lambda>ys. map (\<lambda>x. (1 / length ys) * (x + 0.5)) [0..<length ys]) []"
value "(\<lambda>ys. map (\<lambda>x. (1 / length ys) * (x + 0.5)) [0..<length ys]) [(1 :: real)]"
value "(\<lambda>ys. map (\<lambda>x. (1 / length ys) * (x + 0.5)) [0..<length ys]) [1, (2 :: real)]"
value "(\<lambda>ys. map (\<lambda>x. (1 / length ys) * (x + 0.5)) [0..<length ys]) [1,2, (3 :: real)]"
value "(\<lambda>ys. map (\<lambda>x. (1 / length ys) * (x + 0.5)) [0..<length ys]) [1,2,3, (4 :: real)]"

text \<open> The number of equidistant points is finite.\<close>
lemma finite_equidistant_points_on_unit_interval_of [simp]:
  "finite (dom (equidistant_points_on_unit_interval_of ys))"
unfolding equidistant_points_on_unit_interval_of_def by simp

text \<open> In a well-ordered set, {a..<b} is the set of all elements between a and b (a included, b excluded)
  If this set is non-empty and finite, a is its minimum. \<close>
lemma Min_intv:
  assumes "{a..<b} \<noteq> {}"
  assumes "finite {a..<b}"
  shows "Min {a..<b} = a"
using assms by (auto intro: Min_eqI)

text \<open> For a set {a..<b} of natural numbers is the set of all elements between a and b
 (a included, b excluded). If that set is non-empty and finite, b-1 is its maximum. \<close>
lemma Max_intv:
  assumes "{a..<b} \<noteq> {}"
  shows "Max {a..<(b :: nat)} = b - 1"
using assms by (auto intro!: Max_eqI)

text \<open> The values of equidistant_points_on_unit_interval_of are exactly the values given by its
  definition and none more. \<close>
lemma dom_equidistant_points_on_unit_interval_of:
  "dom (equidistant_points_on_unit_interval_of ys) = (\<lambda>x. (1 / length ys) * (x + 0.5)) ` {0..<length ys}"
proof -
  have "distinct (map (\<lambda>x. (1 / length ys) * (x + 0.5)) [0..<length ys])"
    by (auto intro!: inj_onI simp add: distinct_map )
  show ?thesis
    unfolding equidistant_points_on_unit_interval_of_def by (auto simp add: \<open>distinct _\<close>)
qed

text \<open> The minimal value of equidistant_points_on_unit_interval_of is at half the distance from 0. \<close>
lemma Min_equidistant_points_on_unit_interval_of:
  assumes "ys \<noteq> []"
  shows "Min (dom (equidistant_points_on_unit_interval_of ys)) = 1 / (2 * length ys)"
proof -
  have "incseq (\<lambda>x. (1 / length ys) * (x + 0.5))"
    by (auto simp add: incseq_def divide_right_mono)
  from this dom_equidistant_points_on_unit_interval_of show ?thesis
    using \<open>ys \<noteq> []\<close> \<open>incseq _\<close> by (auto simp add: mono_Min_commute[symmetric] Min_intv)
qed

text \<open> The maximal value of equidistant_points_on_unit_interval_of is at half the distance from 1. \<close>
lemma Max_equidistant_points_on_unit_interval_of:
  assumes "ys \<noteq> []"
  shows "Max (dom (equidistant_points_on_unit_interval_of ys)) = 1 - 1 / (2 * length ys)"
proof -
  have "incseq (\<lambda>x. (1 / length ys) * (x + 0.5))"
    by (auto simp add: incseq_def divide_right_mono)
  from this dom_equidistant_points_on_unit_interval_of show ?thesis
    using \<open>ys \<noteq> []\<close> \<open>incseq _\<close> apply (auto simp add: mono_Max_commute[symmetric] Max_intv)
    apply (subst of_nat_diff)
     defer
     apply simp
    apply (simp add: diff_divide_distrib)
    using not_less by fastforce
qed

text \<open> The following lemma states that the points where the function given by
  equidistant_points_on_unit_interval_of is defined, are all in the interval between
  1/(2 * length ys) and 1 - 1/(2 * length ys), that is,
  the minimal and maximal value as proved in the two lemmas above. \<close>
lemma defined_interval_of_equidistant_points_on_unit_interval_of:
  assumes "ys \<noteq> []"
  shows "defined_interval_of (equidistant_points_on_unit_interval_of ys) = {1 / (2 * length ys)..1 - 1 / (2 * length ys)}"
using assms unfolding defined_interval_of_def
apply (simp add:  Min_equidistant_points_on_unit_interval_of Max_equidistant_points_on_unit_interval_of)
proof -
  assume "ys \<noteq> []"
  then have "[] \<noteq> [0..<length ys]"
    by (metis length_greater_0_conv length_map map_nth)
  then have "\<exists>r. r \<in> {r. map_of (zip (map (\<lambda>n. 1 / real (length ys) * (real n + 5 / 10)) [0..<length ys]) ys) r \<noteq> None}"
    by fastforce
  then show "equidistant_points_on_unit_interval_of ys = Map.empty \<longrightarrow> \<not> 1 \<le> real (length ys)"
    using equidistant_points_on_unit_interval_of_def by force
qed

text \<open> On the points where (equidistant_points_on_unit_interval_of ys) is defined, the resulting values are the ys. \<close>
lemma ran_equidistant_points_on_unit_interval_of:
  "ran (equidistant_points_on_unit_interval_of ys) = set ys"
proof -
  have "length (map (\<lambda>x. (real x + 1 / 2) / real (length ys)) [0..<length ys]) = length ys"
    by simp
  have distinct: "distinct (map (\<lambda>x. (real x + 1 / 2) / real (length ys)) [0..<length ys])"
    by (auto simp add: distinct_map intro!: inj_onI)
  show ?thesis
    unfolding equidistant_points_on_unit_interval_of_def
    apply simp
    apply (rule ran_map_of_zip)
    apply (auto simp add: distinct)
    done
qed

text \<open>The sortedness of a list is preserved by multiplying each element by the same positive number.\<close>
lemma sorted_map:
  assumes "(c::real) > 0"
  assumes "sorted ys"
  shows "sorted (map (\<lambda> z. c*z) ys)"
  by (smt assms(1) assms(2) dual_order.strict_trans length_map mult_left_mono nth_map sorted_iff_nth_mono_less)

text \<open>For a list with no two same elements the n-th element of a first list applied to the zip of
      a first list and a second list is defined and equal to the n-th element of the second list.\<close>
lemma zip_some:
  assumes "length xs = length ys"
  assumes "\<forall> n < length xs. \<forall> m < length xs. xs!n = xs!m \<longrightarrow> n = m"
  shows "(\<forall>n < length xs. (map_of (zip xs ys) (xs!n)) = Some (ys!n))"
  by (metis assms(1) assms(2) distinct_conv_nth map_of_zip_nth)

text \<open>The n-th element of equidistant_points_on_unit_interval_of is the n-th element of the original list.\<close>
lemma equidistant_nth:
  assumes "sorted ys"
  assumes "length ys > 1"
  assumes "xs = map (\<lambda>x. (1 / length ys) * (x + 0.5)) [0..<length ys]"
  assumes "\<exists>y. ((equidistant_points_on_unit_interval_of ys) x) = (Some y)"
  assumes "(n::nat) < length ys"
  assumes "\<forall> n < length xs. \<forall> m < length xs. (xs)!n = (xs)!m \<longrightarrow> n = m"
  shows "the ((equidistant_points_on_unit_interval_of ys) (xs!n)) = ys!n"
proof -
  have a: "length xs = length ys" by (simp add: assms(3))
  have b:  "\<forall> n < length xs. \<forall> m < length xs. xs!n = xs!m \<longrightarrow> n = m" by (simp add: assms(6))
  have "the ((equidistant_points_on_unit_interval_of ys) x) = the (map_of (zip xs ys) x)"
    by (simp add: assms(3) equidistant_points_on_unit_interval_of_def)
  then have "the (map_of (zip xs ys) (xs!n)) = the (map_of (zip xs ys) (xs!n))"  by blast
  have "(map_of (zip xs ys) (xs!n)) = Some (ys!n)"
    by (simp add: a assms(5) b zip_some)
  then show ?thesis using assms
    by (metis equidistant_points_on_unit_interval_of_def option.sel)
qed

text \<open>The partial function equidistant_points_on_unit_interval_of is linear for the defined points.\<close>
lemma equidistant_linear_some:
  assumes "(c::real) > 0"
  assumes "sorted ys"
  assumes "length ys > 1"
  assumes "xs = map (\<lambda>x. (1 / length ys) * (x + 0.5)) [0..<length ys]"
  assumes "\<exists>y. ((equidistant_points_on_unit_interval_of ys) x) = (Some y)"
  shows   "(equidistant_points_on_unit_interval_of (map (\<lambda> z. c*z) ys)) x =
           map_option (\<lambda>z. c * z) ((equidistant_points_on_unit_interval_of ys) x)"
proof -
  have "x \<in> set xs" using assms equidistant_points_on_unit_interval_of_def
    by (metis domIff dom_equidistant_points_on_unit_interval_of option.simps(3) set_map set_upt)
  then have "\<exists> n. n < length ys \<and> x = xs!n" using assms(4) by auto
  then obtain n where " n < length ys \<and> x = xs!n" by blast
  have "length ys > 0" using assms(3) by auto
  have "\<forall> m < length xs. xs!m = (1 / length ys) * (m + 0.5)" by (simp add: assms(4))
  then have "\<forall> m < length xs. \<forall> p < length xs. m < p \<longrightarrow> (xs)!m < (xs)!p" using assms(4)
    by (smt \<open>0 < length ys\<close> less_imp_of_nat_less mult_less_cancel_left_pos of_nat_0_less_iff zero_less_divide_1_iff)
  then have "\<forall> m < length xs. \<forall> p < length xs. (xs)!m = (xs)!p \<longrightarrow> m = p" by (smt nat_neq_iff)
  then have "the ((equidistant_points_on_unit_interval_of ys) (xs!n)) = ys!n" using assms
    using \<open>\<forall>m<length xs. \<forall>p<length xs. xs ! m = xs ! p \<longrightarrow> m = p\<close> equidistant_nth
    by (meson \<open>n < length ys \<and> x = xs ! n\<close>)
  then have "(map_of (zip xs ys)) (xs!n) = Some (ys!n)" using assms
    by (metis (no_types, lifting) \<open>\<forall>m<length xs. \<forall>p<length xs. xs ! m = xs ! p \<longrightarrow> m = p\<close>
        \<open>n < length ys \<and> x = xs ! n\<close> length_map map_nth zip_some)
  have "(map_of (zip xs (map (\<lambda> z. c*z) ys))) (xs!n) = Some (c* (ys!n))" using assms
    by (smt \<open>\<forall>m<length xs. \<forall>p<length xs. xs ! m = xs ! p \<longrightarrow> m = p\<close> \<open>n < length ys \<and> x = xs ! n\<close>
        length_map map_nth nth_map zip_some)
  then have a: "(((equidistant_points_on_unit_interval_of (map (\<lambda> z. c*z) ys)) (xs!n)) = Some (c*(ys!n)))"
    by (simp add: assms(4) equidistant_points_on_unit_interval_of_def)
  have b: "((equidistant_points_on_unit_interval_of ys) x) = Some (ys!n)"
    using \<open>n < length ys \<and> x = xs ! n\<close>
          \<open>the (equidistant_points_on_unit_interval_of ys (xs ! n)) = ys ! n\<close> assms(5) by auto
  have "Some (c*(ys!n)) = map_option (\<lambda>z. c * z) (Some (ys!n))" by auto
  then show ?thesis using a \<open>n < length ys \<and> x = xs ! n\<close> b by presburger
qed

text \<open>The partial function equidistant_points_on_unit_interval_of is linear for undefined points.\<close>
lemma equidistant_linear_none:
  assumes "(c::real) > 0"
  assumes "sorted ys"
  assumes "length ys > 1"
  assumes "xs = map (\<lambda>x. (1 / length ys) * (x + 0.5)) [0..<length ys]"
  assumes "(equidistant_points_on_unit_interval_of ys) x = None"
  shows   "(equidistant_points_on_unit_interval_of (map (\<lambda> z. c*z) ys)) x =
           map_option (\<lambda>z. c * z) ((equidistant_points_on_unit_interval_of ys) x)"
  by (metis (no_types, lifting) assms(5) diff_zero equidistant_points_on_unit_interval_of_def
      length_map length_upt map_eq_conv map_of_zip_is_None map_option_is_None)

text \<open>The partial function equidistant_points_on_unit_interval_of is linear.\<close>
lemma equidistant_linear:
  assumes "(c::real) > 0"
  assumes "sorted ys"
  assumes "length ys > 1"
  assumes "xs = map (\<lambda>x. (1 / length ys) * (x + 0.5)) [0..<length ys]"
  shows   "map_option (\<lambda>z. c * z) ((equidistant_points_on_unit_interval_of ys) x) =
           (equidistant_points_on_unit_interval_of (map (\<lambda> z. c*z) ys)) x"
proof -
  have  "(\<exists>y. ((equidistant_points_on_unit_interval_of ys) x) = (Some y)) \<or>
          (equidistant_points_on_unit_interval_of ys) x = None" by blast
  then show ?thesis using equidistant_linear_some equidistant_linear_none
    using assms(1) assms(2) assms(3) by presburger
qed

section \<open>Definition of percentile\<close>

text \<open> Percentile is a linear approximation of the equidistant points on the unit interval of the sorted list.
  E.g., for a list [3,1,4,8,6], the x percentile is determined by first sorting the list to [1,3,4,6,8],
  then the unit interval is subdivided by adding the 5 points 0.1, 0.3, 0.5, 0.7, and 0.9. The 0.1
  percentile is then 1, the 0.3 percentile 3, the 0.5 percentile 4, and so on. For values in between,
  e.g., the 0.4 percentile, a linear approximation of the 0.3 percentile and the 0.5 percentile is computed,
  that is, in this case the value is precisely between 3 and 4, that is, 3.5.
  Note that this expression deals with a priori infinite objects and is not computational.
  A computational version of percentile can be found in Percentile_Code.thy. \<close>
definition percentile :: "real list \<Rightarrow> real \<Rightarrow> real"
where
  "percentile ys x = linear_interpolation (equidistant_points_on_unit_interval_of (sort ys)) x"

section \<open>Alternative definition of percentile implementation\<close>

text \<open>The neighbors of a point x with respect to the partial function p are the maximal point where
      p is defined that are smaller than x and the minimal point where p is defined that are either
      equal to x or bigger than x.\<close>
lemma neighbors_alternative_pseudo_def:
  assumes "x \<notin> dom p"
  shows "neighbors p x = (Max {x' \<in> dom p. x' < x}, Min {x' \<in> dom p. x \<le> x'})"
proof -
  have "Max {x' \<in> dom p. x' \<le> x} = Max {x' \<in> dom p. x' < x}"
    by (smt Collect_cong assms)
  from this show ?thesis
    unfolding neighbors_def by simp
qed

text \<open>The percentile at a position x is given as the interpolation of the values of the two neighours.\<close>
lemma percentile_alternative_pseudo_def:
  assumes "x \<noteq> 1 / (2 * length ys)"
  shows "percentile ys x =
    (let p = (equidistant_points_on_unit_interval_of (sort ys));
    (x1, x2) = (Max {x' \<in> dom p. x' < x}, Min {x' \<in> dom p. x \<le> x'});
    (y1, y2) = (the (p x1), the (p x2))
    in linear (x1, y1) (x2, y2) x
    )"
proof (cases "x \<in> dom (equidistant_points_on_unit_interval_of (sort ys))")
  case True
  have "finite (dom (equidistant_points_on_unit_interval_of (sort ys)))"
    by simp
  from True this show ?thesis
    unfolding percentile_def linear_interpolation_def
    apply simp
    using \<open>finite (dom (equidistant_points_on_unit_interval_of (sort ys)))\<close>
    by (smt Collect_cong Pair_inject case_prod_conv defined_point_neighbors_eq linear_first linear_second neighbors_def)
next
  case False
  then show ?thesis
    unfolding percentile_def linear_interpolation_def
    apply (subst neighbors_alternative_pseudo_def)
    apply simp
    apply (simp add: Let_def) done
qed

section \<open>Properties of Percentile\<close>

text \<open> The percentile function has an upper bound, the maximal value in the associated set. \<close>
lemma percentile_upper_bound:
  assumes "ys \<noteq> []"
  assumes "1 / (2 * length ys) \<le> x \<and> x \<le> 1 - 1 / (2 * length ys)"
  shows "percentile ys x \<le> Max (set ys)"
proof -
  have "percentile ys x = linear_interpolation (equidistant_points_on_unit_interval_of (sort ys)) x"
    unfolding percentile_def ..
  also have "\<dots> \<le> Max (ran (equidistant_points_on_unit_interval_of (sort ys)))"
  proof -
    have "finite (dom (equidistant_points_on_unit_interval_of (sort ys)))" by simp
    moreover have "x \<in> defined_interval_of (equidistant_points_on_unit_interval_of (sort ys))"
      using defined_interval_of_equidistant_points_on_unit_interval_of
      using assms(1, 2) atLeastAtMost_iff
      by (simp add: sort_eq_Nil_iff)
    ultimately show ?thesis by (rule upper_bound)
  qed
  also have "\<dots> = Max (set ys)"
    using ran_equidistant_points_on_unit_interval_of \<open>ys \<noteq> []\<close> by simp
  finally show ?thesis .
qed

text \<open> The percentile function has a lower bound, the minimal value in the associated set. \<close>
lemma percentile_lower_bound:
  assumes "ys \<noteq> []"
  assumes "1 / (2 * length ys) \<le> x \<and> x \<le> 1 - 1 / (2 * length ys)"
  shows "Min (set ys) \<le> percentile ys x"
proof -
  have "Min (set ys) = Min (ran (equidistant_points_on_unit_interval_of (sort ys)))"
    using ran_equidistant_points_on_unit_interval_of \<open>ys \<noteq> []\<close> by simp
  also have "\<dots> \<le>  linear_interpolation (equidistant_points_on_unit_interval_of (sort ys)) x"
  proof -
    have "finite (dom (equidistant_points_on_unit_interval_of (sort ys)))" by simp
    moreover have "x \<in> defined_interval_of (equidistant_points_on_unit_interval_of (sort ys))"
      using defined_interval_of_equidistant_points_on_unit_interval_of
      using assms(1, 2) atLeastAtMost_iff
      by (simp add: sort_eq_Nil_iff)
    ultimately show ?thesis by (rule lower_bound)
  qed
  also have "\<dots> = percentile ys x"
    unfolding percentile_def ..
  finally show ?thesis .
qed

text \<open> In a sorted list of distinct elements with indices i and j holds that i is smaller than
  (or equal to) j if and only if the ith element is smaller than (or equal to) the jth. \<close>
lemma nth_leq_iff_index_leq:
  assumes "distinct xs" "sorted xs"
  assumes "i < length xs" "j < length xs"
  shows "xs ! i \<le> xs ! j \<longleftrightarrow> i \<le> j"
  using assms
  by (metis antisym nat_le_linear nth_eq_iff_index_eq sorted_nth_mono)

text \<open> If x \<le> x' and both correspond to a value of equidistant_points_on_unit_interval_of, that is,
     they are both defined then for the values y and y' holds that y \<le> y'. \<close>
lemma sorted_imp:
  assumes "sorted ys"
  assumes "equidistant_points_on_unit_interval_of ys x = Some y"
  assumes "equidistant_points_on_unit_interval_of ys x' = Some y'"
  assumes "x \<le> x'"
  shows "y \<le> y'"
proof -
  let ?xs = "map (\<lambda>x. (1 / length ys) * (x + 0.5)) [0..<length ys]"
  from assms(2) have "x \<in> dom (equidistant_points_on_unit_interval_of ys)" by blast
  from this obtain i where "x = ?xs ! i" and "i < length ys"
    unfolding equidistant_points_on_unit_interval_of_def
    apply auto
    by blast
  from assms(3) have "x' \<in> dom (equidistant_points_on_unit_interval_of ys)" by blast
  from this obtain i' where "x' = ?xs ! i'" and "i' < length ys"
    unfolding equidistant_points_on_unit_interval_of_def
    apply auto apply force done
  have "sorted ?xs \<and> distinct ?xs" using inj_onI divide_right_mono distinct_map
    by (auto intro!: inj_onI simp add: divide_right_mono  sorted_iff_nth_mono_less distinct_map)
  have "length ?xs = length ys" by auto
  from assms(2) \<open>x = _\<close> \<open>i < _\<close> have "y = ys ! i"
    unfolding equidistant_points_on_unit_interval_of_def
    using \<open>length _ = length _\<close> \<open>sorted _ \<and> distinct _\<close> by (metis map_of_zip_nth option.inject)
  from assms(3) \<open>x' = _\<close> \<open>i' < _\<close> have "y' = ys ! i'"
    unfolding equidistant_points_on_unit_interval_of_def
    using \<open>length _ = length _\<close> \<open>sorted _ \<and> distinct _\<close> by (metis map_of_zip_nth option.inject)
  from \<open>sorted _ \<and> distinct _\<close> \<open>x \<le> x'\<close> have "i \<le> i'"
    using \<open>x = _\<close> \<open>x' = _\<close> \<open>i < _\<close> \<open>i'< _\<close> \<open>length ?xs = length ys\<close>
    using nth_leq_iff_index_leq by fastforce
  show ?thesis
    using \<open>i \<le> i'\<close> \<open>y = ys ! i\<close> \<open>y' = ys ! i'\<close> \<open>i' < length ys\<close> \<open>sorted ys\<close>
    by (simp add: sorted_nth_mono)
qed

text \<open> The percentile function is (weakly) monotonic increasing. \<close>
lemma percentile_monotonic:
  assumes "ys \<noteq> []"
  assumes "1 / (2 * length ys) \<le> x" "x' \<le> 1 - 1 / (2 * length ys)"
  assumes "x \<le> x'"
  shows "percentile ys x \<le> percentile ys x'"
proof -
  have "percentile ys x = linear_interpolation (equidistant_points_on_unit_interval_of (sort ys)) x"
    unfolding percentile_def ..
  also have "\<dots> \<le> linear_interpolation (equidistant_points_on_unit_interval_of (sort ys)) x'"
  proof -
    from \<open>ys \<noteq> []\<close> have s: "sort ys \<noteq> []" by (simp add: sort_eq_Nil_iff)
    have "finite (dom (equidistant_points_on_unit_interval_of (sort ys)))" by simp
    moreover have "x \<in> defined_interval_of (equidistant_points_on_unit_interval_of (sort ys))"
      using defined_interval_of_equidistant_points_on_unit_interval_of
      using assms s atLeastAtMost_iff
      by fastforce
    moreover have "x' \<in> defined_interval_of (equidistant_points_on_unit_interval_of (sort ys))"
      using defined_interval_of_equidistant_points_on_unit_interval_of
      using assms atLeastAtMost_iff s by fastforce
    moreover have "\<forall>x x' y y'. x \<le> x' \<and> equidistant_points_on_unit_interval_of (sort ys) x = Some y
      \<and> equidistant_points_on_unit_interval_of (sort ys) x' = Some y' \<longrightarrow> y \<le> y'"
      using sorted_imp sorted_sort by blast
    moreover note \<open>x \<le> x'\<close>
    ultimately show ?thesis by (rule linear_interpolation_monotonic)
  qed
  also have "\<dots> \<le> percentile ys x'"
    unfolding percentile_def ..
  finally show ?thesis .
qed

text \<open> The percentile function scales by constant (positive) factors inside the definition interval.\<close>
lemma percentile_scale:
  assumes "length ys > 1"
  assumes "1 / (2 * length ys) \<le> x \<and> x \<le> 1 - 1 / (2 * length ys)"
  assumes "c > 0"
  assumes "sorted ys"
  shows "percentile (map (\<lambda> z. c*z) ys) x = c * percentile ys x"
proof -
  have a: "finite (dom ((equidistant_points_on_unit_interval_of ys)))" by simp
  have "x \<in> defined_interval_of (equidistant_points_on_unit_interval_of ys)"
    using equidistant_points_on_unit_interval_of_def
    by (metis (no_types, lifting) assms(1) assms(2) atLeastAtMost_iff
        defined_interval_of_equidistant_points_on_unit_interval_of le_less_trans le_numeral_extra(1)
        length_greater_0_conv)
  then have b: "linear_interpolation (\<lambda>y. map_option (\<lambda>z. c * z) ((equidistant_points_on_unit_interval_of ys) y)) x =
        c * linear_interpolation (equidistant_points_on_unit_interval_of ys)  x"
    using linear_interpolation_scale a by blast
  have c: "linear_interpolation (\<lambda>y. map_option (\<lambda>z. c * z) ((equidistant_points_on_unit_interval_of ys) y)) x =
        c * percentile ys x" by (simp add: assms(4) b percentile_def sorted_sort_id)
  have d: "map_option (\<lambda>z. c * z) ((equidistant_points_on_unit_interval_of ys) y) =
        (equidistant_points_on_unit_interval_of (map (\<lambda> z. c*z) ys)) y"
    using equidistant_points_on_unit_interval_of_def map_option_def map_def assms
    equidistant_linear by auto
  have "sort (map (\<lambda> z. c*z) ys) = map (\<lambda> z. c*z) (sort ys)" using assms(3) sorted_map
    by (simp add: assms(4) sorted_sort_id)
  then have d: "c * percentile ys x = linear_interpolation (equidistant_points_on_unit_interval_of (map (\<lambda> z. c*z) (sort ys))) x"
    using assms equidistant_linear d assms(4) c sorted_sort_id by fastforce
  then show ?thesis using percentile_def b c
    by (simp add: b \<open>sort (map ((*) c) ys) = map ((*) c) (sort ys)\<close>)
qed

text \<open> The percentile function is Lipschitz continuous. \<close>
lemma percentile_Lipschitz:
  assumes "ys \<noteq> []"
  assumes "1 / (2 * length ys) \<le> x \<and> x \<le> 1 - 1 / (2 * length ys)"
  assumes "1 / (2 * length ys) \<le> x' \<and> x' \<le> 1 - 1 / (2 * length ys)"
  shows "\<exists>K. \<bar>percentile ys x' - percentile ys x\<bar> \<le> K * \<bar>x' - x\<bar>"
proof -
  have "finite (dom (equidistant_points_on_unit_interval_of (sort ys)))" by simp
  moreover have "x \<in> defined_interval_of (equidistant_points_on_unit_interval_of (sort ys))"
    using defined_interval_of_equidistant_points_on_unit_interval_of
    using assms(1, 2) atLeastAtMost_iff
    by (simp add: sort_eq_Nil_iff)
  moreover have "x' \<in> defined_interval_of (equidistant_points_on_unit_interval_of (sort ys))"
    using defined_interval_of_equidistant_points_on_unit_interval_of
    using assms(1, 3) atLeastAtMost_iff
    by (simp add: sort_eq_Nil_iff)
  ultimately show ?thesis
    unfolding percentile_def by (rule linear_interpolation_Lipschitz)
qed

end


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

section \<open>Injections from A to B up to a Permutation on B\<close>

theory Twelvefold_Way_Entry8
imports Twelvefold_Way_Entry7
begin

subsection \<open>Properties for Bijections\<close>

lemma inj_on_implies_partitions_of:
  assumes "F \<in> (A \<rightarrow>\<^sub>E B) // range_permutation A B"
  assumes "univ (\<lambda>f. inj_on f A) F"
  shows "\<forall>X \<in> partitions_of A B F. card X = 1"
proof -
  from \<open>F \<in> (A \<rightarrow>\<^sub>E B) // range_permutation A B\<close> obtain f where "f \<in> A \<rightarrow>\<^sub>E B"
    and F_eq: "F = range_permutation A B `` {f}" using quotientE by blast
  from this \<open>univ (\<lambda>f. inj_on f A) F\<close> have "inj_on f A"
    using univ_commute'[OF equiv_range_permutation inj_on_respects_range_permutation \<open>f \<in> A \<rightarrow>\<^sub>E B\<close>] by simp
  have "\<forall>X\<in>(\<lambda>b. {x \<in> A. f x = b}) ` B - {{}}. card X = 1"
  proof
    fix X
    assume "X \<in> (\<lambda>b. {x \<in> A. f x = b}) ` B - {{}}"
    from this obtain x where "X = {xa \<in> A. f xa = f x}" "x \<in> A" by auto
    from this have "X = {x}"
      using \<open>inj_on f A\<close> by (auto dest!: inj_onD)
    from this show "card X = 1" by simp
  qed
  from this show ?thesis
    unfolding partitions_of_def F_eq
    using equiv_range_permutation domain_partitions_respects_range_permutation \<open>f \<in> A \<rightarrow>\<^sub>E B\<close>
    by (subst univ_commute') assumption+
qed

lemma unique_part_eq_singleton:
  assumes "partition_on A P"
  assumes "\<forall>X\<in>P. card X = 1"
  assumes "x \<in> A"
  shows "(THE X. x \<in> X \<and> X \<in> P) = {x}"
proof -
  have "(THE X. x \<in> X \<and> X \<in> P) \<in> P"
    using \<open>partition_on A P\<close> \<open>x \<in> A\<close> by (simp add: partition_on_the_part_mem)
  from this have "card (THE X. x \<in> X \<and> X \<in> P) = 1"
    using \<open>\<forall>X\<in>P. card X = 1\<close> by auto
  moreover have "x \<in> (THE X. x \<in> X \<and> X \<in> P)"
    using \<open>partition_on A P\<close> \<open>x \<in> A\<close> by (simp add: partition_on_in_the_unique_part)
  ultimately show ?thesis
    by (metis card_1_singletonE singleton_iff)
qed

lemma functions_of_is_inj_on:
  assumes "finite A" "finite B" "partition_on A P" "card P \<le> card B"
  assumes "\<forall>X\<in>P. card X = 1"
  shows "univ (\<lambda>f. inj_on f A) (functions_of P A B)"
proof -
  have "functions_of P A B \<in> (A \<rightarrow>\<^sub>E B) // range_permutation A B"
    using functions_of \<open>finite A\<close> \<open>finite B\<close> \<open>partition_on A P\<close> \<open>card P \<le> card B\<close> by blast
  from this obtain f where eq_f: "functions_of P A B = range_permutation A B `` {f}" and "f \<in> A \<rightarrow>\<^sub>E B"
    using quotientE by blast
  from eq_f have "f \<in> functions_of P A B"
    using \<open>f \<in> A \<rightarrow>\<^sub>E B\<close> equiv_range_permutation equiv_class_self by fastforce
  from this have eq: "(\<lambda>b. {x \<in> A. f x = b}) ` B - {{}} = P"
    unfolding functions_of_def by auto
  have "inj_on f A"
  proof (rule inj_onI)
    fix x y
    assume "x \<in> A" "y \<in> A" "f x = f y"
    from \<open>x \<in> A\<close> have "x \<in> {x' \<in> A. f x' = f x}" by auto
    moreover from \<open>y \<in> A\<close> \<open>f x = f y\<close> have "y \<in> {x' \<in> A. f x' = f x}" by auto
    moreover have "card {x' \<in> A. f x' = f x} = 1"
    proof -
      from \<open>x \<in> A\<close> \<open>f \<in> A \<rightarrow>\<^sub>E B\<close> have "f x \<in> B" by auto
      from this \<open>x \<in> A\<close> have "{x' \<in> A. f x' = f x} \<in> (\<lambda>b. {x \<in> A. f x = b}) ` B - {{}}" by auto
      from this \<open>\<forall>X\<in>P. card X = 1\<close> eq show ?thesis by auto
    qed
    ultimately show "x = y" by (metis card_1_singletonE singletonD)
  qed
  from this show ?thesis
    unfolding eq_f using equiv_range_permutation inj_on_respects_range_permutation \<open>f \<in> A \<rightarrow>\<^sub>E B\<close>
    by (subst univ_commute') assumption+
qed

subsection \<open>Bijections\<close>

lemma bij_betw_partitions_of:
  assumes "finite A" "finite B"
  shows "bij_betw (partitions_of A B) ({f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // range_permutation A B) {P. partition_on A P \<and> card P \<le> card B \<and> (\<forall>X\<in>P. card X = 1)}"
proof (rule bij_betw_byWitness[where f'="\<lambda>P. functions_of P A B"])
  have quotient_eq: "{f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // range_permutation A B = {F \<in> ((A \<rightarrow>\<^sub>E B) // range_permutation A B). univ (\<lambda>f. inj_on f A) F}"
    by (simp add: equiv_range_permutation inj_on_respects_range_permutation univ_preserves_predicate)
  show "\<forall>F\<in>{f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // range_permutation A B. functions_of (partitions_of A B F) A B = F"
    using \<open>finite B\<close> by (simp add: quotient_eq functions_of_partitions_of)
  show "\<forall>P\<in>{P. partition_on A P \<and> card P \<le> card B \<and> (\<forall>X\<in>P. card X = 1)}. partitions_of A B (functions_of P A B) = P"
    using \<open>finite A\<close> \<open>finite B\<close> by (simp add: partitions_of_functions_of)
  show "partitions_of A B ` ({f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // range_permutation A B) \<subseteq> {P. partition_on A P \<and> card P \<le> card B \<and> (\<forall>X\<in>P. card X = 1)}"
    using \<open>finite B\<close> quotient_eq partitions_of inj_on_implies_partitions_of by fastforce
  show "(\<lambda>P. functions_of P A B) ` {P. partition_on A P \<and> card P \<le> card B \<and> (\<forall>X\<in>P. card X = 1)} \<subseteq> {f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // range_permutation A B"
    using \<open>finite A\<close> \<open>finite B\<close> by (auto simp add: quotient_eq intro: functions_of functions_of_is_inj_on)
qed

subsection \<open>Cardinality\<close>

lemma card_injective_functions_range_permutation:
  assumes "finite A" "finite B"
  shows "card ({f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // range_permutation A B) = iverson (card A \<le> card B)"
proof -
  obtain enum where "bij_betw enum {0..<card A} A"
    using \<open>finite A\<close> ex_bij_betw_nat_finite by blast
  have "bij_betw (partitions_of A B) ({f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // range_permutation A B) {P. partition_on A P \<and> card P \<le> card B \<and> (\<forall>X\<in>P. card X = 1)}"
    using \<open>finite A\<close> \<open>finite B\<close> by (rule bij_betw_partitions_of)
  from this have "card ({f \<in> A \<rightarrow>\<^sub>E B. inj_on f A} // range_permutation A B) = card {P. partition_on A P \<and> card P \<le> card B \<and> (\<forall>X\<in>P. card X = 1)}"
    by (rule bij_betw_same_card)
  also have "card {P. partition_on A P \<and> card P \<le> card B \<and> (\<forall>X\<in>P. card X = 1)} = iverson (card A \<le> card B)"
    using \<open>finite A\<close> by (rule card_partition_on_size1_eq_iverson)
  finally show ?thesis .
qed

end


\<^marker>\<open>creator "Alexander Krauss"\<close>
\<^marker>\<open>creator "Josh Chen"\<close>
\<^marker>\<open>creator "Kevin Kappelmann"\<close>
subsubsection \<open>Multiplication\<close>
theory Nat_Mul
  imports Nat_Add
begin

definition "nat_mul m n = nat_rec m 0 (nat_add n)"

lemma nat_mul_type [type]: "nat_mul : Nat \<Rightarrow> Nat \<Rightarrow> Nat"
  unfolding nat_mul_def by auto

bundle isa_set_nat_mul_syntax begin notation nat_mul (infixl "*" 70) end
bundle no_isa_set_nat_mul_syntax begin no_notation nat_mul (infixl "*" 70) end

unbundle isa_set_nat_mul_syntax

lemma zero_nat_mul_eq [simp]: "0 * n = 0"
  unfolding nat_mul_def by simp

lemma Nat_succ_mul_eq: "m : Nat \<Longrightarrow> succ m * n = n + (m * n)"
  unfolding nat_mul_def by simp

lemma Nat_mul_zero_eq [simp]: "n : Nat \<Longrightarrow> n * 0 = 0"
  by (induction n rule: Nat_induct) (auto simp: nat_mul_def)

lemma Nat_one_mul_eq [simp]: "n : Nat \<Longrightarrow> 1 * n = n"
  unfolding nat_mul_def nat_one_def by simp

lemma Nat_mul_one_eq [simp]: "n : Nat \<Longrightarrow> n * 1 = n"
  by (induction n rule: Nat_induct) (auto simp: nat_mul_def nat_one_def)

lemma Nat_mul_add_eq_mul_add_mul:
  assumes "l : Nat" "m : Nat" "n : Nat"
  shows "l * (m + n) = (l * m) + (l * n)"
using assms
proof (induction l rule: Nat_induct)
  case (succ l)
  from Nat_succ_mul_eq have "succ l * (m + n) = m + n + l * (m + n)" by simp
  also with succ.IH have "... = m + n + (l * m + l * n)" by simp
  also have "... = m + l * m + (n + l * n)" by (simp only: Nat_add_AC_rules)
  also have "... = succ l * m + succ l * n" by (simp only: Nat_succ_mul_eq)
  finally show ?case .
qed simp

lemma Nat_mul_comm: "m : Nat \<Longrightarrow> n : Nat \<Longrightarrow> m * n = n * m"
proof (induction m arbitrary: n rule: Nat_induct)
  case (succ m)
  with Nat_succ_mul_eq have "succ m * n = n + (n * m)" by simp
  then show ?case
    by (simp add: nat_add_one_eq_succ[symmetric]
      Nat_mul_add_eq_mul_add_mul Nat_add_comm)
qed simp

lemma Nat_add_mul_eq_mul_add_mul:
  assumes "l : Nat" "m : Nat" "n : Nat"
  shows "(l + m) * n = l * n + m * n"
  by (simp only: Nat_mul_comm Nat_mul_add_eq_mul_add_mul)

lemma Nat_mul_assoc:
  "l : Nat \<Longrightarrow> m : Nat \<Longrightarrow> n : Nat \<Longrightarrow> l * m * n = l * (m * n)"
  by (induction l rule: Nat_induct)
    (auto simp: Nat_succ_mul_eq Nat_add_mul_eq_mul_add_mul)

lemma Nat_mul_comm_left:
  "\<lbrakk>l : Nat; m : Nat; n: Nat\<rbrakk> \<Longrightarrow> l * (m * n) = m * (l * n)"
  by (induction l rule: Nat_induct)
    (auto simp: Nat_succ_mul_eq Nat_mul_add_eq_mul_add_mul)

lemmas Nat_mul_AC_rules = Nat_mul_comm Nat_mul_assoc Nat_mul_comm_left

lemma Nat_mul_ne_zero_if_ne_zero_if_ne_zero:
  assumes "m : Nat" "n : Nat"
  and "m \<noteq> 0" "n \<noteq> 0"
  shows "m * n \<noteq> 0"
using assms
proof (induction m rule: Nat_induct)
  case (succ m)
  from \<open>n \<noteq> 0\<close> have "0 < n" by (simp add: Nat_zero_lt_iff_ne_zero)
  moreover have "... \<le> n + m * n" by (simp only: Nat_le_add)
  moreover have "... = succ m * n" by (simp only: Nat_succ_mul_eq)
  ultimately have "0 < succ m * n" by (simp only: Nat_lt_if_le_if_lt)
  then show ?case by (simp add: Nat_zero_lt_iff_ne_zero)
qed simp

corollary Nat_mul_eq_zero_iff:
  "\<lbrakk>m : Nat; n : Nat\<rbrakk> \<Longrightarrow> m * n = 0 \<longleftrightarrow> m = 0 \<or> n = 0"
  using Nat_mul_ne_zero_if_ne_zero_if_ne_zero by auto

corollary "Nat_mul_eq_zeroE":
  assumes "m : Nat" "n : Nat"
  and "m * n = 0"
  obtains (left_zero) "m = 0" | (right_zero) "n = 0"
  using assms Nat_mul_eq_zero_iff by auto

end


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

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

datatype Nat = Z | S "Nat"

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

fun le :: "Nat => Nat => bool" where
  "le (Z) z = True"
| "le (S z2) (Z) = False"
| "le (S z2) (S x2) = le z2 x2"

fun sort2 :: "Nat => Nat => Nat list" where
  "sort2 y z =
   (if le y z then cons2 y (cons2 z (nil2)) else
      cons2 z (cons2 y (nil2)))"

fun pairs :: "Nat list => Nat list => Nat list" where
  "pairs (nil2) z = z"
| "pairs (cons2 z2 x2) (nil2) = cons2 z2 x2"
| "pairs (cons2 z2 x2) (cons2 x3 x4) =
     x (sort2 z2 x3) (pairs x2 x4)"

fun stitch :: "Nat list => Nat list => Nat list" where
  "stitch (nil2) z = z"
| "stitch (cons2 z2 xs) z = cons2 z2 (pairs xs z)"

function evens :: "'a list => 'a list"
  and odds :: "'a list => 'a list" where
  "evens (nil2) = nil2"
| "evens (cons2 z xs) = cons2 z (odds xs)"
| "odds (nil2) = nil2"
| "odds (cons2 z xs) = evens xs"
  by pat_completeness auto

fun elem :: "'a => 'a list => bool" where
  "elem y (nil2) = False"
| "elem y (cons2 z2 xs) = ((z2 = y) | (elem y xs))"

fun deleteBy :: "('a => ('a => bool)) => 'a => 'a list =>
                 'a list" where
  "deleteBy y z (nil2) = nil2"
| "deleteBy y z (cons2 y2 ys) =
     (if (y z) y2 then ys else cons2 y2 (deleteBy y z ys))"

fun isPermutation :: "'a list => 'a list => bool" where
  "isPermutation (nil2) (nil2) = True"
| "isPermutation (nil2) (cons2 z2 x2) = False"
| "isPermutation (cons2 x3 xs) z =
     ((elem x3 z) &
        (isPermutation
           xs (deleteBy (% (x4 :: 'a) => % (x5 :: 'a) => (x4 = x5)) x3 z)))"

(*fun did not finish the proof*)
function bmerge :: "Nat list => Nat list => Nat list" where
  "bmerge (nil2) z = nil2"
| "bmerge (cons2 z2 x2) (nil2) = cons2 z2 x2"
| "bmerge (cons2 z2 x2) (cons2 x3 x4) =
     (let fail :: Nat list =
       stitch
         (bmerge (evens (cons2 z2 x2)) (evens (cons2 x3 x4)))
         (bmerge (odds (cons2 z2 x2)) (odds (cons2 x3 x4)))
     in (case x2 of
           nil2 =>
             (case x4 of
                nil2 => sort2 z2 x3
                | cons2 x5 x6 => fail)
           | cons2 x7 x8 => fail))"
  by pat_completeness auto

(*fun did not finish the proof*)
function bsort :: "Nat list => Nat list" where
  "bsort (nil2) = nil2"
| "bsort (cons2 z (nil2)) = cons2 z (nil2)"
| "bsort (cons2 z (cons2 x2 x3)) =
     bmerge
       (bsort (evens (cons2 z (cons2 x2 x3))))
       (bsort (odds (cons2 z (cons2 x2 x3))))"
  by pat_completeness auto

theorem property0 :
  "isPermutation (bsort xs) xs"
  oops

end


theory StructualInduction
  imports Main
begin

lemma "\<Sum>{0..(n::nat)} = n * (n + 1) div 2"
proof (induction n)
  case 0
  show ?case by simp
next
  case (Suc n)
  thus ?case by simp
qed

end


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

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

datatype Nat = Z | S "Nat"

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

fun le :: "Nat => Nat => bool" where
  "le (Z) z = True"
| "le (S z2) (Z) = False"
| "le (S z2) (S x2) = le z2 x2"

fun sort2 :: "Nat => Nat => Nat list" where
  "sort2 y z =
   (if le y z then cons2 y (cons2 z (nil2)) else
      cons2 z (cons2 y (nil2)))"

fun pairs :: "Nat list => Nat list => Nat list" where
  "pairs (nil2) z = z"
| "pairs (cons2 z2 x2) (nil2) = cons2 z2 x2"
| "pairs (cons2 z2 x2) (cons2 x3 x4) =
     x (sort2 z2 x3) (pairs x2 x4)"

fun stitch :: "Nat list => Nat list => Nat list" where
  "stitch (nil2) z = z"
| "stitch (cons2 z2 xs) z = cons2 z2 (pairs xs z)"

fun insert :: "Nat => Nat list => Nat list" where
  "insert y (nil2) = cons2 y (nil2)"
| "insert y (cons2 z2 xs) =
     (if le y z2 then cons2 y (cons2 z2 xs) else
        cons2 z2 (insert y xs))"

fun isort :: "Nat list => Nat list" where
  "isort (nil2) = nil2"
| "isort (cons2 z xs) = insert z (isort xs)"

function evens :: "'a list => 'a list"
  and odds :: "'a list => 'a list" where
  "evens (nil2) = nil2"
| "evens (cons2 z xs) = cons2 z (odds xs)"
| "odds (nil2) = nil2"
| "odds (cons2 z xs) = evens xs"
  by pat_completeness auto

(*fun did not finish the proof*)
function bmerge :: "Nat list => Nat list => Nat list" where
  "bmerge (nil2) z = nil2"
| "bmerge (cons2 z2 x2) (nil2) = cons2 z2 x2"
| "bmerge (cons2 z2 x2) (cons2 x3 x4) =
     (let fail :: Nat list =
       stitch
         (bmerge (evens (cons2 z2 x2)) (evens (cons2 x3 x4)))
         (bmerge (odds (cons2 z2 x2)) (odds (cons2 x3 x4)))
     in (case x2 of
           nil2 =>
             (case x4 of
                nil2 => sort2 z2 x3
                | cons2 x5 x6 => fail)
           | cons2 x7 x8 => fail))"
  by pat_completeness auto

(*fun did not finish the proof*)
function bsort :: "Nat list => Nat list" where
  "bsort (nil2) = nil2"
| "bsort (cons2 z (nil2)) = cons2 z (nil2)"
| "bsort (cons2 z (cons2 x2 x3)) =
     bmerge
       (bsort (evens (cons2 z (cons2 x2 x3))))
       (bsort (odds (cons2 z (cons2 x2 x3))))"
  by pat_completeness auto

theorem property0 :
  "((bsort xs) = (isort xs))"
  oops

end


theory FOL_formula
imports axioms_class_existence auxiliary0
begin

text{* A first order logic (FOL) term is either a variable indexed by Isabelle's built in
       natural numbers (\texttt{FVar nat}) or a constant of type \texttt{Class}.
*}
datatype FOL_Term = FVar nat | FConst Class

text{* An FOL formula for NBG is either built from FOL Terms as follows. The names
       given are the standard names for building formulas, with an \texttt{F} in the front
       to differentiate these formulas from Isabelle's built-in HOL counterparts. *}
datatype FOL_Formula =
  FTrue | FFalse | FBelongs FOL_Term FOL_Term | FEquals FOL_Term FOL_Term
  | FAnd FOL_Formula FOL_Formula | FOr FOL_Formula FOL_Formula | FNot FOL_Formula
  | FImp FOL_Formula FOL_Formula | FIff FOL_Formula FOL_Formula
  | FEx nat FOL_Formula | FAll nat FOL_Formula

text{* A FOL evaluation takes a \texttt{FOL_Term} and an interpretation of the variables to sets
       (a metafunction from \texttt{nat} to \texttt{Set}), and returns a set or a class,
       depending on which of the two FOL terms it evaluates.  *}
primrec FOL_Eval :: "FOL_Term \<Rightarrow> (nat \<Rightarrow> Set) \<Rightarrow> Class"
where
  "FOL_Eval (FVar n) i = i(n)"
  | "FOL_Eval (FConst c) i = c"

text{* The function \texttt{Update} takes an interpretation \texttt{i} of variables to sets, an
       Isabelle-natural number \texttt{n} (of type \texttt{nat}), and a set \texttt{x}, and
       returns an interpretation that sends the \texttt{n}-th set-variable to \texttt{x}. *}
definition Update :: "[nat \<Rightarrow> Set, nat, Set] \<Rightarrow> (nat \<Rightarrow> Set)"
where "Update f n x = (\<lambda>k. if k = n then x else f(k))"

text{* The function \texttt{FOL_True} evaluates a FOL formula, given an interpretation,
       to Isabelle's \texttt{True}/\texttt{False}. *}
primrec FOL_True :: "FOL_Formula \<Rightarrow> (nat \<Rightarrow> Set) \<Rightarrow> bool"
where
  "FOL_True FTrue i = True"
  | "FOL_True FFalse i = False"
  | "FOL_True (FBelongs x y) i = FOL_Eval x i \<in> FOL_Eval y i"
  | "FOL_True (FEquals x y) i = (FOL_Eval x i = FOL_Eval y i)"
  | "FOL_True (FAnd \<phi> \<psi>) i = ((FOL_True \<phi> i) \<and> (FOL_True \<psi> i))"
  | "FOL_True (FOr \<phi> \<psi>) i = ((FOL_True \<phi> i) \<or> (FOL_True \<psi> i))"
  | "FOL_True (FNot \<phi>) i = (\<not>(FOL_True \<phi> i))"
  | "FOL_True (FImp \<phi> \<psi>) i = ((FOL_True \<phi> i) \<longrightarrow> (FOL_True \<psi> i))"
  | "FOL_True (FIff \<phi> \<psi>) i = ((FOL_True \<phi> i) \<longleftrightarrow> (FOL_True \<psi> i))"
  | "FOL_True (FEx n \<phi>) i = (\<exists>y :: Set. FOL_True \<phi> (Update i n y))"
  | "FOL_True (FAll n \<phi>) i = (\<forall>y :: Set. FOL_True \<phi> (Update i n y))"

text{* \texttt{FOL_Var} returns the number of a FOL Term, if that Term is a FOL set-variable
       (\texttt{FVar}), otherwise it returns 0. For this reason, we should never use 0 for an
       \texttt{FVar}, when we are defining our own FOL formulas. *}
primrec FOL_Var :: "FOL_Term \<Rightarrow> nat"
where
  "FOL_Var (FVar n) = n"
  | "FOL_Var (FConst c) = 0"

text{* \texttt{FOL_MaxVar} takes a FOL formula and returns the largest variable number
       of all the variables occurring in the formula (includes bound variables). Useful
       when we want to be sure that we are using a variable that doesn't occur in a formula. *}
primrec FOL_MaxVar :: "FOL_Formula \<Rightarrow> nat"
where
  "FOL_MaxVar FTrue = 0"
  | "FOL_MaxVar FFalse = 0"
  | "FOL_MaxVar (FBelongs x y) = max (FOL_Var x) (FOL_Var y)"
  | "FOL_MaxVar (FEquals x y) = max (FOL_Var x) (FOL_Var y)"
  | "FOL_MaxVar (FAnd \<phi> \<psi>) = max (FOL_MaxVar \<phi>) (FOL_MaxVar \<psi>)"
  | "FOL_MaxVar (FNot \<phi>) = FOL_MaxVar \<phi>"
  | "FOL_MaxVar (FOr \<phi> \<psi>) = max (FOL_MaxVar \<phi>) (FOL_MaxVar \<psi>)"
  | "FOL_MaxVar (FImp \<phi> \<psi>) = max (FOL_MaxVar \<phi>) (FOL_MaxVar \<psi>)"
  | "FOL_MaxVar (FIff \<phi> \<psi>) = max (FOL_MaxVar \<phi>) (FOL_MaxVar \<psi>)"
  | "FOL_MaxVar (FEx n \<phi>) = FOL_MaxVar \<phi>"
  | "FOL_MaxVar (FAll n \<phi>) = FOL_MaxVar \<phi>"

lemma FOL_MaxVar_Dom:
  shows "\<forall> i j :: (nat \<Rightarrow> Set). (\<forall>(k::nat) \<le> FOL_MaxVar \<phi>. i(k) = j(k)) \<longrightarrow>
                                (FOL_True \<phi> i \<longleftrightarrow> FOL_True \<phi> j)"
text{* For all $i$, $j$ interpretations, if the interpretations
       $i$ and $j$ agree on every every Isabelle-natural number $k$ that is less than the largest
       variable index occurring in a FOL_Formula $\phi$, then $i$ and $j$ result in the same
       \texttt{FOL_True}-evaluation of $\phi$. *}
proof (induction \<phi>, simp_all; rule allI, rule allI, rule impI)
                                                          --"By induction on FOL_Formula complexity"
  fix x1 x2 :: "FOL_Term"
  fix i j   :: "nat \<Rightarrow> Set"
  assume assm1: "(\<forall>k\<le>max (FOL_Var x1) (FOL_Var x2). i k = j k)"
  thus 1: "(FOL_Eval x1 i \<in> FOL_Eval x2 i \<longleftrightarrow> FOL_Eval x1 j \<in> FOL_Eval x2 j)"
    by (metis FOL_Eval.simps(1) FOL_Eval.simps(2) FOL_Term.exhaust FOL_Var.simps(1) max.cobounded1
      max.cobounded2)
  from assm1 show 2: "(FOL_Eval x1 i = FOL_Eval x2 i) \<longleftrightarrow> (FOL_Eval x1 j = FOL_Eval x2 j)"
    by (metis FOL_Eval.simps(1) FOL_Eval.simps(2) FOL_Term.exhaust FOL_Var.simps(1) max.cobounded1
      max.cobounded2)
(* Identical proof as above, show 1 and 2 doesn't work. Would be nice to have a "similarly"
   (or, more precicely, a "exactly as above"). *)
next
  fix \<phi>1 \<phi>2 :: FOL_Formula
  fix i j    :: "nat \<Rightarrow> Set"
  assume IH\<phi>1:  "\<forall>i j. (\<forall>k\<le>FOL_MaxVar \<phi>1. i(k) = j(k)) \<longrightarrow> FOL_True \<phi>1 i = FOL_True \<phi>1 j"
     and IH\<phi>2:  "\<forall>i j. (\<forall>k\<le>FOL_MaxVar \<phi>2. i(k) = j(k)) \<longrightarrow> FOL_True \<phi>2 i = FOL_True \<phi>2 j"
     and assm2: "\<forall>k\<le>max (FOL_MaxVar \<phi>1) (FOL_MaxVar \<phi>2). i(k) = j(k)"
  show 3: " (FOL_True \<phi>1 i \<and> FOL_True \<phi>2 i) \<longleftrightarrow> (FOL_True \<phi>1 j \<and> FOL_True \<phi>2 j)"
    by (metis IH\<phi>1 IH\<phi>2 assm2 dual_order.trans max.cobounded2 max_def)
  show 4: "(FOL_True \<phi>1 i \<or> FOL_True \<phi>2 i) \<longleftrightarrow> (FOL_True \<phi>1 j \<or> FOL_True \<phi>2 j)"
    by (metis IH\<phi>1 IH\<phi>2 assm2 dual_order.trans max.cobounded2 max_def)
  show 5: "(FOL_True \<phi>1 i \<longrightarrow> FOL_True \<phi>2 i) \<longleftrightarrow> (FOL_True \<phi>1 j \<longrightarrow> FOL_True \<phi>2 j)"
    by (metis IH\<phi>1 IH\<phi>2 assm2 dual_order.trans max.cobounded2 max_def)
  show 6: "(FOL_True \<phi>1 i = FOL_True \<phi>2 i) = (FOL_True \<phi>1 j = FOL_True \<phi>2 j)"
    by (metis IH\<phi>1 IH\<phi>2 assm2 dual_order.trans max.cobounded2 max_def)
next
  fix n :: nat
  fix \<phi> :: FOL_Formula
  fix i j :: "nat \<Rightarrow> Set"
  assume IH\<phi>:   "\<forall>i j. (\<forall>k\<le>FOL_MaxVar \<phi>. i k = j k) \<longrightarrow> FOL_True \<phi> i = FOL_True \<phi> j"
     and assm3: "\<forall>k\<le>FOL_MaxVar \<phi>. i k = j k"
  show 8: "(\<forall>y::Set. FOL_True \<phi> (Update i n y)) \<longleftrightarrow> (\<forall>y::Set. FOL_True \<phi> (Update j n y))"
    unfolding Update_def using IH\<phi> assm3 by (metis (no_types, lifting))
  thus 7: "(\<exists>y::Set. FOL_True \<phi> (Update i n y)) \<longleftrightarrow> (\<exists>y::Set. FOL_True \<phi> (Update j n y))"
    unfolding Update_def using IH\<phi> assm3 by (metis (no_types, lifting))
qed

text{* The following predicate is what we are aiming for. For class comprehension we
       want to show that for every FOL\_Formula and every Isabelle-natural number $n$,
       there exists a class $C$ that contains exactly those tuples, which satisfy $\phi$. *}

definition Class_Ex :: "FOL_Formula \<Rightarrow> nat \<Rightarrow> bool"
where "Class_Ex \<phi> n \<equiv> \<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> FOL_True \<phi> i"
-- "There exists a class C which contains exactly those (n+1)-tuples which satisfy \<phi>.
    We want to show that this is always true, for any FOL_Formula \<phi> and for n largest index
    appearing in \<phi> (lemma Class_Existence)."

lemma Class_Ex_Mono: "Class_Ex \<phi> (FOL_MaxVar \<phi>) \<Longrightarrow> Class_Ex \<phi> (FOL_MaxVar \<phi> + k)"
text{* If there is a class that contains all the \tt{n+1}-tuples which satisfy \tt{$\phi$}, where
       \tt{n} is the largest variable index occurring in \tt{$\phi$}, then for any \tt{k::nat},
       there is a class that contains all the \tt{(n+k+1)}-tuples with this property. *}
proof -
  assume "Class_Ex \<phi> (FOL_MaxVar \<phi>)"
  then obtain C where C_def: "\<forall>i. \<langle>\<dots>, i(FOL_MaxVar \<phi>)\<rangle> \<in> C \<longleftrightarrow> FOL_True \<phi> i"
    unfolding Class_Ex_def by blast
  then obtain D where "\<forall>i. \<langle>\<dots>, i(FOL_MaxVar \<phi> + k)\<rangle> \<in> D \<longleftrightarrow> \<langle>\<dots>, i(FOL_MaxVar \<phi>)\<rangle> \<in> C"
    using Ex_4_11_d by blast
  with C_def have "\<forall>i. \<langle>\<dots>, i(FOL_MaxVar \<phi> + k)\<rangle> \<in> D \<longleftrightarrow> FOL_True \<phi> i" by blast
  thus ?thesis unfolding Class_Ex_def by blast
qed

lemma Class_Ex_Mono2: "\<lbrakk>FOL_MaxVar \<phi> \<le> n; Class_Ex \<phi> (FOL_MaxVar \<phi>)\<rbrakk> \<Longrightarrow> Class_Ex \<phi> n"
text{* Consequently, if $n$ is greater or equal to $m$, the largest variable index occurring
       in $\phi$, and if there is a class containing all the $m$-tuples that satisfy $\phi$ under
       any interpretation, then there is a class containing all the $n$-tuples that satisfy
       $\phi$ under any interpretation. *}
using Class_Ex_Mono le_Suc_ex by blast

text{* To prove that for any FOL formula $\phi$, there is a class that contains all the
       sets that appear last in an $n$-tuple which satisfies $\phi$ under any interpretation,
       we prove the following lemmas, towards an induction on the complexity of FOL formulas. *}

lemma Class_Ex_True: "Class_Ex FTrue n" --"Atomic case FOL's True."
unfolding Class_Ex_def using Ex4_9_b by (simp, blast)

lemma Class_Ex_False: "Class_Ex FFalse n" --"Atomic case FOL's False."
unfolding Class_Ex_def using empty_set by (simp, blast)

lemma Class_Ex_Belongs_CC: "Class_Ex (FBelongs (FConst c) (FConst d))
  (FOL_MaxVar (FBelongs (FConst c) (FConst d)))" --"Atomic case \<in>-relation with Class-constants"
proof (unfold Class_Ex_def, simp)
  show "\<exists>C. \<forall>i :: nat \<Rightarrow> Set. i 0 \<in> C = c \<in> d"
  proof (cases "c \<in> d")
    assume "c \<in> d"
    thus ?thesis using Ex4_9_b by auto
  next
    assume "c \<notin> d"
    thus ?thesis using empty_set by auto
  qed
qed

lemma Tuple_Last: "\<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> i(n) \<in> X"
proof (cases "n = 0")
  assume "n = 0"
  thus ?thesis by auto
next
  assume "n \<noteq> 0"
  then obtain l where "n = Suc l" using not0_implies_Suc by blast
  moreover obtain C where "\<forall>v. \<forall>i. \<langle>\<dots>, i(l), v\<rangle> \<in> C \<longleftrightarrow> v \<in> X" using Ex_4_11_f by blast
  ultimately have "\<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> i(n) \<in> X" by simp
  thus ?thesis ..
qed

lemma Class_Ex_Belongs_VC: "Class_Ex (FBelongs (FVar n) (FConst c))
  (FOL_MaxVar (FBelongs (FVar n) (FConst c)))"
--"Atomic case \<in>-relation with a Set-variable and a Class-constant"
by (unfold Class_Ex_def, simp, blast intro: Tuple_Last)

lemma Tuple_Extend1: "\<exists>C. \<forall>i. \<langle>\<dots>, i(Suc k), i(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, i(k), i(n)\<rangle> \<in> X"
using Ex_4_11_b by (simp, blast)

lemma Tuple_Extend2: "n > 0 \<Longrightarrow> \<forall>X. \<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, i(n - Suc m), i(n)\<rangle> \<in> X"
proof (induct "m", simp_all)
  assume "0 < n"
  then have "Suc (n - Suc 0) = n" by simp
  hence "\<forall>i. \<langle>\<dots>, i(n)\<rangle> = \<langle>\<dots>, i(n - Suc 0), i(n)\<rangle>" by (metis ToTuple.simps(2))
  thus "\<forall>X. \<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, i(n - Suc 0), i(n)\<rangle> \<in> X" by auto
next
  fix m
  assume a1: "\<forall>X. \<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, i(n - Suc m), i n\<rangle> \<in> X"
  assume "0 < n"
  show "\<forall>X. \<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, i(n - Suc (Suc m)), i n\<rangle> \<in> X"
  proof (rule allI, cases "Suc m \<ge> n")
    fix X
    assume "n \<le> Suc m"
    hence "n - Suc (Suc m) = n - Suc m" by simp
    with a1 show "\<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>,  i(n - Suc (Suc m)), i n\<rangle> \<in> X" by simp
  next
    fix X
    assume "\<not> n \<le> Suc m"
    hence eq: "n - Suc m = Suc (n - Suc (Suc m))" by simp
    obtain C where C_def:
      "\<forall>i. \<langle>\<dots>, i(Suc (n - Suc (Suc m))), i(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, i(n - Suc (Suc m)), i n\<rangle> \<in> X"
      using Tuple_Extend1 by blast
    from a1 obtain D where "\<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> D \<longleftrightarrow> \<langle>\<dots>, i(n - Suc m), i n\<rangle> \<in> C"
      by blast
    with C_def eq show "\<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, i(n - Suc (Suc m)), i n\<rangle> \<in> X" by auto
  qed
qed

lemma Tuple_Extend3: "k < n \<Longrightarrow> \<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, i(k), i(n)\<rangle> \<in> X"
proof -
  assume "k < n"
  then obtain l where "k = n - Suc l" by (metis Suc_diff_Suc diff_diff_cancel less_imp_le)
  with `k < n` show ?thesis using Tuple_Extend2 [of n l] by simp
qed

lemma Tuple_Extend4: "k < n \<Longrightarrow> \<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>i(k), i(n)\<rangle> \<in> X"
proof (cases "k = 0")
  assume "k < n" "k = 0"
  thus ?thesis using Tuple_Extend3 [of k n] by simp
next
  assume "k < n" "k \<noteq> 0"
  then obtain l where "k = Suc l" using not0_implies_Suc by blast
  moreover obtain C where "\<forall>i. \<langle>i(k), i(n), \<langle>\<dots>, i(l)\<rangle>\<rangle> \<in> C \<longleftrightarrow> \<langle>i(k), i(n)\<rangle> \<in> X" using B5 by blast
  moreover then obtain D where "\<forall>u v w. \<langle>u, v, w\<rangle> \<in> D \<longleftrightarrow> \<langle>v, w, u\<rangle> \<in> C" using B6 by blast
  ultimately have "\<forall>i. \<langle>\<dots>, i(k), i(n)\<rangle> \<in> D \<longleftrightarrow> \<langle>i(k), i(n)\<rangle> \<in> X" by simp
  moreover with `k < n` obtain E where "\<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> E \<longleftrightarrow> \<langle>\<dots>, i(k), i(n)\<rangle> \<in> D"
    using Tuple_Extend3 by blast
  ultimately show ?thesis by auto
qed

definition Swap :: "[nat \<Rightarrow> Set, nat, nat] \<Rightarrow> (nat \<Rightarrow> Set)"
where "Swap f n m = (\<lambda>k. if k = n then f(m) else if k = m then f(n) else f(k))"

lemma Double_Swap: "Swap (Swap f n m) n m = f"
unfolding Swap_def by auto

lemma Update_Swap: "Update (Swap f m n) n y = Swap (Update f m y) m n"
unfolding Update_def Swap_def by auto

text{* \textbf{FOMUS workshop extra exercise:} *}

lemma Tuple_Swap: "k < n \<Longrightarrow> (\<exists>C. \<forall>i. \<langle>\<dots>, (Swap i k n)(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, i(n)\<rangle> \<in> X)"
sorry

lemma Tuple_Swap_Inter: "\<forall>i. \<langle>\<dots>, (Swap i k n)(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, i(n)\<rangle> \<in> X \<Longrightarrow>
  \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, (Swap i k n)(n)\<rangle> \<in> X"
using Double_Swap by metis

lemma Class_Project1: "\<exists>C. \<forall>x y. \<langle>x, y\<rangle> \<in> C \<longleftrightarrow> (\<exists>z. \<langle>x, z\<rangle> \<in> X)"
--"Class existence for the projection class."
using B4 [of X] B5 [of "dom X"] by simp

lemma Class_Project2: "\<exists>C. \<forall>i. \<langle>\<dots>, i(0)\<rangle> \<in> C \<longleftrightarrow> (\<exists>y. \<langle>\<dots>, (Update i 0 y)(0)\<rangle> \<in> X)"
unfolding Update_def using Ex4_9_b by auto

lemma Class_Project3: "0 < n \<Longrightarrow> \<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C
  \<longleftrightarrow> (\<exists>y. \<langle>\<dots>, (Update i n y)(n)\<rangle> \<in> X)"
proof -
  assume "0 < n"
  then obtain m where "n = Suc m" using not0_implies_Suc by blast
  have "\<exists>C. \<forall>v. \<forall>i. \<langle>\<dots>, i(m), v\<rangle> \<in> C \<longleftrightarrow> (\<exists>y. \<langle>\<dots>, i(m), y\<rangle> \<in> X)"
      using Class_Project1 by blast
    with `n = Suc m` have "\<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> (\<exists>y. \<langle>\<dots>, i(m), y\<rangle> \<in> X)" by auto
  moreover have "\<forall>i. \<forall>y. \<langle>\<dots>, i(m), y\<rangle> =  ToTuple (\<lambda>l. if l = n then y else i(l)) n"
  proof (rule allI, rule allI)
    fix i :: "nat \<Rightarrow> Set"
    fix y
    have "\<langle>\<dots>, i(m)\<rangle> = ToTuple (\<lambda>l. if l = Suc m then y else i l) m"
      using Tuple_Dom [of m i "\<lambda>l. if l = Suc m then y else i l"] by simp
    with `n = Suc m` show "\<langle>\<dots>, i(m), y\<rangle> = ToTuple (\<lambda>l. if l = n then y else i(l)) n"
      by simp
  qed
  ultimately show ?thesis unfolding Update_def by simp
qed

lemma Class_Project4: "k < n \<Longrightarrow> \<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C
  \<longleftrightarrow> (\<exists>y. \<langle>\<dots>, (Update i k y)(n)\<rangle> \<in> X)"
proof -
  assume "k < n"
  then obtain C where C_def:
    "\<forall>i. \<langle>\<dots>, (Swap i k n)(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, i(n)\<rangle> \<in> X"
    using Tuple_Swap by blast
  from `k < n` have "0 < n" by simp
  then obtain D where D_def:
    "\<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> D \<longleftrightarrow> (\<exists>y. \<langle>\<dots>, (Update i n y)(n)\<rangle> \<in> C)"
    using Class_Project3 by blast
  from `k < n` obtain E where "\<forall>i. \<langle>\<dots>, (Swap i k n)(n)\<rangle> \<in> E \<longleftrightarrow> \<langle>\<dots>, i(n)\<rangle> \<in> D"
    using Tuple_Swap by blast
  hence "\<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> E \<longleftrightarrow> \<langle>\<dots>, (Swap i k n)(n)\<rangle> \<in> D" using Tuple_Swap_Inter by fast
  with D_def have "\<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> E \<longleftrightarrow> (\<exists>y. \<langle>\<dots>, (Update (Swap i k n) n y)(n)\<rangle> \<in> C)"
    by simp
  moreover from C_def
    have "\<forall>i. \<forall>y. \<langle>\<dots>, (Update (Swap i k n) n y)(n)\<rangle> \<in> C \<longleftrightarrow> \<langle>\<dots>, (Update i k y)(n)\<rangle> \<in> X"
    using Update_Swap by simp
  ultimately show "\<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> (\<exists>y. \<langle>\<dots>, (Update i k y)(n)\<rangle> \<in> X)" by auto
qed

lemma Class_Ex_Subset: "\<exists>C. \<forall>x y. \<langle>x, y\<rangle> \<in> C \<longleftrightarrow> x \<subseteq> y"
proof -
  obtain C1 where C1_def: "\<forall>z x. \<langle>z, x\<rangle> \<in> C1 \<longleftrightarrow> z \<in> x" using B1 by blast
  moreover obtain C2 where C2_def: "\<forall>x z. \<langle>x, z\<rangle> \<in> C2 \<longleftrightarrow> \<langle>z, x\<rangle> \<in> C1" using Ex_4_11_a by blast
  moreover obtain C3 where "\<forall>x y z. \<langle>x, y, z\<rangle> \<in> C3 \<longleftrightarrow> \<langle>x, z\<rangle> \<in> C2" using Ex_4_11_b by blast
  ultimately have a1: "\<forall>x y z. \<langle>x, y, z\<rangle> \<in> C3 \<longleftrightarrow> z \<in> x" by simp
  from C1_def C2_def have "\<forall>y z. \<langle>y, z\<rangle> \<in> Co(C2) \<longleftrightarrow> z \<notin> y" using B3 by simp
  moreover obtain D1 where "\<forall>y z x. \<langle>y, z, x\<rangle> \<in> D1 \<longleftrightarrow> \<langle>y, z\<rangle> \<in> Co(C2)" using B5 by blast
  moreover obtain D2 where "\<forall>x y z. \<langle>x, y, z\<rangle> \<in> D2 \<longleftrightarrow> \<langle>y, z, x\<rangle> \<in> D1" using B6 by blast
  ultimately have "\<forall>x y z. \<langle>x, y, z\<rangle> \<in> D2 \<longleftrightarrow> z \<notin> y" by simp
  with a1 have "\<forall>x y z. \<langle>x, y, z\<rangle> \<in> C3 \<inter> D2 \<longleftrightarrow> z \<in> x \<and> z \<notin> y" using B2 by blast
  moreover have "\<forall>x y. \<langle>x, y\<rangle> \<notin> dom(C3 \<inter> D2) \<longleftrightarrow> \<not>(\<exists>z. \<langle>x, y, z\<rangle> \<in> C3 \<inter> D2)" using B4 by blast
  moreover have "\<forall>x y. \<langle>x, y\<rangle> \<in> Co(dom(C3 \<inter> D2)) \<longleftrightarrow> \<langle>x, y\<rangle> \<notin> dom(C3 \<inter> D2)" using B3 by blast
  ultimately have "\<forall>x y. \<langle>x, y\<rangle> \<in> Co(dom(C3 \<inter> D2)) \<longleftrightarrow> (\<forall>z :: Set. (z \<in> x \<longrightarrow> z \<in> y))" by simp
  thus ?thesis using subset by auto
qed

lemma Class_Ex_Equals1: "\<exists>C. \<forall>x y. \<langle>x, y\<rangle> \<in> C \<longleftrightarrow> x = y"
proof -
  obtain C1 where "\<forall>x y. \<langle>x, y\<rangle> \<in> C1 \<longleftrightarrow> x \<subseteq> y" using Class_Ex_Subset by blast
  moreover obtain C2 where "\<forall>x y. \<langle>x, y\<rangle> \<in> C2 \<longleftrightarrow> \<langle>y, x\<rangle> \<in> C1" using Ex_4_11_a by blast
  ultimately have "\<forall>x y. \<langle>x, y\<rangle> \<in> C1 \<inter> C2 \<longleftrightarrow> x = y" using B2 Prop4_1_a Rep_Set_inject by auto
  thus ?thesis ..
qed

lemma Class_Ex_Antifoundation: "\<exists>C. \<forall>x :: Set. x \<in> C \<longleftrightarrow> x \<in> x"
proof -
  obtain C where "\<forall>x y. \<langle>x, y\<rangle> \<in> C \<longleftrightarrow> x \<in> y" using B1 ..
  moreover obtain D where "\<forall>x y. \<langle>x, y\<rangle> \<in> D \<longleftrightarrow> x = y" using Class_Ex_Equals1 ..
  ultimately have "\<forall>x. x \<in> dom(C \<inter> D) \<longleftrightarrow> (\<exists>y :: Set. x \<in> y \<and> x = y)" using B2 B4 by simp
  moreover have "\<forall>x. x \<in> x \<longleftrightarrow> (\<exists>y :: Set. x \<in> y \<and> x = y)" by simp
  ultimately show ?thesis by blast
qed

lemma Class_Ex_Belongs_CV1: "\<exists>C. \<forall>x :: Set. x \<in> C \<longleftrightarrow> X \<in> x"
proof (cases "\<exists>w :: Set. X = w")
  assume "\<exists>w :: Set. X = w"
  then obtain w :: Set where "X = w" by blast
  hence "\<forall>x. x \<in> {w} \<longleftrightarrow> x = X" using singletonE using pairing by blast
  then obtain C where "\<forall>x y. \<langle>y, x\<rangle> \<in> C \<longleftrightarrow> y = X" using B5 by metis
  moreover then obtain D where "\<forall>x y. \<langle>y, x\<rangle> \<in> D \<longleftrightarrow> y \<in> x" using B1 by blast
  ultimately have "\<forall>x y. \<langle>y, x\<rangle> \<in> C \<inter> D \<longleftrightarrow> y = X \<and> y \<in> x" using B2 by simp
  then obtain E where "\<forall>x y. \<langle>x, y\<rangle> \<in> E \<longleftrightarrow> y = X \<and> y \<in> x" using Ex_4_11_a by metis
  hence "\<forall>x :: Set. x \<in> dom(E) \<longleftrightarrow> (\<exists>y :: Set. y = X \<and> y \<in> x)" using B4 by simp
  with `X = w` show ?thesis by metis
next
  assume "\<not> (\<exists>w :: Set. X = w)"
  hence "\<forall>x :: Set. X \<notin> x" by (metis CollectI Rep_Set_cases set_predicate_def universe)
  thus ?thesis using empty_set by auto
qed

lemma Class_Ex_Belongs_CV:
  fixes \<phi> :: FOL_Formula
  fixes C :: Class
  fixes n :: nat
  assumes "\<phi> = (FBelongs (FConst C) (FVar n))"
  shows   "Class_Ex \<phi> (FOL_MaxVar \<phi>)"
proof -
  have n: "n = FOL_MaxVar \<phi>" by (simp add: assms)
  have *: "\<exists>C'. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C' \<longleftrightarrow> C \<in> i(n)" using Class_Ex_Belongs_CV1 Tuple_Last by fastforce
  have "\<forall>i. FOL_True \<phi> i \<longleftrightarrow> C \<in> i(n)" using FOL_True.simps FOL_Eval.simps assms by simp
  thus "Class_Ex \<phi> (FOL_MaxVar \<phi>)" unfolding Class_Ex_def using n * by simp
qed

lemma Class_Ex_Belongs_VV: "Class_Ex (FBelongs (FVar n) (FVar m))
  (FOL_MaxVar (FBelongs (FVar n) (FVar m)))"
proof (rule Nat.nat_less_cases [of n m])
  assume "n < m"
  moreover then obtain C where "\<forall>i. \<langle>i(n), i(m)\<rangle> \<in> C \<longleftrightarrow> i(n) \<in> i(m)" using B1 by auto
  ultimately obtain D where "\<forall>i. \<langle>\<dots>, i(m)\<rangle> \<in> D \<longleftrightarrow> i(n) \<in> i(m)" using Tuple_Extend4 by metis
  moreover from `n < m` have "max n m = m" by simp
  ultimately show ?thesis unfolding Class_Ex_def by auto
next
  assume "n = m"
  thus ?thesis unfolding Class_Ex_def using Tuple_Last Class_Ex_Antifoundation by fastforce
next
  assume "m < n"
  moreover then obtain C where "\<forall>i. \<langle>i(m), i(n)\<rangle> \<in> C \<longleftrightarrow> i(n) \<in> i(m)" using B1 Ex_4_11_a by metis
  ultimately obtain D where "\<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> D \<longleftrightarrow> i(n) \<in> i(m)" using Tuple_Extend4 by metis
  moreover from `m < n` have "max n m = n" by simp
  ultimately show ?thesis unfolding Class_Ex_def by auto
qed

lemma Class_Ex_Equals_CC: "Class_Ex (FEquals (FConst c) (FConst d))
  (FOL_MaxVar (FEquals (FConst c) (FConst d)))"
proof (unfold Class_Ex_def, simp, cases "c = d")
  assume "c = d"
  thus "\<exists>C. \<forall>i :: nat \<Rightarrow> Set. i(0) \<in> C \<longleftrightarrow> c = d" using Ex4_9_b by auto
next
  assume "c \<noteq> d"
  thus "\<exists>C. \<forall>i :: nat \<Rightarrow> Set. i(0) \<in> C \<longleftrightarrow> c = d" using empty_set by auto
qed

lemma Class_Ex_Equals_VC: "Class_Ex (FEquals (FVar n) (FConst c))
  (FOL_MaxVar (FEquals (FVar n) (FConst c)))"
proof (unfold Class_Ex_def, simp, cases "\<exists>z :: Set. z = c")
  assume "\<exists>z :: Set. z = c"
  then obtain z :: Set where "z = c" by blast
  hence "\<forall>x. x \<in> {z} \<longleftrightarrow> x = c" using singletonE singletonI pairing by blast
  moreover obtain C where "\<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> i(n) \<in> {z}" using Tuple_Last by blast
  ultimately show "\<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> i(n) = c" by auto
next
  assume "\<not> (\<exists>z :: Set. z = c)"
  thus "\<exists>C. \<forall>i. \<langle>\<dots>, i(n)\<rangle> \<in> C \<longleftrightarrow> i(n) = c" using empty_set by auto
qed

lemma Class_Ex_Equals_CV: "Class_Ex (FEquals (FConst c) (FVar n))
  (FOL_MaxVar (FEquals (FConst c) (FVar n)))"
using Class_Ex_Equals_VC unfolding Class_Ex_def by (simp, metis)

lemma Class_Ex_Equals_VV: "Class_Ex (FEquals (FVar n) (FVar k))
  (FOL_MaxVar (FEquals (FVar n) (FVar k)))"
proof (unfold Class_Ex_def, simp, cases "n = k")
  assume "n = k"
  thus "\<exists>C. \<forall>i. \<langle>\<dots>, i(max n k)\<rangle> \<in> C \<longleftrightarrow> (Rep_Set (i(n)) = (i(k)))"
    using Ex4_9_b by auto
next
  obtain C where C_def: "\<forall>x y. \<langle>x, y\<rangle> \<in> C \<longleftrightarrow> x = y" using Class_Ex_Equals1 ..
  assume "n \<noteq> k"
  hence "min n k < max n k" by simp
  then obtain D where "\<forall>i. \<langle>\<dots>, i(max n k)\<rangle> \<in> D \<longleftrightarrow> \<langle>i(min n k), i(max n k)\<rangle> \<in> C"
    using Tuple_Extend4 by blast
  with C_def have "\<forall>i. \<langle>\<dots>, i(max n k)\<rangle> \<in> D \<longleftrightarrow> i(min n k) = i(max n k)"
    by blast
  moreover from `n \<noteq> k` have "\<forall>i. i(min n k) = i(max n k) \<longleftrightarrow> i(n) = i(k)"
    by (metis max_def min_def)
  ultimately show "\<exists>C. \<forall>i. \<langle>\<dots>, i(max n k)\<rangle> \<in> C \<longleftrightarrow> (Rep_Set (i(n)) = (i(k)))"
    using Rep_Set_inject by blast
qed

lemma Class_Ex_Equals: "Class_Ex (FEquals x y) (FOL_MaxVar (FEquals x y))"
proof (cases x, cases y, auto simp add: Class_Ex_Equals_VV Class_Ex_Equals_VC Class_Ex_Equals_CV
                                        Class_Ex_Equals_CC)
  fix n m :: nat
  assume x: "x = FVar n"
  assume y: "y = FVar m"
  show "Class_Ex (FEquals (FVar n) (FVar m)) (max n m)" using Class_Ex_Equals_VV by auto
next
  fix n :: nat
  fix Y :: Class
  assume "x = FVar n"
  assume "y = FConst Y"
  show "Class_Ex (FEquals (FVar n) (FConst Y)) n" using Class_Ex_Equals_VC by auto
next
  fix X :: Class
  assume "x = FConst X"
  show "Class_Ex (FEquals (FConst X) y) (FOL_Var y)" by (metis Class_Ex_Equals_CC
    Class_Ex_Equals_CV FOL_MaxVar.simps(4) FOL_Term.exhaust FOL_Var.simps(2) max_0L)
qed

lemma Class_Ex_Belongs: "Class_Ex (FBelongs x y) (FOL_MaxVar (FBelongs x y))"
proof (cases x, cases y, auto simp add: Class_Ex_Belongs_VV Class_Ex_Belongs_VC Class_Ex_Belongs_CC)
  fix n m:: nat
  assume "x = FVar n"
  assume "y = FVar m"
  show   "Class_Ex (FBelongs (FVar n) (FVar m)) (max n m)" using Class_Ex_Belongs_VV by auto
next
  fix n :: nat
  fix Y :: Class
  assume "x = FVar n"
  assume "y = FConst Y"
  show "Class_Ex (FBelongs (FVar n) (FConst Y)) n" using Class_Ex_Belongs_VC by auto
next
  fix X ::Class
  assume "x = FConst X"
  show "Class_Ex (FBelongs (FConst X) y) (FOL_Var y)" by (metis Class_Ex_Belongs_CC
    Class_Ex_Belongs_CV FOL_MaxVar.simps(3) FOL_Term.exhaust FOL_Var.simps(2) max_0L)
qed

lemma Class_Ex_And: "\<lbrakk>Class_Ex \<phi> n; Class_Ex \<psi> n\<rbrakk> \<Longrightarrow> Class_Ex (FAnd \<phi> \<psi>) n"
proof -
  assume "Class_Ex \<phi> n"
  then obtain C where ex1: "\<forall>j. \<langle>\<dots>, j(n)\<rangle> \<in> C \<longleftrightarrow> FOL_True \<phi> j"
    unfolding Class_Ex_def by blast
  assume "Class_Ex \<psi> n"
  then obtain D where "\<forall>j. \<langle>\<dots>, j(n)\<rangle> \<in> D \<longleftrightarrow> FOL_True \<psi> j"
    unfolding Class_Ex_def by blast
  with ex1 have "\<forall>j. \<langle>\<dots>, j(n)\<rangle> \<in> C \<inter> D \<longleftrightarrow> (FOL_True \<phi> j \<and> FOL_True \<psi> j)"
    using B2 by blast
  thus ?thesis unfolding Class_Ex_def by auto
qed

lemma Class_Ex_Not: "Class_Ex \<phi> n \<Longrightarrow> Class_Ex (FNot \<phi>) n"
proof -
  assume "Class_Ex \<phi> n"
  then obtain C where "\<forall>j. \<langle>\<dots>, j(n)\<rangle> \<in> C \<longleftrightarrow> FOL_True \<phi> j"
    unfolding Class_Ex_def by blast
  hence "\<forall>j :: nat \<Rightarrow> Set. \<langle>\<dots>, j(n)\<rangle> \<in> Co(C) \<longleftrightarrow> \<not> (FOL_True \<phi> j)"
    using B3 by blast
  thus ?thesis unfolding Class_Ex_def by auto
qed

lemma Class_Ex_Or: "\<lbrakk>Class_Ex \<phi> n; Class_Ex \<psi> n\<rbrakk> \<Longrightarrow> Class_Ex (FOr \<phi> \<psi>) n"
proof -
  assume "Class_Ex \<phi> n"
  hence ex1: "Class_Ex (FNot \<phi>) n" by (rule Class_Ex_Not)
  assume "Class_Ex \<psi> n"
  hence ex2: "Class_Ex (FNot \<psi>) n" by (rule Class_Ex_Not)
  from ex1 ex2 have ex3: "Class_Ex (FAnd (FNot \<phi>) (FNot \<psi>)) n" by (rule Class_Ex_And)
  hence "Class_Ex (FNot (FAnd (FNot \<phi>) (FNot \<psi>))) n" by (rule Class_Ex_Not)
  thus ?thesis unfolding Class_Ex_def by simp
qed

lemma Class_Ex_Imp: "\<lbrakk>Class_Ex \<phi> n; Class_Ex \<psi> n\<rbrakk> \<Longrightarrow> Class_Ex (FImp \<phi> \<psi>) n"
proof -
  assume "Class_Ex \<phi> n"
  hence ex1: "Class_Ex (FNot \<phi>) n" by (rule Class_Ex_Not)
  assume "Class_Ex \<psi> n"
  with ex1 have "Class_Ex (FOr (FNot \<phi>) \<psi>) n" by (rule Class_Ex_Or)
  thus ?thesis unfolding Class_Ex_def by simp
qed

lemma Class_Ex_Iff: "\<lbrakk>Class_Ex \<phi> n; Class_Ex \<psi> n\<rbrakk> \<Longrightarrow> Class_Ex (FIff \<phi> \<psi>) n"
proof -
  assume ex1: "Class_Ex \<phi> n"
  assume ex2: "Class_Ex \<psi> n"
  from ex1 ex2 have ex3: "Class_Ex (FImp \<phi> \<psi>) n" by (rule Class_Ex_Imp)
  from ex2 ex1 have "Class_Ex (FImp \<psi> \<phi>) n" by (rule Class_Ex_Imp)
  with ex3 have "Class_Ex (FAnd (FImp \<phi> \<psi>) (FImp \<psi> \<phi>)) n" by (rule Class_Ex_And)
  thus ?thesis unfolding Class_Ex_def by auto
qed

lemma Class_Ex_Irr: "n > FOL_MaxVar \<phi> \<Longrightarrow> FOL_True (FEx n \<phi>) i \<longleftrightarrow> FOL_True \<phi> i"
proof -
  assume "FOL_MaxVar \<phi> < n"
  hence "\<forall>y. \<forall>k \<le> FOL_MaxVar \<phi>. i(k) = (Update i n y)(k)" unfolding Update_def by simp
  hence "\<forall>y. FOL_True \<phi> i \<longleftrightarrow> FOL_True \<phi> (Update i n y)" using FOL_MaxVar_Dom by simp
  thus ?thesis by simp
qed

lemma Class_Ex_Ex: "Class_Ex \<phi> (FOL_MaxVar \<phi>) \<Longrightarrow> Class_Ex (FEx n \<phi>) (FOL_MaxVar (FEx n \<phi>))"
proof (cases "FOL_MaxVar \<phi> < n")
  assume "Class_Ex \<phi> (FOL_MaxVar \<phi>)"
  moreover assume "FOL_MaxVar \<phi> < n"
  ultimately show "Class_Ex (FEx n \<phi>) (FOL_MaxVar (FEx n \<phi>))"
    unfolding Class_Ex_def using Class_Ex_Irr by simp
next
  assume "Class_Ex \<phi> (FOL_MaxVar \<phi>)"
  then obtain D where D_def: "\<forall>i. \<langle>\<dots>, i(FOL_MaxVar \<phi>)\<rangle> \<in> D \<longleftrightarrow> FOL_True \<phi> i"
    unfolding Class_Ex_def by blast
  assume "\<not> FOL_MaxVar \<phi> < n"
  then consider "n = 0 \<and> FOL_MaxVar \<phi> = 0" | "0 < n \<and> FOL_MaxVar \<phi> = n" | "n < FOL_MaxVar \<phi>"
    by linarith
  hence "\<exists>C. \<forall>i. \<langle>\<dots>, i(FOL_MaxVar \<phi>)\<rangle> \<in> C \<longleftrightarrow> (\<exists>y. \<langle>\<dots>, (Update i n y)(FOL_MaxVar \<phi>)\<rangle> \<in> D)"
    using Class_Project2 Class_Project3 Class_Project4 by (cases, simp_all)
  with D_def show ?thesis unfolding Class_Ex_def by simp
qed

lemma Class_Ex_All: "Class_Ex \<phi> (FOL_MaxVar \<phi>) \<Longrightarrow> Class_Ex (FAll n \<phi>) (FOL_MaxVar (FAll n \<phi>))"
proof -
  assume "Class_Ex \<phi> (FOL_MaxVar \<phi>)"
  hence "Class_Ex (FNot \<phi>) (FOL_MaxVar \<phi>)" by (rule Class_Ex_Not)
  hence "Class_Ex (FEx n (FNot \<phi>)) (FOL_MaxVar (FEx n \<phi>))" using Class_Ex_Ex
    by (metis FOL_MaxVar.simps(10) FOL_MaxVar.simps(6))
  hence "Class_Ex (FNot (FEx n (FNot \<phi>))) (FOL_MaxVar (FAll n \<phi>))" using Class_Ex_Not by simp
  thus ?thesis unfolding Class_Ex_def by auto
qed

theorem Class_Existence: "Class_Ex \<phi> (FOL_MaxVar \<phi>)"
-- "For every FOL_Formula \<phi> there exists a class which contains exactly those n-tuples which
    satisfy \<phi>, where n is the largest set-variable index appearing in \<phi>."
proof (induct \<phi>, auto simp add: Class_Ex_True Class_Ex_False  Class_Ex_Belongs  Class_Ex_Equals
                                Class_Ex_And  Class_Ex_Mono2  Class_Ex_Or       Class_Ex_Not
                                Class_Ex_Imp  Class_Ex_Iff)
  fix x1 x2::FOL_Term
  show "Class_Ex (FBelongs x1 x2) (max (FOL_Var x1) (FOL_Var x2))" using Class_Ex_Belongs by auto
  show "Class_Ex (FEquals x1 x2) (max (FOL_Var x1) (FOL_Var x2))"  using Class_Ex_Equals by auto
next
  fix n  :: nat
  fix \<phi>  :: FOL_Formula
  assume IH: "Class_Ex \<phi> (FOL_MaxVar \<phi>)"
  thus "Class_Ex (FEx n \<phi>) (FOL_MaxVar \<phi>)" using Class_Ex_Ex FOL_MaxVar.simps(10) by auto
  from IH show "Class_Ex (FAll n \<phi>) (FOL_MaxVar \<phi>)" using Class_Ex_All FOL_MaxVar.simps(11) by auto
qed

end


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

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

fun elem :: "'a => 'a list => bool" where
"elem x (nil2) = False"
| "elem x (cons2 z xs) = ((z = x) | (elem x xs))"

fun deleteBy :: "('a => ('a => bool)) => 'a => 'a list =>
                 'a list" where
"deleteBy x y (nil2) = nil2"
| "deleteBy x y (cons2 y2 ys) =
     (if (x y) y2 then ys else cons2 y2 (deleteBy x y ys))"

fun isPermutation :: "'a list => 'a list => bool" where
"isPermutation (nil2) (nil2) = True"
| "isPermutation (nil2) (cons2 z x2) = False"
| "isPermutation (cons2 x3 xs) y =
     ((elem x3 y) &
        (isPermutation
           xs (deleteBy (% (x4 :: 'a) => % (x5 :: 'a) => (x4 = x5)) x3 y)))"

theorem property0 :
  "((isPermutation xs ys) ==> (isPermutation ys xs))"
  oops

end


section \<open>Time tables\<close>

theory TimeTable
  imports Main
begin

text \<open>Partitions and IDs for time tables are both specified by natural
  numbers.\<close>
type_synonym partition = nat
type_synonym ttbl_id = nat

text \<open>Each time table is specified by a list of windows, each window
  specifies the partition id and the length of the window.

  For example, [(1, 10), (2, 15), (1, 5)] means a frame has a total length
  of 30 ticks. The first 10 ticks in partition 1, next 15 ticks in
  partition 2, and the last 5 ticks in partition 1.
\<close>
type_synonym time_table = "(partition \<times> nat) list"

text \<open>Returns the total frame length of the time table.\<close>
fun frame_length :: "time_table \<Rightarrow> nat" where
  "frame_length [] = 0"
| "frame_length ((p, n) # fs) = n + frame_length fs"

text \<open>Amount of time spent at partition in one frame.\<close>
fun partition_time :: "time_table \<Rightarrow> partition \<Rightarrow> nat" where
  "partition_time [] p' = 0"
| "partition_time ((p, n) # fs) p' = (if p = p' then n + partition_time fs p' else partition_time fs p')"

text \<open>Returns the partition for the t'th tick of the time table.
  If t is greater than or equal to the total frame time, return undefined.\<close>
fun partition_at_time :: "time_table \<Rightarrow> nat \<Rightarrow> partition" where
  "partition_at_time [] t = undefined"
| "partition_at_time ((p, n) # fs) t = (if t < n then p else partition_at_time fs (t - n))"

text \<open>Whether the given time is at a window boundary.
  If t is  equal to the window time minus one, return False.\<close>
fun at_window_boundary :: "time_table \<Rightarrow> nat \<Rightarrow> bool" where
  "at_window_boundary [] t = False"
| "at_window_boundary ((p, n) # fs) t = (if t < n then t = (n - 1) else at_window_boundary fs (t - n))"

text \<open>Id of the current window, given the total amount of time spent in frame.\<close>
fun cur_window_id :: "time_table \<Rightarrow> nat \<Rightarrow> nat" where
  "cur_window_id [] t = undefined"
| "cur_window_id ((p, n) # fs) t = (if t < n then 0 else cur_window_id fs (t - n) + 1)"

text \<open>Amount of time spent in the current window.\<close>
fun cur_window_time :: "time_table \<Rightarrow> nat \<Rightarrow> nat" where
  "cur_window_time [] t = undefined"
| "cur_window_time ((p, n) # fs) t = (if t < n then t else cur_window_time fs (t - n))"

text \<open>Time to the next window boundary.\<close>
fun time_to_next_window :: "time_table \<Rightarrow> nat \<Rightarrow> nat" where
  "time_to_next_window tbl t = (
    let window_id = cur_window_id tbl t;
        window_time = cur_window_time tbl t
     in
       snd (tbl ! window_id) - window_time)"

text \<open>Amount of time until the start of next frame.\<close>
fun time_to_next_frame :: "time_table \<Rightarrow> nat \<Rightarrow> nat" where
  "time_to_next_frame tbl t = frame_length tbl - t"

text \<open>Whether a time table contains frames of length zero. This condition
  may be needed in some of the future proofs.\<close>
fun is_valid_time_table' :: "time_table \<Rightarrow> bool" where
  "is_valid_time_table' [] = True"
| "is_valid_time_table' ((p, n) # fs) \<longleftrightarrow> (n \<noteq> 0 \<and> is_valid_time_table' fs)"

fun is_valid_time_table :: "time_table \<Rightarrow> bool" where
  "is_valid_time_table ttbl \<longleftrightarrow> length ttbl > 1 \<and> is_valid_time_table' ttbl"

lemma valid_time_table_frame_length:
  assumes "is_valid_time_table ttbl"
  shows "frame_length ttbl > 0"
proof (cases ttbl)
  case Nil
  then show ?thesis
    using assms by auto
next
  case (Cons a fs)
  show ?thesis
  proof (cases a)
    case (Pair p n)
    have "n > 0"
      using assms unfolding Cons Pair by auto
    then show ?thesis
      unfolding Cons Pair by simp
  qed
qed

lemma window_time_pos':
  "is_valid_time_table' tbl \<Longrightarrow> i < length tbl \<Longrightarrow> snd (tbl ! i) > 0"
  apply (induction tbl arbitrary: i) apply auto
  using less_Suc_eq_0_disj by fastforce

lemma window_time_pos:
  "is_valid_time_table tbl \<Longrightarrow> i < length tbl \<Longrightarrow> snd (tbl ! i) > 0"
  using window_time_pos' by auto

text \<open>Returns the total frame time up to (but not including) window k.\<close>
fun frame_time_to_window :: "time_table \<Rightarrow> nat \<Rightarrow> nat" where
  "frame_time_to_window [] i = 0"
| "frame_time_to_window ((p, n) # tbl) 0 = 0"
| "frame_time_to_window ((p, n) # tbl) (Suc i) = n + frame_time_to_window tbl i"

lemma frame_time_to_window_zero [simp]:
  "frame_time_to_window tbl 0 = 0"
  apply (cases tbl) by auto

lemma frame_time_to_window_total:
  "frame_time_to_window tbl (length tbl) = frame_length tbl"
  apply (induction tbl) by auto

lemma frame_time_to_window_mono:
  "a \<le> b \<Longrightarrow> frame_time_to_window tbl a \<le> frame_time_to_window tbl b"
proof (induct b arbitrary: a tbl)
  case 0
  then show ?case by auto
next
  case (Suc b)
  show ?case
  proof (cases tbl)
    case Nil
    then show ?thesis by auto
  next
    case (Cons x list)
    then show ?thesis
      apply (cases x)
      subgoal for p n
        apply (cases a) apply auto
        subgoal for a'
          apply (rule Suc(1)) using Suc(2) by auto
        done
      done
  qed
qed

lemma frame_time_to_window_next:
  "i < length tbl \<Longrightarrow> frame_time_to_window tbl (Suc i) = frame_time_to_window tbl i + snd (tbl ! i)"
proof (induct tbl arbitrary: i)
  case Nil
  then show ?case by auto
next
  case (Cons pn tbl)
  then show ?case
    apply (cases pn)
    subgoal for p n
      apply auto apply (cases i) by auto
    done
qed

lemma frame_time_to_window_mono_strict:
  assumes "is_valid_time_table tbl"
    and "a < b"
    and "a < length tbl"
  shows "frame_time_to_window tbl a < frame_time_to_window tbl b"
proof -
  have a1: "Suc a \<le> b"
    using assms(2) by auto
  have a2: "frame_time_to_window tbl (Suc a) \<le> frame_time_to_window tbl b"
    using a1 frame_time_to_window_mono by auto
  have a3: "frame_time_to_window tbl a < frame_time_to_window tbl (Suc a)"
    unfolding frame_time_to_window_next[OF assms(3)]
    using assms(1,3) window_time_pos by auto
  show ?thesis
    using a2 a3 by auto
qed

lemma frame_time_to_window_inj:
  assumes "is_valid_time_table tbl"
    and "a \<le> length tbl"
    and "b \<le> length tbl"
    and "frame_time_to_window tbl a = frame_time_to_window tbl b"
  shows "a = b"
  by (metis assms frame_time_to_window_mono_strict less_le_trans less_not_refl3 linorder_neqE_nat)

lemma at_window_boundary_wpos:
  "is_valid_time_table' tbl \<Longrightarrow> wid < length tbl \<Longrightarrow> wpos > 0 \<Longrightarrow> wpos \<le> snd (tbl ! wid) \<Longrightarrow>
   at_window_boundary tbl (frame_time_to_window tbl (wid + 1) - wpos) \<longleftrightarrow> wpos = 1"
proof (induction tbl arbitrary: wid)
  case Nil
  then show ?case by auto
next
  case (Cons pair tbl')
  show ?case
  proof (cases pair)
    case (Pair p n)
    have a: "n > 0"
      using Cons(2) unfolding Pair by auto
    show ?thesis
    proof (cases wid)
      case 0
      show ?thesis
        unfolding 0 Pair using a apply auto
        using Cons.prems(4) Pair 0 apply auto[1]
        by (simp add: Cons.prems(3))
    next
      case (Suc wid')
      have b1: "is_valid_time_table' tbl'"
        using Cons(2) unfolding Pair by auto
      have b2: "wpos \<le> snd (tbl' ! wid')"
        using Cons(5) unfolding Pair Suc by auto
      have b3: "wid' < length tbl'"
        using Cons(3) unfolding Pair Suc by auto
      have b4: "at_window_boundary tbl' (frame_time_to_window tbl' (wid' + 1) - wpos) = (wpos = 1)"
        using Cons(1)[OF b1 b3 Cons(4) b2] by auto
      show ?thesis
        unfolding Pair Suc using b4 apply auto
        unfolding frame_time_to_window_next[OF b3]
        using b2 by linarith
    qed
  qed
qed

lemma partition_at_time_frame_time_to_window:
  "is_valid_time_table' tbl \<Longrightarrow> wid < length tbl \<Longrightarrow> partition_at_time tbl (frame_time_to_window tbl wid) = fst (tbl ! wid)"
proof (induction tbl arbitrary: wid)
  case Nil
  then show ?case by auto
next
  case (Cons pair tbl')
  show ?case
  proof (cases pair)
    case (Pair p n)
    have a: "n > 0"
      using Cons(2) unfolding Pair by auto
    show ?thesis
    proof (cases wid)
      case 0
      then show ?thesis unfolding Pair using a by auto
    next
      case (Suc wid')
      have b: "partition_at_time tbl' (frame_time_to_window tbl' wid') = fst (tbl' ! wid')"
        apply (rule Cons(1))
        using Cons(2,3) unfolding Pair Suc by auto
      show ?thesis
        unfolding Pair Suc using b by auto
    qed
  qed
qed

lemma at_frame_boundary_also_window_boundary:
  assumes "is_valid_time_table tbl"
  shows "at_window_boundary tbl (frame_length tbl - 1)"
proof -
  have a: "at_window_boundary tbl (frame_time_to_window tbl (length tbl - 1 + 1) - 1)"
    apply (subst at_window_boundary_wpos)
    using assms apply auto
    by (simp add: Suc_leI window_time_pos)
  show ?thesis
    using a unfolding frame_time_to_window_total[symmetric]
    by (metis One_nat_def Suc_pred add.right_neutral add_Suc_right assms is_valid_time_table.elims(2)
              length_greater_0_conv less_imp_le list.size(3) not_le zero_less_Suc)
qed

text \<open>Three switch modes: switch at next tick, switch at next window,
  and switch at next time frame.\<close>
datatype switch_mode = NO_SWITCH | NEXT_TICK | NEXT_WINDOW | NEXT_FRAME | ONGOING

text \<open>Global state contains a list of time tables, indexed by ID.
  We require that all time tables with valid ID (less than 256) are valid.
\<close>
locale global_state =
  fixes time_tables :: "ttbl_id \<Rightarrow> time_table"
  assumes valid_time_table: "\<And>n. n < 256 \<Longrightarrow> is_valid_time_table (time_tables n)"

end


theory Common
  imports Main "HOL-Library.While_Combinator"
begin

(* A feasible set is a nonempty subset *)
abbreviation NonEmptySubset :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool" (infix "\<sqsubseteq>" 50) where
  "NonEmptySubset A U \<equiv> (A \<subseteq> U \<and> A \<noteq> {})"

(*
  What follows is a lemma to show that if a property is true for some finite set, and we can always
  find a nonempty strict subset that also has the property, then, after repeated application, we
  will eventually end up with a singleton subset of the original set, that also has the property.
*)

abbreviation filled where "filled \<equiv> \<lambda>G. finite G \<and> G \<noteq> {}"

context
  fixes G :: "'a set"
    and P :: "'a set \<Rightarrow> bool"
  assumes filled_G: "filled G"
      and initial: "P G"
begin

lemma sub_finite: "G' \<subseteq> G \<Longrightarrow> finite G'" using filled_G by (metis finite_subset)

abbreviation P' where "P' G' \<equiv> P G' \<and> G' \<sqsubseteq> G"
abbreviation C where "C G' \<equiv> P' G' \<and> card G' \<noteq> 1"

abbreviation Q where "Q s G' \<equiv> P' G' \<and> G' \<subset> s"
abbreviation S where "S s \<equiv> SOME G'. Q s G'"

lemma subset_descent:
  assumes step: "\<And>s. C s \<Longrightarrow> \<exists>G'. Q s G'"
  shows "\<exists>g \<in> G. while C S G = {g} \<and> P {g}"
proof (rule while_rule[where P = P' and r = finite_psubset])
  show "P' G" using filled_G initial by simp next
  show "P' s \<Longrightarrow> C s \<Longrightarrow> P' (S s)" for s using someI2_ex[of "Q s" "\<lambda>G'. G' \<subseteq> G"] someI2_ex[of "Q s" P] someI2_ex[of "Q s" filled] step sub_finite by simp
next
  show "P' s \<Longrightarrow> \<not> C s \<Longrightarrow> \<exists>g \<in> G. s = {g} \<and> P {g}" for s proof -
    assume "P' s" "\<not> C s"
    hence "s \<subseteq> G" "P s" "card s = 1" by auto
    then obtain g where "g \<in> G \<and> s = {g} \<and> P {g}" by (metis card_1_singletonE in_mono singletonI)
    thus ?thesis by auto
  qed next
  show "wf finite_psubset" using wf_finite_psubset . next
  show "P' s \<Longrightarrow> C s \<Longrightarrow> (S s, s) \<in> finite_psubset" for s using someI2_ex[of "Q s" "\<lambda>G. G \<subset> s"] step sub_finite by auto
qed

end

end