(*  Title:      ZF/Int.thy
    Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
    Copyright   1993  University of Cambridge
*)

section\<open>The Integers as Equivalence Classes Over Pairs of Natural Numbers\<close>

theory Int imports EquivClass ArithSimp begin

definition
  intrel :: i  where
    "intrel == {p \<in> (nat*nat)*(nat*nat).
                \<exists>x1 y1 x2 y2. p=<<x1,y1>,<x2,y2>> & x1#+y2 = x2#+y1}"

definition
  int :: i  where
    "int == (nat*nat)//intrel"

definition
  int_of :: "i=>i" \<comment> \<open>coercion from nat to int\<close>    (\<open>$# _\<close> [80] 80)  where
    "$# m == intrel `` {<natify(m), 0>}"

definition
  intify :: "i=>i" \<comment> \<open>coercion from ANYTHING to int\<close>  where
    "intify(m) == if m \<in> int then m else $#0"

definition
  raw_zminus :: "i=>i"  where
    "raw_zminus(z) == \<Union><x,y>\<in>z. intrel``{<y,x>}"

definition
  zminus :: "i=>i"                                 (\<open>$- _\<close> [80] 80)  where
    "$- z == raw_zminus (intify(z))"

definition
  znegative   ::      "i=>o"  where
    "znegative(z) == \<exists>x y. x<y & y\<in>nat & <x,y>\<in>z"

definition
  iszero      ::      "i=>o"  where
    "iszero(z) == z = $# 0"

definition
  raw_nat_of  :: "i=>i"  where
  "raw_nat_of(z) == natify (\<Union><x,y>\<in>z. x#-y)"

definition
  nat_of  :: "i=>i"  where
  "nat_of(z) == raw_nat_of (intify(z))"

definition
  zmagnitude  ::      "i=>i"  where
  \<comment> \<open>could be replaced by an absolute value function from int to int?\<close>
    "zmagnitude(z) ==
     THE m. m\<in>nat & ((~ znegative(z) & z = $# m) |
                       (znegative(z) & $- z = $# m))"

definition
  raw_zmult   ::      "[i,i]=>i"  where
    (*Cannot use UN<x1,y2> here or in zadd because of the form of congruent2.
      Perhaps a "curried" or even polymorphic congruent predicate would be
      better.*)
     "raw_zmult(z1,z2) ==
       \<Union>p1\<in>z1. \<Union>p2\<in>z2.  split(%x1 y1. split(%x2 y2.
                   intrel``{<x1#*x2 #+ y1#*y2, x1#*y2 #+ y1#*x2>}, p2), p1)"

definition
  zmult       ::      "[i,i]=>i"      (infixl \<open>$*\<close> 70)  where
     "z1 $* z2 == raw_zmult (intify(z1),intify(z2))"

definition
  raw_zadd    ::      "[i,i]=>i"  where
     "raw_zadd (z1, z2) ==
       \<Union>z1\<in>z1. \<Union>z2\<in>z2. let <x1,y1>=z1; <x2,y2>=z2
                           in intrel``{<x1#+x2, y1#+y2>}"

definition
  zadd        ::      "[i,i]=>i"      (infixl \<open>$+\<close> 65)  where
     "z1 $+ z2 == raw_zadd (intify(z1),intify(z2))"

definition
  zdiff        ::      "[i,i]=>i"      (infixl \<open>$-\<close> 65)  where
     "z1 $- z2 == z1 $+ zminus(z2)"

definition
  zless        ::      "[i,i]=>o"      (infixl \<open>$<\<close> 50)  where
     "z1 $< z2 == znegative(z1 $- z2)"

definition
  zle          ::      "[i,i]=>o"      (infixl \<open>$\<le>\<close> 50)  where
     "z1 $\<le> z2 == z1 $< z2 | intify(z1)=intify(z2)"

declare quotientE [elim!]

subsection\<open>Proving that \<^term>\<open>intrel\<close> is an equivalence relation\<close>

(** Natural deduction for intrel **)

lemma intrel_iff [simp]:
    "<<x1,y1>,<x2,y2>>: intrel \<longleftrightarrow>
     x1\<in>nat & y1\<in>nat & x2\<in>nat & y2\<in>nat & x1#+y2 = x2#+y1"
by (simp add: intrel_def)

lemma intrelI [intro!]:
    "[| x1#+y2 = x2#+y1; x1\<in>nat; y1\<in>nat; x2\<in>nat; y2\<in>nat |]
     ==> <<x1,y1>,<x2,y2>>: intrel"
by (simp add: intrel_def)

lemma intrelE [elim!]:
  "[| p \<in> intrel;
      !!x1 y1 x2 y2. [| p = <<x1,y1>,<x2,y2>>;  x1#+y2 = x2#+y1;
                        x1\<in>nat; y1\<in>nat; x2\<in>nat; y2\<in>nat |] ==> Q |]
   ==> Q"
by (simp add: intrel_def, blast)

lemma int_trans_lemma:
     "[| x1 #+ y2 = x2 #+ y1; x2 #+ y3 = x3 #+ y2 |] ==> x1 #+ y3 = x3 #+ y1"
apply (rule sym)
apply (erule add_left_cancel)+
apply (simp_all (no_asm_simp))
done

lemma equiv_intrel: "equiv(nat*nat, intrel)"
apply (simp add: equiv_def refl_def sym_def trans_def)
apply (fast elim!: sym int_trans_lemma)
done

lemma image_intrel_int: "[| m\<in>nat; n\<in>nat |] ==> intrel `` {<m,n>} \<in> int"
by (simp add: int_def)

declare equiv_intrel [THEN eq_equiv_class_iff, simp]
declare conj_cong [cong]

lemmas eq_intrelD = eq_equiv_class [OF _ equiv_intrel]

(** int_of: the injection from nat to int **)

lemma int_of_type [simp,TC]: "$#m \<in> int"
by (simp add: int_def quotient_def int_of_def, auto)

lemma int_of_eq [iff]: "($# m = $# n) \<longleftrightarrow> natify(m)=natify(n)"
by (simp add: int_of_def)

lemma int_of_inject: "[| $#m = $#n;  m\<in>nat;  n\<in>nat |] ==> m=n"
by (drule int_of_eq [THEN iffD1], auto)

(** intify: coercion from anything to int **)

lemma intify_in_int [iff,TC]: "intify(x) \<in> int"
by (simp add: intify_def)

lemma intify_ident [simp]: "n \<in> int ==> intify(n) = n"
by (simp add: intify_def)

subsection\<open>Collapsing rules: to remove \<^term>\<open>intify\<close>
            from arithmetic expressions\<close>

lemma intify_idem [simp]: "intify(intify(x)) = intify(x)"
by simp

lemma int_of_natify [simp]: "$# (natify(m)) = $# m"
by (simp add: int_of_def)

lemma zminus_intify [simp]: "$- (intify(m)) = $- m"
by (simp add: zminus_def)

(** Addition **)

lemma zadd_intify1 [simp]: "intify(x) $+ y = x $+ y"
by (simp add: zadd_def)

lemma zadd_intify2 [simp]: "x $+ intify(y) = x $+ y"
by (simp add: zadd_def)

(** Subtraction **)

lemma zdiff_intify1 [simp]:"intify(x) $- y = x $- y"
by (simp add: zdiff_def)

lemma zdiff_intify2 [simp]:"x $- intify(y) = x $- y"
by (simp add: zdiff_def)

(** Multiplication **)

lemma zmult_intify1 [simp]:"intify(x) $* y = x $* y"
by (simp add: zmult_def)

lemma zmult_intify2 [simp]:"x $* intify(y) = x $* y"
by (simp add: zmult_def)

(** Orderings **)

lemma zless_intify1 [simp]:"intify(x) $< y \<longleftrightarrow> x $< y"
by (simp add: zless_def)

lemma zless_intify2 [simp]:"x $< intify(y) \<longleftrightarrow> x $< y"
by (simp add: zless_def)

lemma zle_intify1 [simp]:"intify(x) $\<le> y \<longleftrightarrow> x $\<le> y"
by (simp add: zle_def)

lemma zle_intify2 [simp]:"x $\<le> intify(y) \<longleftrightarrow> x $\<le> y"
by (simp add: zle_def)

subsection\<open>\<^term>\<open>zminus\<close>: unary negation on \<^term>\<open>int\<close>\<close>

lemma zminus_congruent: "(%<x,y>. intrel``{<y,x>}) respects intrel"
by (auto simp add: congruent_def add_ac)

lemma raw_zminus_type: "z \<in> int ==> raw_zminus(z) \<in> int"
apply (simp add: int_def raw_zminus_def)
apply (typecheck add: UN_equiv_class_type [OF equiv_intrel zminus_congruent])
done

lemma zminus_type [TC,iff]: "$-z \<in> int"
by (simp add: zminus_def raw_zminus_type)

lemma raw_zminus_inject:
     "[| raw_zminus(z) = raw_zminus(w);  z \<in> int;  w \<in> int |] ==> z=w"
apply (simp add: int_def raw_zminus_def)
apply (erule UN_equiv_class_inject [OF equiv_intrel zminus_congruent], safe)
apply (auto dest: eq_intrelD simp add: add_ac)
done

lemma zminus_inject_intify [dest!]: "$-z = $-w ==> intify(z) = intify(w)"
apply (simp add: zminus_def)
apply (blast dest!: raw_zminus_inject)
done

lemma zminus_inject: "[| $-z = $-w;  z \<in> int;  w \<in> int |] ==> z=w"
by auto

lemma raw_zminus:
    "[| x\<in>nat;  y\<in>nat |] ==> raw_zminus(intrel``{<x,y>}) = intrel `` {<y,x>}"
apply (simp add: raw_zminus_def UN_equiv_class [OF equiv_intrel zminus_congruent])
done

lemma zminus:
    "[| x\<in>nat;  y\<in>nat |]
     ==> $- (intrel``{<x,y>}) = intrel `` {<y,x>}"
by (simp add: zminus_def raw_zminus image_intrel_int)

lemma raw_zminus_zminus: "z \<in> int ==> raw_zminus (raw_zminus(z)) = z"
by (auto simp add: int_def raw_zminus)

lemma zminus_zminus_intify [simp]: "$- ($- z) = intify(z)"
by (simp add: zminus_def raw_zminus_type raw_zminus_zminus)

lemma zminus_int0 [simp]: "$- ($#0) = $#0"
by (simp add: int_of_def zminus)

lemma zminus_zminus: "z \<in> int ==> $- ($- z) = z"
by simp

subsection\<open>\<^term>\<open>znegative\<close>: the test for negative integers\<close>

lemma znegative: "[| x\<in>nat; y\<in>nat |] ==> znegative(intrel``{<x,y>}) \<longleftrightarrow> x<y"
apply (cases "x<y")
apply (auto simp add: znegative_def not_lt_iff_le)
apply (subgoal_tac "y #+ x2 < x #+ y2", force)
apply (rule add_le_lt_mono, auto)
done

(*No natural number is negative!*)
lemma not_znegative_int_of [iff]: "~ znegative($# n)"
by (simp add: znegative int_of_def)

lemma znegative_zminus_int_of [simp]: "znegative($- $# succ(n))"
by (simp add: znegative int_of_def zminus natify_succ)

lemma not_znegative_imp_zero: "~ znegative($- $# n) ==> natify(n)=0"
by (simp add: znegative int_of_def zminus Ord_0_lt_iff [THEN iff_sym])

subsection\<open>\<^term>\<open>nat_of\<close>: Coercion of an Integer to a Natural Number\<close>

lemma nat_of_intify [simp]: "nat_of(intify(z)) = nat_of(z)"
by (simp add: nat_of_def)

lemma nat_of_congruent: "(\<lambda>x. (\<lambda>\<langle>x,y\<rangle>. x #- y)(x)) respects intrel"
by (auto simp add: congruent_def split: nat_diff_split)

lemma raw_nat_of:
    "[| x\<in>nat;  y\<in>nat |] ==> raw_nat_of(intrel``{<x,y>}) = x#-y"
by (simp add: raw_nat_of_def UN_equiv_class [OF equiv_intrel nat_of_congruent])

lemma raw_nat_of_int_of: "raw_nat_of($# n) = natify(n)"
by (simp add: int_of_def raw_nat_of)

lemma nat_of_int_of [simp]: "nat_of($# n) = natify(n)"
by (simp add: raw_nat_of_int_of nat_of_def)

lemma raw_nat_of_type: "raw_nat_of(z) \<in> nat"
by (simp add: raw_nat_of_def)

lemma nat_of_type [iff,TC]: "nat_of(z) \<in> nat"
by (simp add: nat_of_def raw_nat_of_type)

subsection\<open>zmagnitude: magnitide of an integer, as a natural number\<close>

lemma zmagnitude_int_of [simp]: "zmagnitude($# n) = natify(n)"
by (auto simp add: zmagnitude_def int_of_eq)

lemma natify_int_of_eq: "natify(x)=n ==> $#x = $# n"
apply (drule sym)
apply (simp (no_asm_simp) add: int_of_eq)
done

lemma zmagnitude_zminus_int_of [simp]: "zmagnitude($- $# n) = natify(n)"
apply (simp add: zmagnitude_def)
apply (rule the_equality)
apply (auto dest!: not_znegative_imp_zero natify_int_of_eq
            iff del: int_of_eq, auto)
done

lemma zmagnitude_type [iff,TC]: "zmagnitude(z)\<in>nat"
apply (simp add: zmagnitude_def)
apply (rule theI2, auto)
done

lemma not_zneg_int_of:
     "[| z \<in> int; ~ znegative(z) |] ==> \<exists>n\<in>nat. z = $# n"
apply (auto simp add: int_def znegative int_of_def not_lt_iff_le)
apply (rename_tac x y)
apply (rule_tac x="x#-y" in bexI)
apply (auto simp add: add_diff_inverse2)
done

lemma not_zneg_mag [simp]:
     "[| z \<in> int; ~ znegative(z) |] ==> $# (zmagnitude(z)) = z"
by (drule not_zneg_int_of, auto)

lemma zneg_int_of:
     "[| znegative(z); z \<in> int |] ==> \<exists>n\<in>nat. z = $- ($# succ(n))"
by (auto simp add: int_def znegative zminus int_of_def dest!: less_imp_succ_add)

lemma zneg_mag [simp]:
     "[| znegative(z); z \<in> int |] ==> $# (zmagnitude(z)) = $- z"
by (drule zneg_int_of, auto)

lemma int_cases: "z \<in> int ==> \<exists>n\<in>nat. z = $# n | z = $- ($# succ(n))"
apply (case_tac "znegative (z) ")
prefer 2 apply (blast dest: not_zneg_mag sym)
apply (blast dest: zneg_int_of)
done

lemma not_zneg_raw_nat_of:
     "[| ~ znegative(z); z \<in> int |] ==> $# (raw_nat_of(z)) = z"
apply (drule not_zneg_int_of)
apply (auto simp add: raw_nat_of_type raw_nat_of_int_of)
done

lemma not_zneg_nat_of_intify:
     "~ znegative(intify(z)) ==> $# (nat_of(z)) = intify(z)"
by (simp (no_asm_simp) add: nat_of_def not_zneg_raw_nat_of)

lemma not_zneg_nat_of: "[| ~ znegative(z); z \<in> int |] ==> $# (nat_of(z)) = z"
apply (simp (no_asm_simp) add: not_zneg_nat_of_intify)
done

lemma zneg_nat_of [simp]: "znegative(intify(z)) ==> nat_of(z) = 0"
apply (subgoal_tac "intify(z) \<in> int")
apply (simp add: int_def)
apply (auto simp add: znegative nat_of_def raw_nat_of
            split: nat_diff_split)
done

subsection\<open>\<^term>\<open>zadd\<close>: addition on int\<close>

text\<open>Congruence Property for Addition\<close>
lemma zadd_congruent2:
    "(%z1 z2. let <x1,y1>=z1; <x2,y2>=z2
                            in intrel``{<x1#+x2, y1#+y2>})
     respects2 intrel"
apply (simp add: congruent2_def)
(*Proof via congruent2_commuteI seems longer*)
apply safe
apply (simp (no_asm_simp) add: add_assoc Let_def)
(*The rest should be trivial, but rearranging terms is hard
  add_ac does not help rewriting with the assumptions.*)
apply (rule_tac m1 = x1a in add_left_commute [THEN ssubst])
apply (rule_tac m1 = x2a in add_left_commute [THEN ssubst])
apply (simp (no_asm_simp) add: add_assoc [symmetric])
done

lemma raw_zadd_type: "[| z \<in> int;  w \<in> int |] ==> raw_zadd(z,w) \<in> int"
apply (simp add: int_def raw_zadd_def)
apply (rule UN_equiv_class_type2 [OF equiv_intrel zadd_congruent2], assumption+)
apply (simp add: Let_def)
done

lemma zadd_type [iff,TC]: "z $+ w \<in> int"
by (simp add: zadd_def raw_zadd_type)

lemma raw_zadd:
  "[| x1\<in>nat; y1\<in>nat;  x2\<in>nat; y2\<in>nat |]
   ==> raw_zadd (intrel``{<x1,y1>}, intrel``{<x2,y2>}) =
       intrel `` {<x1#+x2, y1#+y2>}"
apply (simp add: raw_zadd_def
             UN_equiv_class2 [OF equiv_intrel equiv_intrel zadd_congruent2])
apply (simp add: Let_def)
done

lemma zadd:
  "[| x1\<in>nat; y1\<in>nat;  x2\<in>nat; y2\<in>nat |]
   ==> (intrel``{<x1,y1>}) $+ (intrel``{<x2,y2>}) =
       intrel `` {<x1#+x2, y1#+y2>}"
by (simp add: zadd_def raw_zadd image_intrel_int)

lemma raw_zadd_int0: "z \<in> int ==> raw_zadd ($#0,z) = z"
by (auto simp add: int_def int_of_def raw_zadd)

lemma zadd_int0_intify [simp]: "$#0 $+ z = intify(z)"
by (simp add: zadd_def raw_zadd_int0)

lemma zadd_int0: "z \<in> int ==> $#0 $+ z = z"
by simp

lemma raw_zminus_zadd_distrib:
     "[| z \<in> int;  w \<in> int |] ==> $- raw_zadd(z,w) = raw_zadd($- z, $- w)"
by (auto simp add: zminus raw_zadd int_def)

lemma zminus_zadd_distrib [simp]: "$- (z $+ w) = $- z $+ $- w"
by (simp add: zadd_def raw_zminus_zadd_distrib)

lemma raw_zadd_commute:
     "[| z \<in> int;  w \<in> int |] ==> raw_zadd(z,w) = raw_zadd(w,z)"
by (auto simp add: raw_zadd add_ac int_def)

lemma zadd_commute: "z $+ w = w $+ z"
by (simp add: zadd_def raw_zadd_commute)

lemma raw_zadd_assoc:
    "[| z1: int;  z2: int;  z3: int |]
     ==> raw_zadd (raw_zadd(z1,z2),z3) = raw_zadd(z1,raw_zadd(z2,z3))"
by (auto simp add: int_def raw_zadd add_assoc)

lemma zadd_assoc: "(z1 $+ z2) $+ z3 = z1 $+ (z2 $+ z3)"
by (simp add: zadd_def raw_zadd_type raw_zadd_assoc)

(*For AC rewriting*)
lemma zadd_left_commute: "z1$+(z2$+z3) = z2$+(z1$+z3)"
apply (simp add: zadd_assoc [symmetric])
apply (simp add: zadd_commute)
done

(*Integer addition is an AC operator*)
lemmas zadd_ac = zadd_assoc zadd_commute zadd_left_commute

lemma int_of_add: "$# (m #+ n) = ($#m) $+ ($#n)"
by (simp add: int_of_def zadd)

lemma int_succ_int_1: "$# succ(m) = $# 1 $+ ($# m)"
by (simp add: int_of_add [symmetric] natify_succ)

lemma int_of_diff:
     "[| m\<in>nat;  n \<le> m |] ==> $# (m #- n) = ($#m) $- ($#n)"
apply (simp add: int_of_def zdiff_def)
apply (frule lt_nat_in_nat)
apply (simp_all add: zadd zminus add_diff_inverse2)
done

lemma raw_zadd_zminus_inverse: "z \<in> int ==> raw_zadd (z, $- z) = $#0"
by (auto simp add: int_def int_of_def zminus raw_zadd add_commute)

lemma zadd_zminus_inverse [simp]: "z $+ ($- z) = $#0"
apply (simp add: zadd_def)
apply (subst zminus_intify [symmetric])
apply (rule intify_in_int [THEN raw_zadd_zminus_inverse])
done

lemma zadd_zminus_inverse2 [simp]: "($- z) $+ z = $#0"
by (simp add: zadd_commute zadd_zminus_inverse)

lemma zadd_int0_right_intify [simp]: "z $+ $#0 = intify(z)"
by (rule trans [OF zadd_commute zadd_int0_intify])

lemma zadd_int0_right: "z \<in> int ==> z $+ $#0 = z"
by simp

subsection\<open>\<^term>\<open>zmult\<close>: Integer Multiplication\<close>

text\<open>Congruence property for multiplication\<close>
lemma zmult_congruent2:
    "(%p1 p2. split(%x1 y1. split(%x2 y2.
                    intrel``{<x1#*x2 #+ y1#*y2, x1#*y2 #+ y1#*x2>}, p2), p1))
     respects2 intrel"
apply (rule equiv_intrel [THEN congruent2_commuteI], auto)
(*Proof that zmult is congruent in one argument*)
apply (rename_tac x y)
apply (frule_tac t = "%u. x#*u" in sym [THEN subst_context])
apply (drule_tac t = "%u. y#*u" in subst_context)
apply (erule add_left_cancel)+
apply (simp_all add: add_mult_distrib_left)
done

lemma raw_zmult_type: "[| z \<in> int;  w \<in> int |] ==> raw_zmult(z,w) \<in> int"
apply (simp add: int_def raw_zmult_def)
apply (rule UN_equiv_class_type2 [OF equiv_intrel zmult_congruent2], assumption+)
apply (simp add: Let_def)
done

lemma zmult_type [iff,TC]: "z $* w \<in> int"
by (simp add: zmult_def raw_zmult_type)

lemma raw_zmult:
     "[| x1\<in>nat; y1\<in>nat;  x2\<in>nat; y2\<in>nat |]
      ==> raw_zmult(intrel``{<x1,y1>}, intrel``{<x2,y2>}) =
          intrel `` {<x1#*x2 #+ y1#*y2, x1#*y2 #+ y1#*x2>}"
by (simp add: raw_zmult_def
           UN_equiv_class2 [OF equiv_intrel equiv_intrel zmult_congruent2])

lemma zmult:
     "[| x1\<in>nat; y1\<in>nat;  x2\<in>nat; y2\<in>nat |]
      ==> (intrel``{<x1,y1>}) $* (intrel``{<x2,y2>}) =
          intrel `` {<x1#*x2 #+ y1#*y2, x1#*y2 #+ y1#*x2>}"
by (simp add: zmult_def raw_zmult image_intrel_int)

lemma raw_zmult_int0: "z \<in> int ==> raw_zmult ($#0,z) = $#0"
by (auto simp add: int_def int_of_def raw_zmult)

lemma zmult_int0 [simp]: "$#0 $* z = $#0"
by (simp add: zmult_def raw_zmult_int0)

lemma raw_zmult_int1: "z \<in> int ==> raw_zmult ($#1,z) = z"
by (auto simp add: int_def int_of_def raw_zmult)

lemma zmult_int1_intify [simp]: "$#1 $* z = intify(z)"
by (simp add: zmult_def raw_zmult_int1)

lemma zmult_int1: "z \<in> int ==> $#1 $* z = z"
by simp

lemma raw_zmult_commute:
     "[| z \<in> int;  w \<in> int |] ==> raw_zmult(z,w) = raw_zmult(w,z)"
by (auto simp add: int_def raw_zmult add_ac mult_ac)

lemma zmult_commute: "z $* w = w $* z"
by (simp add: zmult_def raw_zmult_commute)

lemma raw_zmult_zminus:
     "[| z \<in> int;  w \<in> int |] ==> raw_zmult($- z, w) = $- raw_zmult(z, w)"
by (auto simp add: int_def zminus raw_zmult add_ac)

lemma zmult_zminus [simp]: "($- z) $* w = $- (z $* w)"
apply (simp add: zmult_def raw_zmult_zminus)
apply (subst zminus_intify [symmetric], rule raw_zmult_zminus, auto)
done

lemma zmult_zminus_right [simp]: "w $* ($- z) = $- (w $* z)"
by (simp add: zmult_commute [of w])

lemma raw_zmult_assoc:
    "[| z1: int;  z2: int;  z3: int |]
     ==> raw_zmult (raw_zmult(z1,z2),z3) = raw_zmult(z1,raw_zmult(z2,z3))"
by (auto simp add: int_def raw_zmult add_mult_distrib_left add_ac mult_ac)

lemma zmult_assoc: "(z1 $* z2) $* z3 = z1 $* (z2 $* z3)"
by (simp add: zmult_def raw_zmult_type raw_zmult_assoc)

(*For AC rewriting*)
lemma zmult_left_commute: "z1$*(z2$*z3) = z2$*(z1$*z3)"
apply (simp add: zmult_assoc [symmetric])
apply (simp add: zmult_commute)
done

(*Integer multiplication is an AC operator*)
lemmas zmult_ac = zmult_assoc zmult_commute zmult_left_commute

lemma raw_zadd_zmult_distrib:
    "[| z1: int;  z2: int;  w \<in> int |]
     ==> raw_zmult(raw_zadd(z1,z2), w) =
         raw_zadd (raw_zmult(z1,w), raw_zmult(z2,w))"
by (auto simp add: int_def raw_zadd raw_zmult add_mult_distrib_left add_ac mult_ac)

lemma zadd_zmult_distrib: "(z1 $+ z2) $* w = (z1 $* w) $+ (z2 $* w)"
by (simp add: zmult_def zadd_def raw_zadd_type raw_zmult_type
              raw_zadd_zmult_distrib)

lemma zadd_zmult_distrib2: "w $* (z1 $+ z2) = (w $* z1) $+ (w $* z2)"
by (simp add: zmult_commute [of w] zadd_zmult_distrib)

lemmas int_typechecks =
  int_of_type zminus_type zmagnitude_type zadd_type zmult_type

(*** Subtraction laws ***)

lemma zdiff_type [iff,TC]: "z $- w \<in> int"
by (simp add: zdiff_def)

lemma zminus_zdiff_eq [simp]: "$- (z $- y) = y $- z"
by (simp add: zdiff_def zadd_commute)

lemma zdiff_zmult_distrib: "(z1 $- z2) $* w = (z1 $* w) $- (z2 $* w)"
apply (simp add: zdiff_def)
apply (subst zadd_zmult_distrib)
apply (simp add: zmult_zminus)
done

lemma zdiff_zmult_distrib2: "w $* (z1 $- z2) = (w $* z1) $- (w $* z2)"
by (simp add: zmult_commute [of w] zdiff_zmult_distrib)

lemma zadd_zdiff_eq: "x $+ (y $- z) = (x $+ y) $- z"
by (simp add: zdiff_def zadd_ac)

lemma zdiff_zadd_eq: "(x $- y) $+ z = (x $+ z) $- y"
by (simp add: zdiff_def zadd_ac)

subsection\<open>The "Less Than" Relation\<close>

(*"Less than" is a linear ordering*)
lemma zless_linear_lemma:
     "[| z \<in> int; w \<in> int |] ==> z$<w | z=w | w$<z"
apply (simp add: int_def zless_def znegative_def zdiff_def, auto)
apply (simp add: zadd zminus image_iff Bex_def)
apply (rule_tac i = "xb#+ya" and j = "xc #+ y" in Ord_linear_lt)
apply (force dest!: spec simp add: add_ac)+
done

lemma zless_linear: "z$<w | intify(z)=intify(w) | w$<z"
apply (cut_tac z = " intify (z) " and w = " intify (w) " in zless_linear_lemma)
apply auto
done

lemma zless_not_refl [iff]: "~ (z$<z)"
by (auto simp add: zless_def znegative_def int_of_def zdiff_def)

lemma neq_iff_zless: "[| x \<in> int; y \<in> int |] ==> (x \<noteq> y) \<longleftrightarrow> (x $< y | y $< x)"
by (cut_tac z = x and w = y in zless_linear, auto)

lemma zless_imp_intify_neq: "w $< z ==> intify(w) \<noteq> intify(z)"
apply auto
apply (subgoal_tac "~ (intify (w) $< intify (z))")
apply (erule_tac [2] ssubst)
apply (simp (no_asm_use))
apply auto
done

(*This lemma allows direct proofs of other <-properties*)
lemma zless_imp_succ_zadd_lemma:
    "[| w $< z; w \<in> int; z \<in> int |] ==> (\<exists>n\<in>nat. z = w $+ $#(succ(n)))"
apply (simp add: zless_def znegative_def zdiff_def int_def)
apply (auto dest!: less_imp_succ_add simp add: zadd zminus int_of_def)
apply (rule_tac x = k in bexI)
apply (erule_tac i="succ (v)" for v in add_left_cancel, auto)
done

lemma zless_imp_succ_zadd:
     "w $< z ==> (\<exists>n\<in>nat. w $+ $#(succ(n)) = intify(z))"
apply (subgoal_tac "intify (w) $< intify (z) ")
apply (drule_tac w = "intify (w) " in zless_imp_succ_zadd_lemma)
apply auto
done

lemma zless_succ_zadd_lemma:
    "w \<in> int ==> w $< w $+ $# succ(n)"
apply (simp add: zless_def znegative_def zdiff_def int_def)
apply (auto simp add: zadd zminus int_of_def image_iff)
apply (rule_tac x = 0 in exI, auto)
done

lemma zless_succ_zadd: "w $< w $+ $# succ(n)"
by (cut_tac intify_in_int [THEN zless_succ_zadd_lemma], auto)

lemma zless_iff_succ_zadd:
     "w $< z \<longleftrightarrow> (\<exists>n\<in>nat. w $+ $#(succ(n)) = intify(z))"
apply (rule iffI)
apply (erule zless_imp_succ_zadd, auto)
apply (rename_tac "n")
apply (cut_tac w = w and n = n in zless_succ_zadd, auto)
done

lemma zless_int_of [simp]: "[| m\<in>nat; n\<in>nat |] ==> ($#m $< $#n) \<longleftrightarrow> (m<n)"
apply (simp add: less_iff_succ_add zless_iff_succ_zadd int_of_add [symmetric])
apply (blast intro: sym)
done

lemma zless_trans_lemma:
    "[| x $< y; y $< z; x \<in> int; y \<in> int; z \<in> int |] ==> x $< z"
apply (simp add: zless_def znegative_def zdiff_def int_def)
apply (auto simp add: zadd zminus image_iff)
apply (rename_tac x1 x2 y1 y2)
apply (rule_tac x = "x1#+x2" in exI)
apply (rule_tac x = "y1#+y2" in exI)
apply (auto simp add: add_lt_mono)
apply (rule sym)
apply hypsubst_thin
apply (erule add_left_cancel)+
apply auto
done

lemma zless_trans [trans]: "[| x $< y; y $< z |] ==> x $< z"
apply (subgoal_tac "intify (x) $< intify (z) ")
apply (rule_tac [2] y = "intify (y) " in zless_trans_lemma)
apply auto
done

lemma zless_not_sym: "z $< w ==> ~ (w $< z)"
by (blast dest: zless_trans)

(* [| z $< w; ~ P ==> w $< z |] ==> P *)
lemmas zless_asym = zless_not_sym [THEN swap]

lemma zless_imp_zle: "z $< w ==> z $\<le> w"
by (simp add: zle_def)

lemma zle_linear: "z $\<le> w | w $\<le> z"
apply (simp add: zle_def)
apply (cut_tac zless_linear, blast)
done

subsection\<open>Less Than or Equals\<close>

lemma zle_refl: "z $\<le> z"
by (simp add: zle_def)

lemma zle_eq_refl: "x=y ==> x $\<le> y"
by (simp add: zle_refl)

lemma zle_anti_sym_intify: "[| x $\<le> y; y $\<le> x |] ==> intify(x) = intify(y)"
apply (simp add: zle_def, auto)
apply (blast dest: zless_trans)
done

lemma zle_anti_sym: "[| x $\<le> y; y $\<le> x; x \<in> int; y \<in> int |] ==> x=y"
by (drule zle_anti_sym_intify, auto)

lemma zle_trans_lemma:
     "[| x \<in> int; y \<in> int; z \<in> int; x $\<le> y; y $\<le> z |] ==> x $\<le> z"
apply (simp add: zle_def, auto)
apply (blast intro: zless_trans)
done

lemma zle_trans [trans]: "[| x $\<le> y; y $\<le> z |] ==> x $\<le> z"
apply (subgoal_tac "intify (x) $\<le> intify (z) ")
apply (rule_tac [2] y = "intify (y) " in zle_trans_lemma)
apply auto
done

lemma zle_zless_trans [trans]: "[| i $\<le> j; j $< k |] ==> i $< k"
apply (auto simp add: zle_def)
apply (blast intro: zless_trans)
apply (simp add: zless_def zdiff_def zadd_def)
done

lemma zless_zle_trans [trans]: "[| i $< j; j $\<le> k |] ==> i $< k"
apply (auto simp add: zle_def)
apply (blast intro: zless_trans)
apply (simp add: zless_def zdiff_def zminus_def)
done

lemma not_zless_iff_zle: "~ (z $< w) \<longleftrightarrow> (w $\<le> z)"
apply (cut_tac z = z and w = w in zless_linear)
apply (auto dest: zless_trans simp add: zle_def)
apply (auto dest!: zless_imp_intify_neq)
done

lemma not_zle_iff_zless: "~ (z $\<le> w) \<longleftrightarrow> (w $< z)"
by (simp add: not_zless_iff_zle [THEN iff_sym])

subsection\<open>More subtraction laws (for \<open>zcompare_rls\<close>)\<close>

lemma zdiff_zdiff_eq: "(x $- y) $- z = x $- (y $+ z)"
by (simp add: zdiff_def zadd_ac)

lemma zdiff_zdiff_eq2: "x $- (y $- z) = (x $+ z) $- y"
by (simp add: zdiff_def zadd_ac)

lemma zdiff_zless_iff: "(x$-y $< z) \<longleftrightarrow> (x $< z $+ y)"
by (simp add: zless_def zdiff_def zadd_ac)

lemma zless_zdiff_iff: "(x $< z$-y) \<longleftrightarrow> (x $+ y $< z)"
by (simp add: zless_def zdiff_def zadd_ac)

lemma zdiff_eq_iff: "[| x \<in> int; z \<in> int |] ==> (x$-y = z) \<longleftrightarrow> (x = z $+ y)"
by (auto simp add: zdiff_def zadd_assoc)

lemma eq_zdiff_iff: "[| x \<in> int; z \<in> int |] ==> (x = z$-y) \<longleftrightarrow> (x $+ y = z)"
by (auto simp add: zdiff_def zadd_assoc)

lemma zdiff_zle_iff_lemma:
     "[| x \<in> int; z \<in> int |] ==> (x$-y $\<le> z) \<longleftrightarrow> (x $\<le> z $+ y)"
by (auto simp add: zle_def zdiff_eq_iff zdiff_zless_iff)

lemma zdiff_zle_iff: "(x$-y $\<le> z) \<longleftrightarrow> (x $\<le> z $+ y)"
by (cut_tac zdiff_zle_iff_lemma [OF intify_in_int intify_in_int], simp)

lemma zle_zdiff_iff_lemma:
     "[| x \<in> int; z \<in> int |] ==>(x $\<le> z$-y) \<longleftrightarrow> (x $+ y $\<le> z)"
apply (auto simp add: zle_def zdiff_eq_iff zless_zdiff_iff)
apply (auto simp add: zdiff_def zadd_assoc)
done

lemma zle_zdiff_iff: "(x $\<le> z$-y) \<longleftrightarrow> (x $+ y $\<le> z)"
by (cut_tac zle_zdiff_iff_lemma [ OF intify_in_int intify_in_int], simp)

text\<open>This list of rewrites simplifies (in)equalities by bringing subtractions
  to the top and then moving negative terms to the other side.
  Use with \<open>zadd_ac\<close>\<close>
lemmas zcompare_rls =
     zdiff_def [symmetric]
     zadd_zdiff_eq zdiff_zadd_eq zdiff_zdiff_eq zdiff_zdiff_eq2
     zdiff_zless_iff zless_zdiff_iff zdiff_zle_iff zle_zdiff_iff
     zdiff_eq_iff eq_zdiff_iff

subsection\<open>Monotonicity and Cancellation Results for Instantiation
     of the CancelNumerals Simprocs\<close>

lemma zadd_left_cancel:
     "[| w \<in> int; w': int |] ==> (z $+ w' = z $+ w) \<longleftrightarrow> (w' = w)"
apply safe
apply (drule_tac t = "%x. x $+ ($-z) " in subst_context)
apply (simp add: zadd_ac)
done

lemma zadd_left_cancel_intify [simp]:
     "(z $+ w' = z $+ w) \<longleftrightarrow> intify(w') = intify(w)"
apply (rule iff_trans)
apply (rule_tac [2] zadd_left_cancel, auto)
done

lemma zadd_right_cancel:
     "[| w \<in> int; w': int |] ==> (w' $+ z = w $+ z) \<longleftrightarrow> (w' = w)"
apply safe
apply (drule_tac t = "%x. x $+ ($-z) " in subst_context)
apply (simp add: zadd_ac)
done

lemma zadd_right_cancel_intify [simp]:
     "(w' $+ z = w $+ z) \<longleftrightarrow> intify(w') = intify(w)"
apply (rule iff_trans)
apply (rule_tac [2] zadd_right_cancel, auto)
done

lemma zadd_right_cancel_zless [simp]: "(w' $+ z $< w $+ z) \<longleftrightarrow> (w' $< w)"
by (simp add: zdiff_zless_iff [THEN iff_sym] zdiff_def zadd_assoc)

lemma zadd_left_cancel_zless [simp]: "(z $+ w' $< z $+ w) \<longleftrightarrow> (w' $< w)"
by (simp add: zadd_commute [of z] zadd_right_cancel_zless)

lemma zadd_right_cancel_zle [simp]: "(w' $+ z $\<le> w $+ z) \<longleftrightarrow> w' $\<le> w"
by (simp add: zle_def)

lemma zadd_left_cancel_zle [simp]: "(z $+ w' $\<le> z $+ w) \<longleftrightarrow>  w' $\<le> w"
by (simp add: zadd_commute [of z]  zadd_right_cancel_zle)

(*"v $\<le> w ==> v$+z $\<le> w$+z"*)
lemmas zadd_zless_mono1 = zadd_right_cancel_zless [THEN iffD2]

(*"v $\<le> w ==> z$+v $\<le> z$+w"*)
lemmas zadd_zless_mono2 = zadd_left_cancel_zless [THEN iffD2]

(*"v $\<le> w ==> v$+z $\<le> w$+z"*)
lemmas zadd_zle_mono1 = zadd_right_cancel_zle [THEN iffD2]

(*"v $\<le> w ==> z$+v $\<le> z$+w"*)
lemmas zadd_zle_mono2 = zadd_left_cancel_zle [THEN iffD2]

lemma zadd_zle_mono: "[| w' $\<le> w; z' $\<le> z |] ==> w' $+ z' $\<le> w $+ z"
by (erule zadd_zle_mono1 [THEN zle_trans], simp)

lemma zadd_zless_mono: "[| w' $< w; z' $\<le> z |] ==> w' $+ z' $< w $+ z"
by (erule zadd_zless_mono1 [THEN zless_zle_trans], simp)

subsection\<open>Comparison laws\<close>

lemma zminus_zless_zminus [simp]: "($- x $< $- y) \<longleftrightarrow> (y $< x)"
by (simp add: zless_def zdiff_def zadd_ac)

lemma zminus_zle_zminus [simp]: "($- x $\<le> $- y) \<longleftrightarrow> (y $\<le> x)"
by (simp add: not_zless_iff_zle [THEN iff_sym])

subsubsection\<open>More inequality lemmas\<close>

lemma equation_zminus: "[| x \<in> int;  y \<in> int |] ==> (x = $- y) \<longleftrightarrow> (y = $- x)"
by auto

lemma zminus_equation: "[| x \<in> int;  y \<in> int |] ==> ($- x = y) \<longleftrightarrow> ($- y = x)"
by auto

lemma equation_zminus_intify: "(intify(x) = $- y) \<longleftrightarrow> (intify(y) = $- x)"
apply (cut_tac x = "intify (x) " and y = "intify (y) " in equation_zminus)
apply auto
done

lemma zminus_equation_intify: "($- x = intify(y)) \<longleftrightarrow> ($- y = intify(x))"
apply (cut_tac x = "intify (x) " and y = "intify (y) " in zminus_equation)
apply auto
done

subsubsection\<open>The next several equations are permutative: watch out!\<close>

lemma zless_zminus: "(x $< $- y) \<longleftrightarrow> (y $< $- x)"
by (simp add: zless_def zdiff_def zadd_ac)

lemma zminus_zless: "($- x $< y) \<longleftrightarrow> ($- y $< x)"
by (simp add: zless_def zdiff_def zadd_ac)

lemma zle_zminus: "(x $\<le> $- y) \<longleftrightarrow> (y $\<le> $- x)"
by (simp add: not_zless_iff_zle [THEN iff_sym] zminus_zless)

lemma zminus_zle: "($- x $\<le> y) \<longleftrightarrow> ($- y $\<le> x)"
by (simp add: not_zless_iff_zle [THEN iff_sym] zless_zminus)

end


section "Solution to Day 2 of AoC 2020"

theory day2
  imports Main "HOL.Code_Numeral" string_utils natural_utils list_natural_utils
begin

text "This is a solution to the puzzle for day 2"

subsection "Input parsing"

text "Parse the policies from the file"

type_synonym policy = "(natural * natural * char)"

fun parse_line :: "string \<Rightarrow> (policy * string)"
  where "(parse_line s) = (
    (let (min, rest) = (split_once CHR ''-'' s) in
      (let (max, rest) = (split_once CHR '' '' rest) in
        (let (c, rest) = (split_once CHR '':'' rest) in
          ((str_to_nat min, str_to_nat max, list.hd c), list.tl rest)
        )
      )
    )
  )"

text "an example policy spec and string to check"
value "parse_line ''1-3 a: abcde''"

text "parse\\_input parses the whole file"
fun parse_input :: "string \<Rightarrow> (policy * string) list"
  where "parse_input l = map (parse_line) (split CHR ''\<newline>'' (trim l))"

subsection "Solution Algorithm"

text "recursively check if a policy matches, character by character"

fun matches_policy :: "policy \<Rightarrow> string \<Rightarrow> bool"
  where "matches_policy (min_c, max_c, c) '''' = (min_c = 0)"
  | "matches_policy (min_c, max_c, c) (Cons n tail) = (
    if n = c then
      if max_c = 0 then False else
      (matches_policy (min_c-1, max_c-1, c) tail)
    else
      (matches_policy (min_c, max_c, c) tail)
    )"

text "The solution to part1 counts the number of entires in the list where the string matches
the policy"
fun part1 :: "string \<Rightarrow> natural"
  where "part1 a = (let policies = (parse_input a) in
    sum_list (map count_bool (map (\<lambda>((min_c, max_c, c),str). matches_policy (min_c, max_c, c) str) policies))
  )"

definition xor :: "bool \<Rightarrow> bool \<Rightarrow> bool" (infixl "\<oplus>" 60)
  where "xor a b \<equiv> (a \<and> \<not>b) \<or> (b \<and> \<not>a)"

fun matches_policy_2 :: "policy \<Rightarrow> string \<Rightarrow> bool"
  where "matches_policy_2 (ca, cb, c) str = ((nth (ca-1) str) = c) \<oplus> ((nth (cb-1) str) = c)"

text "Part 2 is like part 1 but the policy is different"

fun part2 :: "string \<Rightarrow> natural"
  where "part2 a = (let policies = (parse_input a) in
    sum_list (map count_bool (map (\<lambda>((min_c, max_c, c),str). matches_policy_2 (min_c, max_c, c) str) policies))
  )"

subsection "Testing"

text "We expect our test case to return 2"

definition example_input :: "string" where "example_input = ''1-3 a: abcde
1-3 b: cdefg
2-9 c: ccccccccc
''"

lemma "part1 example_input = 2"
  by eval

text "And for part 2 it should return 1"

lemma "part2 example_input = 1"
  by eval

export_code "part1" "part2" in Haskell module_name Solution

end


(*  Title:      HOL/HOLCF/Fix.thy
    Author:     Franz Regensburger
    Author:     Brian Huffman
*)

section {* Fixed point operator and admissibility *}

theory Fix
imports Cfun
begin

default_sort pcpo

subsection {* Iteration *}

primrec iterate :: "nat \<Rightarrow> ('a::cpo \<rightarrow> 'a) \<rightarrow> ('a \<rightarrow> 'a)" where
    "iterate 0 = (\<Lambda> F x. x)"
  | "iterate (Suc n) = (\<Lambda> F x. F\<cdot>(iterate n\<cdot>F\<cdot>x))"

text {* Derive inductive properties of iterate from primitive recursion *}

lemma iterate_0 [simp]: "iterate 0\<cdot>F\<cdot>x = x"
by simp

lemma iterate_Suc [simp]: "iterate (Suc n)\<cdot>F\<cdot>x = F\<cdot>(iterate n\<cdot>F\<cdot>x)"
by simp

declare iterate.simps [simp del]

lemma iterate_Suc2: "iterate (Suc n)\<cdot>F\<cdot>x = iterate n\<cdot>F\<cdot>(F\<cdot>x)"
by (induct n) simp_all

lemma iterate_iterate:
  "iterate m\<cdot>F\<cdot>(iterate n\<cdot>F\<cdot>x) = iterate (m + n)\<cdot>F\<cdot>x"
by (induct m) simp_all

text {* The sequence of function iterations is a chain. *}

lemma chain_iterate [simp]: "chain (\<lambda>i. iterate i\<cdot>F\<cdot>\<bottom>)"
by (rule chainI, unfold iterate_Suc2, rule monofun_cfun_arg, rule minimal)

subsection {* Least fixed point operator *}

definition
  "fix" :: "('a \<rightarrow> 'a) \<rightarrow> 'a" where
  "fix = (\<Lambda> F. \<Squnion>i. iterate i\<cdot>F\<cdot>\<bottom>)"

text {* Binder syntax for @{term fix} *}

abbreviation
  fix_syn :: "('a \<Rightarrow> 'a) \<Rightarrow> 'a"  (binder "FIX " 10) where
  "fix_syn (\<lambda>x. f x) \<equiv> fix\<cdot>(\<Lambda> x. f x)"

notation (xsymbols)
  fix_syn  (binder "\<mu> " 10)

text {* Properties of @{term fix} *}

text {* direct connection between @{term fix} and iteration *}

lemma fix_def2: "fix\<cdot>F = (\<Squnion>i. iterate i\<cdot>F\<cdot>\<bottom>)"
unfolding fix_def by simp

lemma iterate_below_fix: "iterate n\<cdot>f\<cdot>\<bottom> \<sqsubseteq> fix\<cdot>f"
  unfolding fix_def2
  using chain_iterate by (rule is_ub_thelub)

text {*
  Kleene's fixed point theorems for continuous functions in pointed
  omega cpo's
*}

lemma fix_eq: "fix\<cdot>F = F\<cdot>(fix\<cdot>F)"
apply (simp add: fix_def2)
apply (subst lub_range_shift [of _ 1, symmetric])
apply (rule chain_iterate)
apply (subst contlub_cfun_arg)
apply (rule chain_iterate)
apply simp
done

lemma fix_least_below: "F\<cdot>x \<sqsubseteq> x \<Longrightarrow> fix\<cdot>F \<sqsubseteq> x"
apply (simp add: fix_def2)
apply (rule lub_below)
apply (rule chain_iterate)
apply (induct_tac i)
apply simp
apply simp
apply (erule rev_below_trans)
apply (erule monofun_cfun_arg)
done

lemma fix_least: "F\<cdot>x = x \<Longrightarrow> fix\<cdot>F \<sqsubseteq> x"
by (rule fix_least_below, simp)

lemma fix_eqI:
  assumes fixed: "F\<cdot>x = x" and least: "\<And>z. F\<cdot>z = z \<Longrightarrow> x \<sqsubseteq> z"
  shows "fix\<cdot>F = x"
apply (rule below_antisym)
apply (rule fix_least [OF fixed])
apply (rule least [OF fix_eq [symmetric]])
done

lemma fix_eq2: "f \<equiv> fix\<cdot>F \<Longrightarrow> f = F\<cdot>f"
by (simp add: fix_eq [symmetric])

lemma fix_eq3: "f \<equiv> fix\<cdot>F \<Longrightarrow> f\<cdot>x = F\<cdot>f\<cdot>x"
by (erule fix_eq2 [THEN cfun_fun_cong])

lemma fix_eq4: "f = fix\<cdot>F \<Longrightarrow> f = F\<cdot>f"
apply (erule ssubst)
apply (rule fix_eq)
done

lemma fix_eq5: "f = fix\<cdot>F \<Longrightarrow> f\<cdot>x = F\<cdot>f\<cdot>x"
by (erule fix_eq4 [THEN cfun_fun_cong])

text {* strictness of @{term fix} *}

lemma fix_bottom_iff: "(fix\<cdot>F = \<bottom>) = (F\<cdot>\<bottom> = \<bottom>)"
apply (rule iffI)
apply (erule subst)
apply (rule fix_eq [symmetric])
apply (erule fix_least [THEN bottomI])
done

lemma fix_strict: "F\<cdot>\<bottom> = \<bottom> \<Longrightarrow> fix\<cdot>F = \<bottom>"
by (simp add: fix_bottom_iff)

lemma fix_defined: "F\<cdot>\<bottom> \<noteq> \<bottom> \<Longrightarrow> fix\<cdot>F \<noteq> \<bottom>"
by (simp add: fix_bottom_iff)

text {* @{term fix} applied to identity and constant functions *}

lemma fix_id: "(\<mu> x. x) = \<bottom>"
by (simp add: fix_strict)

lemma fix_const: "(\<mu> x. c) = c"
by (subst fix_eq, simp)

subsection {* Fixed point induction *}

lemma fix_ind: "\<lbrakk>adm P; P \<bottom>; \<And>x. P x \<Longrightarrow> P (F\<cdot>x)\<rbrakk> \<Longrightarrow> P (fix\<cdot>F)"
unfolding fix_def2
apply (erule admD)
apply (rule chain_iterate)
apply (rule nat_induct, simp_all)
done

lemma cont_fix_ind:
  "\<lbrakk>cont F; adm P; P \<bottom>; \<And>x. P x \<Longrightarrow> P (F x)\<rbrakk> \<Longrightarrow> P (fix\<cdot>(Abs_cfun F))"
by (simp add: fix_ind)

lemma def_fix_ind:
  "\<lbrakk>f \<equiv> fix\<cdot>F; adm P; P \<bottom>; \<And>x. P x \<Longrightarrow> P (F\<cdot>x)\<rbrakk> \<Longrightarrow> P f"
by (simp add: fix_ind)

lemma fix_ind2:
  assumes adm: "adm P"
  assumes 0: "P \<bottom>" and 1: "P (F\<cdot>\<bottom>)"
  assumes step: "\<And>x. \<lbrakk>P x; P (F\<cdot>x)\<rbrakk> \<Longrightarrow> P (F\<cdot>(F\<cdot>x))"
  shows "P (fix\<cdot>F)"
unfolding fix_def2
apply (rule admD [OF adm chain_iterate])
apply (rule nat_less_induct)
apply (case_tac n)
apply (simp add: 0)
apply (case_tac nat)
apply (simp add: 1)
apply (frule_tac x=nat in spec)
apply (simp add: step)
done

lemma parallel_fix_ind:
  assumes adm: "adm (\<lambda>x. P (fst x) (snd x))"
  assumes base: "P \<bottom> \<bottom>"
  assumes step: "\<And>x y. P x y \<Longrightarrow> P (F\<cdot>x) (G\<cdot>y)"
  shows "P (fix\<cdot>F) (fix\<cdot>G)"
proof -
  from adm have adm': "adm (split P)"
    unfolding split_def .
  have "\<And>i. P (iterate i\<cdot>F\<cdot>\<bottom>) (iterate i\<cdot>G\<cdot>\<bottom>)"
    by (induct_tac i, simp add: base, simp add: step)
  hence "\<And>i. split P (iterate i\<cdot>F\<cdot>\<bottom>, iterate i\<cdot>G\<cdot>\<bottom>)"
    by simp
  hence "split P (\<Squnion>i. (iterate i\<cdot>F\<cdot>\<bottom>, iterate i\<cdot>G\<cdot>\<bottom>))"
    by - (rule admD [OF adm'], simp, assumption)
  hence "split P (\<Squnion>i. iterate i\<cdot>F\<cdot>\<bottom>, \<Squnion>i. iterate i\<cdot>G\<cdot>\<bottom>)"
    by (simp add: lub_Pair)
  hence "P (\<Squnion>i. iterate i\<cdot>F\<cdot>\<bottom>) (\<Squnion>i. iterate i\<cdot>G\<cdot>\<bottom>)"
    by simp
  thus "P (fix\<cdot>F) (fix\<cdot>G)"
    by (simp add: fix_def2)
qed

lemma cont_parallel_fix_ind:
  assumes "cont F" and "cont G"
  assumes "adm (\<lambda>x. P (fst x) (snd x))"
  assumes "P \<bottom> \<bottom>"
  assumes "\<And>x y. P x y \<Longrightarrow> P (F x) (G y)"
  shows "P (fix\<cdot>(Abs_cfun F)) (fix\<cdot>(Abs_cfun G))"
by (rule parallel_fix_ind, simp_all add: assms)

subsection {* Fixed-points on product types *}

text {*
  Bekic's Theorem: Simultaneous fixed points over pairs
  can be written in terms of separate fixed points.
*}

lemma fix_cprod:
  "fix\<cdot>(F::'a \<times> 'b \<rightarrow> 'a \<times> 'b) =
   (\<mu> x. fst (F\<cdot>(x, \<mu> y. snd (F\<cdot>(x, y)))),
    \<mu> y. snd (F\<cdot>(\<mu> x. fst (F\<cdot>(x, \<mu> y. snd (F\<cdot>(x, y)))), y)))"
  (is "fix\<cdot>F = (?x, ?y)")
proof (rule fix_eqI)
  have 1: "fst (F\<cdot>(?x, ?y)) = ?x"
    by (rule trans [symmetric, OF fix_eq], simp)
  have 2: "snd (F\<cdot>(?x, ?y)) = ?y"
    by (rule trans [symmetric, OF fix_eq], simp)
  from 1 2 show "F\<cdot>(?x, ?y) = (?x, ?y)" by (simp add: prod_eq_iff)
next
  fix z assume F_z: "F\<cdot>z = z"
  obtain x y where z: "z = (x,y)" by (rule prod.exhaust)
  from F_z z have F_x: "fst (F\<cdot>(x, y)) = x" by simp
  from F_z z have F_y: "snd (F\<cdot>(x, y)) = y" by simp
  let ?y1 = "\<mu> y. snd (F\<cdot>(x, y))"
  have "?y1 \<sqsubseteq> y" by (rule fix_least, simp add: F_y)
  hence "fst (F\<cdot>(x, ?y1)) \<sqsubseteq> fst (F\<cdot>(x, y))"
    by (simp add: fst_monofun monofun_cfun)
  hence "fst (F\<cdot>(x, ?y1)) \<sqsubseteq> x" using F_x by simp
  hence 1: "?x \<sqsubseteq> x" by (simp add: fix_least_below)
  hence "snd (F\<cdot>(?x, y)) \<sqsubseteq> snd (F\<cdot>(x, y))"
    by (simp add: snd_monofun monofun_cfun)
  hence "snd (F\<cdot>(?x, y)) \<sqsubseteq> y" using F_y by simp
  hence 2: "?y \<sqsubseteq> y" by (simp add: fix_least_below)
  show "(?x, ?y) \<sqsubseteq> z" using z 1 2 by simp
qed

end


(*
  Title:    Random_Dictatorship.thy
  Author:   Manuel Eberl, TU München

  Definition and basic properties of Random Dictatorship
  (on weak preferences)
*)

section \<open>Random Dictatorship\<close>

theory Random_Dictatorship
imports
  Complex_Main
  Social_Decision_Schemes
begin

text \<open>
  We define Random Dictatorship as a social decision scheme on total preorders
  (i.e. agents are allowed to have ties in their rankings) by first selecting an agent
  uniformly at random and then selecting one of that agents' most preferred alternatives
  uniformly at random. Note that this definition also works for weak preferences.
\<close>
definition random_dictatorship :: "'agent set \<Rightarrow> 'alt set \<Rightarrow> ('agent, 'alt) pref_profile \<Rightarrow> 'alt lottery" where
  random_dictatorship_auxdef:
  "random_dictatorship agents alts R =
      do {
        i \<leftarrow> pmf_of_set agents;
        pmf_of_set (Max_wrt_among (R i) alts)
      }"

context election
begin

abbreviation RD :: "('agent, 'alt) pref_profile \<Rightarrow> 'alt lottery" where
  "RD \<equiv> random_dictatorship agents alts"

lemma random_dictatorship_def:
  assumes "is_pref_profile R"
  shows  "RD R =
            do {
              i \<leftarrow> pmf_of_set agents;
              pmf_of_set (favorites R i)
            }"
proof -
  from assms interpret pref_profile_wf agents alts R .
  show ?thesis by (simp add: random_dictatorship_auxdef favorites_altdef)
qed

lemma random_dictatorship_unique_favorites:
  assumes "is_pref_profile R" "has_unique_favorites R"
  shows   "RD R = map_pmf (favorite R) (pmf_of_set agents)"
proof -
  from assms(1) interpret pref_profile_wf agents alts R .
  from assms(2) interpret pref_profile_unique_favorites agents alts R by unfold_locales
  show ?thesis unfolding random_dictatorship_def[OF assms(1)] map_pmf_def
    by (intro bind_pmf_cong) (auto simp: unique_favorites pmf_of_set_singleton)
qed

lemma random_dictatorship_unique_favorites':
  assumes "is_pref_profile R" "has_unique_favorites R"
  shows   "RD R = pmf_of_multiset (image_mset (favorite R) (mset_set agents))"
  using assms by (simp add: random_dictatorship_unique_favorites map_pmf_of_set)

lemma pmf_random_dictatorship:
  assumes "is_pref_profile R"
  shows "pmf (RD R) x =
           (\<Sum>i\<in>agents. indicator (favorites R i) x /
              real (card (favorites R i))) / real (card agents)"
proof -
  from assms(1) interpret pref_profile_wf agents alts R .
  from nonempty_dom have "card agents > 0" by (auto simp del: nonempty_agents)
  hence "ennreal (pmf (RD R) x) =
           ennreal ((\<Sum>i\<in>agents. pmf (pmf_of_set (favorites R i)) x) / real (card agents))"
    (is "_ = ennreal (?p / _)") unfolding random_dictatorship_def[OF assms]
    by (simp_all add: ennreal_pmf_bind nn_integral_pmf_of_set max_def
          divide_ennreal [symmetric] ennreal_of_nat_eq_real_of_nat sum_nonneg)
  also have "?p = (\<Sum>i\<in>agents. indicator (favorites R i) x / real (card (favorites R i)))"
    by (intro sum.cong) (simp_all add: favorites_nonempty)
  finally show ?thesis
    by (subst (asm) ennreal_inj) (auto intro!: sum_nonneg divide_nonneg_nonneg)
qed

sublocale RD: social_decision_scheme agents alts RD
proof
  fix R assume R_wf: "is_pref_profile R"
  then interpret pref_profile_wf agents alts R .
  from R_wf show "RD R \<in> lotteries"
    using favorites_subset_alts favorites_nonempty
    by (auto simp: lotteries_on_def random_dictatorship_def)
qed

text \<open>
  We now show that Random Dictatorship fulfils anonymity, neutrality,
  and strong strategyproofness.
  At the very least, this shows that the definitions of these notions are
  consistent.
\<close>

subsection \<open>Anonymity\<close>

text \<open>
  The following proof is essentially the following:
  In Random Dictatorship, permuting the agents in the preference profile is the same
  as applying the permutation to the agent that was picked uniformly at random in the
  first step. However, uniform distributions are invariant under permutation, therefore
  the outcome is totally unchanged.
\<close>

sublocale RD: anonymous_sds agents alts RD
proof
  fix R \<pi> assume wf: "is_pref_profile R" and perm: "\<pi> permutes agents"
  interpret pref_profile_wf agents alts R by fact
  from wf_permute_agents[OF perm]
    have "RD (R \<circ> \<pi>) = map_pmf \<pi> (pmf_of_set agents) \<bind> (\<lambda>i. pmf_of_set (favorites R i))"
    by (simp add: bind_map_pmf random_dictatorship_def o_def favorites_def)
  also from perm wf have "\<dots> = RD R"
    by (simp add: map_pmf_of_set_inj permutes_inj_on permutes_image random_dictatorship_def)
  finally show "RD (R \<circ> \<pi>) = RD R" .
qed

subsection \<open>Neutrality\<close>

text \<open>
  The proof of neutrality is similar to that of anonymity. We have proven elsewhere
  that the most preferred alternatives of an agent in a profile with permuted alternatives
  are simply the image of the originally preferred alternatives.
  Since we pick one alternative from the most preferred alternatives of the selected agent
  uniformly at random, this means that we effectively pick an agent, then pick on of her
  most preferred alternatives, and then apply the permutation to that alternative,
  which is simply Random Dictatorship transformed with the permutation.
\<close>

sublocale RD: neutral_sds agents alts RD
proof
  fix \<sigma> R
  assume perm: "\<sigma> permutes alts" and R_wf: "is_pref_profile R"
  from R_wf interpret pref_profile_wf agents alts R .
  from wf_permute_alts[OF perm] R_wf perm show "RD (permute_profile \<sigma> R) = map_pmf \<sigma> (RD R)"
    by (subst random_dictatorship_def)
       (auto intro!: bind_pmf_cong simp: random_dictatorship_def map_bind_pmf
          favorites_permute map_pmf_of_set_inj permutes_inj_on favorites_nonempty)
qed

subsection \<open>Strong strategyproofness\<close>

text \<open>
  The argument for strategyproofness is quite simple:
  Since the preferences submitted by an agent @{term i} only influence
  the outcome when that agent is picked in the first process, it suffices
  to focus on this case.
  When the agent @{term i} submits her true preferences, the probability of
  obtaining a result at least as good as @{term x} (for any alternative @{term x})
  is 1, since the outcome will always be one of her most-preferred alternatives.
  Obviously, the probability of obtaining such a result cannot exceed 1 no matter
  what preferences she submits instead, and thus, RD is strategyproof.
\<close>

sublocale RD: strongly_strategyproof_sds agents alts RD
proof (unfold_locales, unfold RD.strongly_strategyproof_profile_def)
  fix R i Ri' assume R_wf: "is_pref_profile R" and i: "i \<in> agents"
                 and Ri'_wf: "total_preorder_on alts Ri'"
  interpret R: pref_profile_wf agents alts R by fact
  from R_wf Ri'_wf i have R'_wf: "is_pref_profile (R(i := Ri'))"
    by (simp add: R.wf_update)
  interpret R': pref_profile_wf agents alts "R(i := Ri')" by fact

  show "SD (R i) (RD (R(i := Ri'))) (RD R)"
  proof (rule R.SD_pref_profileI)
    fix x assume "x \<in> alts"
    hence "emeasure (measure_pmf (RD (R(i := Ri')))) (preferred_alts (R i) x)
             \<le> emeasure (measure_pmf (RD R)) (preferred_alts (R i) x)"
      using Ri'_wf maximal_imp_preferred[of "R i" x]
      by (auto intro!: card_mono nn_integral_mono_AE
               simp: random_dictatorship_def R_wf R'_wf AE_measure_pmf_iff Max_wrt_prefs_finite
                     emeasure_pmf_of_set Int_absorb2 favorites_def
                     Max_wrt_prefs_nonempty card_gt_0_iff)
    thus "lottery_prob (RD (R(i := Ri'))) (preferred_alts (R i) x)
            \<le> lottery_prob (RD R) (preferred_alts (R i) x)"
      by (simp add: measure_pmf.emeasure_eq_measure)
  qed (insert R_wf R'_wf, simp_all add: RD.sds_wf i)
qed

end

end


theory Shakarchi
  imports "HOL-Complex_Analysis.Complex_Analysis"
    "HOL-Computational_Algebra.Computational_Algebra"
begin

(*
problem_number:1_13a
natural language statement:
Suppose that $f$ is holomorphic in an open set $\Omega$. Prove that if $\text{Re}(f)$ is constant, then $f$ is constant.
lean statement:
theorem exercise_1_13a {f : \<complex> \<rightarrow> \<complex>} (Ω : set \<complex>) (a b : Ω) (h : is_open Ω)
  (hf : differentiable_on \<complex> f Ω) (hc : \<exists> (c : \<real>), \<forall> z \<in> Ω, (f z).re = c) :
  f a = f b :=

codex statement:
theorem holomorphic_const_of_real_const:
  fixes f::"complex \<Rightarrow> complex"
  assumes "open s" "f holomorphic_on s" "\<forall>x\<in>s. Re (f x) = c"
  shows "\<forall>x\<in>s. f x = c"
Our comment on the codex statement: f is constant but not necessary equal to c.
 *)
theorem exercise_1_13a:
  fixes f::"complex \<Rightarrow> complex"
  assumes "open s" "f holomorphic_on s" "\<forall>x\<in>s. Re (f x) = c"
  shows "\<exists> c. \<forall>x\<in>s. f x = c"
  oops

(*
problem_number:1_13b
natural language statement:
Suppose that $f$ is holomorphic in an open set $\Omega$. Prove that if $\text{Im}(f)$ is constant, then $f$ is constant.
lean statement:
theorem exercise_1_13b {f : \<complex> \<rightarrow> \<complex>} (Ω : set \<complex>) (a b : Ω) (h : is_open Ω)
  (hf : differentiable_on \<complex> f Ω) (hc : \<exists> (c : \<real>), \<forall> z \<in> Ω, (f z).im = c) :
  f a = f b :=

codex statement:
theorem constant_of_holomorphic_constant_imag:
  fixes f::"complex \<Rightarrow> complex"
  assumes "open s" "f holomorphic_on s" "\<forall>x\<in>s. Im (f x) = c"
  shows "\<forall>x\<in>s. f x = c"
Our comment on the codex statement: f is constant but not necessary equal to c.
 *)
theorem exercise_1_13b:
  fixes f::"complex \<Rightarrow> complex"
  assumes "open s" "f holomorphic_on s" "\<forall>x\<in>s. Im (f x) = c"
  shows "\<exists> c. \<forall>x\<in>s. f x = c"
  oops

(*
problem_number:1_13c
natural language statement:
Suppose that $f$ is holomorphic in an open set $\Omega$. Prove that if $|f|$ is constant, then $f$ is constant.
lean statement:
theorem exercise_1_13c {f : \<complex> \<rightarrow> \<complex>} (Ω : set \<complex>) (a b : Ω) (h : is_open Ω)
  (hf : differentiable_on \<complex> f Ω) (hc : \<exists> (c : \<real>), \<forall> z \<in> Ω, abs (f z) = c) :
  f a = f b :=

codex statement:
theorem holomorphic_constant_of_constant_abs:
  fixes f::"complex \<Rightarrow> complex"
  assumes "open s" "f holomorphic_on s" "\<forall>x\<in>s. f x \<noteq> 0" "\<forall>x y. x \<in> s \<longrightarrow> y \<in> s \<longrightarrow> norm (f x) = norm (f y)"
  shows "\<forall>x y. x \<in> s \<longrightarrow> y \<in> s \<longrightarrow> f x = f y"
Our comment on the codex statement: totally correct except for an unnessary condition "\<forall>x\<in>s. f x \<noteq> 0".
 *)
theorem exercise_1_13c:
  fixes f::"complex \<Rightarrow> complex"
  assumes "open s" "f holomorphic_on s" "\<forall>x y. x \<in> s \<longrightarrow> y \<in> s \<longrightarrow> norm (f x) = norm (f y)"
  shows "\<exists> c. \<forall>x\<in>s. f x = c"
  oops

(*
problem_number:1_18
natural language statement:
Let $f$ be a power series centered at the origin. Prove that $f$ has a power series expansion around any point in its disc of convergence.
lean statement:

codex statement:
theorem power_series_expansion_of_power_series_centered_at_origin:
  fixes f::"complex \<Rightarrow> complex"
  assumes "\<forall>x. f x = (\<Sum>n. f n * x^n)" "\<exists>r. \<forall>x. norm x < r \<longrightarrow> f x = (\<Sum>n. f n * x^n)"
  shows "\<forall>z. \<exists>r. \<forall>x. norm (x - z) < r \<longrightarrow> f x = (\<Sum>n. f n * (x - z)^n)"
Our comment on the codex statement: not quite right
  (e.g., f should be of type nat \<Rightarrow> 'a),
  though the model roughly captured the idea of convergence.
 *)
theorem exercise_1_18:
  fixes f :: "nat \<Rightarrow> 'a :: {banach, real_normed_div_algebra}"
  assumes "ereal (norm z) < conv_radius f"
  shows   "summable (\<lambda>n. norm (f n * z ^ n))"
  oops

(*
problem_number:1_19a
natural language statement:
Prove that the power series $\sum nz^n$ does not converge on any point of the unit circle.
lean statement:
theorem exercise_1_19a (z : \<complex>) (hz : abs z = 1) (s : \<nat> \<rightarrow> \<complex>)
    (h : s = (\<lambda> n, \<Sum> i in (finset.range n), i * z ^ i)) :
    ¬ \<exists> y, tendsto s at_top (𝓝 y) :=

codex statement:
theorem power_series_not_converges_on_unit_circle:
  fixes z::complex
  assumes "norm z = 1"
  shows "\<forall>\<epsilon>>0. \<exists>N. \<forall>n\<ge>N. norm (of_nat n * z^n) \<ge> \<epsilon>"
Our comment on the codex statement: Correct.
 *)
theorem exercise_1_19a:
  fixes z::complex
  assumes "norm z = 1"
  shows "\<forall>\<epsilon>>0. \<exists>N. \<forall>n\<ge>N. norm (of_nat n * z^n) \<ge> \<epsilon>" oops

(*
problem_number:1_19b
natural language statement:
Prove that the power series $\sum zn/n^2$ converges at every point of the unit circle.
lean statement:
theorem exercise_1_19b (z : \<complex>) (hz : abs z = 1) (s : \<nat> \<rightarrow> \<complex>)
    (h : s = (\<lambda> n, \<Sum> i in (finset.range n), i * z / i ^ 2)) :
    \<exists> y, tendsto s at_top (𝓝 y) :=

codex statement:
theorem converges_power_series_of_unit_circle:
  fixes z::complex
  assumes "norm z = 1"
  shows "summable (\<lambda>n. z^n / n^2)"
Our comment on the codex statement: Correct.
 *)
theorem exercise_1_19b:
  fixes z::complex
  assumes "norm z = 1"
  shows "summable (\<lambda>n. z^n / n^2)" oops

(*
problem_number:1_19c
natural language statement:
Prove that the power series $\sum zn/n$ converges at every point of the unit circle except $z = 1$.
lean statement:
theorem exercise_1_19c (z : \<complex>) (hz : abs z = 1) (hz2 : z \<noteq> 1) (s : \<nat> \<rightarrow> \<complex>)
    (h : s = (\<lambda> n, \<Sum> i in (finset.range n), i * z / i)) :
    \<exists> z, tendsto s at_top (𝓝 z) :=

codex statement:
theorem power_series_converges_at_every_point_of_unit_circle_except_z_eq_1:
  fixes z::complex
  assumes "norm z = 1" "z \<noteq> 1"
  shows "summable (\<lambda>n. z^n / of_nat n)"
Our comment on the codex statement: Correct.
 *)
theorem exercise_1_19c:
  fixes z::complex
  assumes "norm z = 1" "z \<noteq> 1"
  shows "summable (\<lambda>n. z^n / of_nat n)"
  oops

(*
problem_number:1_22
natural language statement:
Let $\mathbb{N} = {1, 2, 3, \ldots}$ denote the set of positive integers.
A subset $S \subset \mathbb{N}$ is said to be in arithmetic progression
if $S = {a, a + d, a + 2d, a + 3d, \ldots}$ where $a, d \in \mathbb{N}$.
Here $d$ is called the step of $S$.  Show that $\mathbb{N}$ cannot be
partitioned into a finite number of subsets that are in arithmetic
progression with distinct steps (except for the trivial case $a = d = 1$).

lean statement:
theorem exercise_1_22 (n : \<nat>) (S : fin n \<rightarrow> set \<nat>) (f : fin n \<rightarrow> \<nat> \<times> \<nat>)
  (h : \<forall> i, S i = set.range (\<lambda> j, (f i).fst + j * (f i).snd)) :
    ¬ (\<Union> i, S i) = (set.univ : set \<nat>) :=

codex statement:
theorem not_finite_partition_of_nat_into_arithmetic_progression:
  fixes S::"nat set"
  assumes "finite S" "\<forall>s\<in>S. \<exists>a d. s = {a, a + d, a + 2*d,
    a + 3*d, a + 4*d, a + 5*d, a + 6*d, a + 7*d, a + 8*d, a + 9*d}"
  shows "\<exists>s\<in>S. s = {1, 2, 3, 4, 5, 6, 7, 8, 9, 10}"
Our comment on the codex statement: not right.
 *)
theorem exercise_1_22: undefined oops

  text \<open> Does the Lean version handle the corner case when $a = d = 1$?\<close>

(*
problem_number:1_26
natural language statement:
Suppose $f$ is continuous in a region $\Omega$. Prove that any two primitives of $f$ (if they exist) differ by a constant.
lean statement:
theorem exercise_1_26
  (f F_1 F_2 : \<complex> \<rightarrow> \<complex>) (Ω : set \<complex>) (h1 : is_open Ω) (h2 : is_connected Ω)
  (hF_1 : differentiable_on \<complex> F_1 Ω) (hF_2 : differentiable_on \<complex> F_2 Ω)
  (hdF_1 : \<forall> x \<in> Ω, deriv F_1 x = f x) (hdF_2 : \<forall> x \<in> Ω, deriv F_2 x = f x)
  : \<exists> c : \<complex>, \<forall> x, F_1 x = F_2 x + c :=

codex statement:
theorem primitives_diff_const:
  fixes f::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  assumes "continuous_on Ω f" "\<exists>g. (\<forall>x\<in>Ω. (f x) = (vector_derivative g (at x) within Ω))" "\<exists>h. (\<forall>x\<in>Ω. (f x) = (vector_derivative h (at x) within Ω))"
  shows "\<exists>c. (\<forall>x\<in>Ω. g x = h x + c)"
Our comment on the codex statement: almost correct except for not noticing
  that vector_derivative of type "real \<Rightarrow> 'b::real_normed_vector", which is very understandable.
 *)
theorem exercise_1_26:
  fixes f::"real \<Rightarrow> 'b::real_normed_vector"
  assumes "continuous_on Ω f"
    "\<exists>g. (\<forall>x\<in>Ω. (f x) = (vector_derivative g (at x within Ω)))"
    "\<exists>h. (\<forall>x\<in>Ω. (f x) = (vector_derivative h (at x within Ω)))"
  shows "\<exists>c. (\<forall>x\<in>Ω. g x = h x + c)" oops

(*
problem_number:2_2
natural language statement:
Show that $\int_{0}^{\infty} \frac{\sin x}{x} d x=\frac{\pi}{2}$.
lean statement:
theorem exercise_2_2 :
  tendsto (\<lambda> y, ∫ x in 0..y, real.sin x / x) at_top (𝓝 (real.pi / 2)) :=

codex statement:
theorem integral_sin_x_over_x_eq_pi_div_2:
  fixes f::"real \<Rightarrow> real"
  assumes "f integrable_on {0..\<infinity>}" "\<forall>x. 0 \<le> x \<longrightarrow> f x = sin x / x"
  shows "integral {0..\<infinity>} f = pi / 2"
Our comment on the codex statement: syntactically convincing but was
  misusing the "{0..\<infinity>}" symbol.
 *)
theorem exercise_2_2:
  "(\<lambda> k. integral {0..k} (\<lambda> x. sin x / x))
    \<longlonglongrightarrow> pi/2"
  oops

(*
problem_number:2_5
natural language statement:
Suppose $f$ is continuously complex differentiable on $\Omega$,
and $T \subset \Omega$ is a triangle whose interior is also
contained in $\Omega$. Apply Green’s theorem to show that $\int_T f(z) dz = 0$.
lean statement:

codex statement:
theorem integral_of_complex_differentiable_on_triangle_eq_zero:
  fixes f::"complex \<Rightarrow> complex" and T::"complex set"
  assumes "continuous_on T f" "f complex_differentiable_on T" "\<exists>a b c. T = convex hull {a, b, c}"
  shows "∫ T f = 0"
Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_2_5: undefined oops

(*
problem_number:2_6
natural language statement:
Let $\Omega$ be an open subset of $\mathbb{C}$ and let $T \subset \Omega$
be a triangle whose interior is also contained in $\Omega$.
Suppose that $f$ is a function holomorphic in $\Omega$ except
possibly at a point w inside $T$. Prove that if $f$ is
bounded near $w$, then $\int_T f(z) dz = 0$.

lean statement:

codex statement:
theorem integral_of_holomorphic_eq_zero_of_bounded_near_point:
  fixes f::"complex \<Rightarrow> complex" and T::"complex set"
  assumes "open Ω" "T \<subseteq> Ω" "interior T \<subseteq> Ω" "f holomorphic_on (Ω - {w})" "bounded (f ` (ball w r))"
  shows "∫ T f = 0"
Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_2_6: undefined oops

(*
problem_number:2_9
natural language statement:
Let $\Omega$ be a bounded open subset of $\mathbb{C}$,
 and $\varphi: \Omega \rightarrow \Omega$ a holomorphic function.
Prove that if there exists a point $z_{0} \in \Omega$ such that
$\varphi\left(z_{0}\right)=z_{0} \quad \text { and } \quad \varphi^{\prime}
\left(z_{0}\right)=1$ then $\varphi$ is linear.

lean statement:
theorem exercise_2_9
  {f : \<complex> \<rightarrow> \<complex>} (Ω : set \<complex>) (b : metric.bounded Ω) (h : is_open Ω)
  (hf : differentiable_on \<complex> f Ω) (z \<in> Ω) (hz : f z = z) (h'z : deriv f z = 1) :
  \<exists> (f_lin : \<complex> \<rightarrow>L[\<complex>] \<complex>), \<forall> x \<in> Ω, f x = f_lin x :=

codex statement:
theorem linear_of_holomorphic_and_derivative_one:
  fixes f::"complex \<Rightarrow> complex"
  assumes "open s" "bounded s" "f holomorphic_on s" "z\<in>s" "f z = z" "deriv f z = 1"
  shows "\<forall>w\<in>s. f w = w + (z - w)"
Our comment on the codex statement: mostly correct except for the conclusion.
 *)
theorem exercise_2_9:
  fixes f::"complex \<Rightarrow> complex"
  assumes "open s" "bounded s" "f holomorphic_on s" "z\<in>s" "f z = z" "deriv f z = 1"
  shows "linear f"
  oops

(*
problem_number:2_13
natural language statement:
Suppose $f$ is an analytic function defined everywhere in $\mathbb{C}$
and such that for each $z_0 \in \mathbb{C}$ at least one
coefficient in the expansion $f(z) = \sum_{n=0}^\infty c_n(z - z_0)^n$
is equal to 0. Prove that $f$ is a polynomial.

lean statement:
theorem exercise_2_13 {f : \<complex> \<rightarrow> \<complex>}
    (hf : \<forall> z₀ : \<complex>, \<exists> (s : set \<complex>) (c : \<nat> \<rightarrow> \<complex>), is_open s \<and> z₀ \<in> s \<and>
      \<forall> z \<in> s, tendsto (\<lambda> n, \<Sum> i in finset.range n, (c i) * (z - z₀)^i) at_top (𝓝 (f z₀))
      \<and> \<exists> i, c i = 0) :
    \<exists> (c : \<nat> \<rightarrow> \<complex>) (n : \<nat>), f = \<lambda> z, \<Sum> i in finset.range n, (c i) * z ^ n :=

codex statement:
theorem is_polynomial_of_analytic_and_coeff_zero:
  fixes f::"complex \<Rightarrow> complex"
  assumes "\<forall>z. analytic f (at z)" "\<forall>z. \<exists>n. c n z = 0"
  shows "\<exists>p. \<forall>z. f z = p z"
Our comment on the codex statement: not using important definitions
  like fps_expansion, fps_nth, etc.
 *)
theorem exercise_2_13:
  fixes f::"complex \<Rightarrow> complex"
  assumes "f analytic_on UNIV"
    "\<forall> z. \<exists> n. fps_nth (fps_expansion f z) n \<noteq> 0"
  shows "\<exists>p. \<forall> z. f z = poly p z"
  oops

(*
problem_number:3_2
natural language statement:
Evaluate the integral $\int_{-\infty}^{\infty} \frac{dx}{1 + x^4}$.
lean statement:
theorem exercise_3_22 (D : set \<complex>) (hD : D = ball 0 1) (f : \<complex> \<rightarrow> \<complex>)
    (hf : differentiable_on \<complex> f D) (hfc : continuous_on f (closure D)) :
    ¬ \<forall> z \<in> (sphere (0 : \<complex>) 1), f z = 1 / z :=

codex statement:
theorem integral_of_inverse_of_one_plus_x_four:
  fixes f::"real \<Rightarrow> real"
  assumes "finite (set_integrable lborel {-\<infinity>..\<infinity>} f)"
  shows "(∫₋\<infinity> \<infinity> (\<lambda>x. 1/(1+x^4)) dx) = (∫₋\<infinity> \<infinity> f dx)"
Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_3_2: undefined oops
  text \<open>The problem appears suspicious\<close>

(*
problem_number:3_3
natural language statement:
Show that $ \int_{-\infty}^{\infty} \frac{\cos x}{x^2 + a^2} dx = \pi \frac{e^{-a}}{a}$ for $a > 0$.
lean statement:
theorem exercise_3_3 (a : \<real>) (ha : 0 < a) :
    tendsto (\<lambda> y, ∫ x in -y..y, real.cos x / (x ^ 2 + a ^ 2))
      at_top (𝓝 (real.pi * (real.exp (-a) / a))) :=

codex statement:
theorem integral_cos_over_square_plus_a_square_eq_pi_exp_minus_a_over_a:
  fixes a::real
  assumes "a > 0"
  shows "∫ {-\<infinity>..\<infinity>} (\<lambda>x. cos x / (x^2 + a^2)) = \<pi> * exp (-a) / a"
Our comment on the codex statement: misuse of the integral function and the pi constant.
 *)
theorem exercise_3_3:
  fixes a::real
  assumes "a > 0"
  shows "LBINT x=-\<infinity>..\<infinity>. cos x / (x^2 + a^2) = pi * exp (-a) / a"
  oops

(*
problem_number:3_4
natural language statement:
Show that $ \int_{-\infty}^{\infty} \frac{x \sin x}{x^2 + a^2} dx = \pi e^{-a}$ for $a > 0$.
lean statement:
theorem exercise_3_4 (a : \<real>) (ha : 0 < a) :
    tendsto (\<lambda> y, ∫ x in -y..y, x * real.sin x / (x ^ 2 + a ^ 2))
      at_top (𝓝 (real.pi * (real.exp (-a)))) :=

codex statement:
theorem integral_sin_over_square_plus_a_square_eq_pi_exp_minus_a:
  fixes a::real
  assumes "a>0"
  shows "(∫ x = -\<infinity>..\<infinity>. (x * sin x) / (x^2 + a^2)) = \<pi> * exp (-a)"
Our comment on the codex statement: misuse of the integral function and the pi constant.
 *)
theorem exercise_3_4:
  fixes a::real
  assumes "a > 0"
  shows "LBINT x=-\<infinity>..\<infinity>. (x * sin x) / (x^2 + a^2) = pi * exp (-a)"
  oops

(*
problem_number:3_9
natural language statement:
Show that $\int_0^1 \log(\sin \pi x) dx = - \log 2$.
lean statement:
theorem exercise_3_9 : ∫ x in 0..1, real.log (real.sin (real.pi * x)) = - real.log 2 :=

codex statement:
theorem integral_log_sin_pi_x_eq_log_2:
  fixes f::"real \<Rightarrow> real"
  assumes "f integrable_on {0..1}" "f = (\<lambda>x. log (sin (\<pi> * x)))"
  shows "(∫ {0..1} f) = - log 2"
Our comment on the codex statement:misuse of the integral function and the log function, but the
  mistakes are understandable.
 *)
theorem exercise_3_9:
  shows "((\<lambda> x::real. ln (sin (pi * x)) ) has_integral (- ln 2)) {0..1}"
  oops

(*
problem_number:3_14
natural language statement:
Prove that all entire functions that are also injective take the form $f(z) = az + b$, $a, b \in \mathbb{C}$ and $a \neq 0$.
lean statement:
theorem exercise_3_14 {f : \<complex> \<rightarrow> \<complex>} (hf : differentiable \<complex> f)
    (hf_inj : function.injective f) :
    \<exists> (a b : \<complex>), f = (\<lambda> z, a * z + b) \<and> a \<noteq> 0 :=

codex statement:
theorem entire_injective_eq_linear:
  fixes f::"complex \<Rightarrow> complex"
  assumes "entire f" "inj f"
  shows "\<exists>a b. f = (\<lambda>z. a * z + b)"
Our comment on the codex statement: The model fails to align the definition of 'entire'.
 *)
theorem exercise_3_14:
  fixes f::"complex \<Rightarrow> complex"
  assumes "f holomorphic_on UNIV" "inj f"
  shows "\<exists>a b. a \<noteq> 0 \<and> f = (\<lambda>z. a * z + b)"
  oops

(*
problem_number:3_22
natural language statement:
Show that there is no holomorphic function $f$ in the unit disc $D$ that extends continuously to $\partial D$ such that $f(z) = 1/z$ for $z \in \partial D$.
lean statement:
theorem exercise_3_22 (D : set \<complex>) (hD : D = ball 0 1) (f : \<complex> \<rightarrow> \<complex>)
    (hf : differentiable_on \<complex> f D) (hfc : continuous_on f (closure D)) :
    ¬ \<forall> z \<in> (sphere (0 : \<complex>) 1), f z = 1 / z :=

codex statement:
theorem no_holomorphic_function_extends_continuously_to_boundary_of_unit_disc:
  fixes f::"complex \<Rightarrow> complex"
  assumes "continuous_on (cball 0 1) f" "f holomorphic_on ball 0 1" "\<forall>z\<in>cball 0 1. z \<noteq> 0 \<longrightarrow> f z = 1/z"
  shows False
Our comment on the codex statement: appears good!
 *)
theorem exercise_3_22:
  fixes f::"complex \<Rightarrow> complex"
  assumes "continuous_on (cball 0 1) f" "f holomorphic_on ball 0 1"
    "\<forall>z\<in>cball 0 1. z \<noteq> 0 \<longrightarrow> f z = 1/z"
  shows False

  oops

(*
problem_number:4_4a
natural language statement:
Suppose $Q$ is a polynomial of degree $\geq 2$ with distinct roots, none lying on the real axis.
Calculate $\int_{-\infty}^\infty \frac{e^{-2 \pi ix \xi}}{Q(x)} dx$, $\xi \in \mathbb{R}$, in terms of the roots of $Q$.

lean statement:

codex statement:
theorem integral_of_polynomial_of_degree_geq_2_with_distinct_roots:
  fixes Q::"complex \<Rightarrow> complex"
  assumes "degree Q \<ge> 2" "\<forall>x. Q x \<noteq> 0" "\<forall>x. \<exists>y. Q x = y^2"
  shows "∫ {-\<infinity>..\<infinity>} (\<lambda>x. exp (-2 * \<pi> * complex_of_real x * ξ) / Q x) dx = 0"
Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_4_4a: undefined
  text \<open>The problem is not that easy -- will come back.\<close>
  oops

(*
problem_number:5_1
natural language statement:
Prove that if $f$ is holomorphic in the unit disc, bounded and not identically zero, and $z_{1}, z_{2}, \ldots, z_{n}, \ldots$ are its zeros $\left(\left|z_{k}\right|<1\right)$, then $\sum_{n}\left(1-\left|z_{n}\right|\right)<\infty$.
lean statement:
theorem exercise_5_1 (f : \<complex> \<rightarrow> \<complex>) (hf : differentiable_on \<complex> f (ball 0 1))
  (hb : bounded (set.range f)) (h0 : f \<noteq> 0) (zeros : \<nat> \<rightarrow> \<complex>) (hz : \<forall> n, f (zeros n) = 0)
  (hzz : set.range zeros = {z | f z = 0 \<and> z \<in> (ball (0 : \<complex>) 1)}) :
  \<exists> (z : \<complex>), tendsto (\<lambda> n, (\<Sum> i in finset.range n, (1 - zeros i))) at_top (𝓝 z) :=

codex statement:
theorem sum_of_one_minus_abs_of_zeros_of_holomorphic_bounded_not_identically_zero_is_finite:
  fixes f::"complex \<Rightarrow> complex"
  assumes "\<forall>z. f holomorphic (at z)" "bounded (range f)" "\<forall>z. f z \<noteq> 0" "\<forall>n. \<exists>z. f z = 0 \<and> norm z < 1"
  shows "finite {z. f z = 0 \<and> norm z < 1}"
Our comment on the codex statement: Not quite right, but to prove the number of roots is finite is
  really not a bad attempt.
 *)
theorem exercise_5_1:
  fixes f::"complex \<Rightarrow> complex" and zeros::"nat \<Rightarrow> complex"
  assumes "f holomorphic_on (ball 0 1)" "bounded (range f)" "\<exists>z. f z \<noteq> 0"
    "range zeros = {z. norm z < 1 \<and> f z = 0}"
  shows "summable zeros"
  oops

(*
problem_number:5_3
natural language statement:
Show that $\sum \frac{z^{n}}{(n !)^{\alpha}}$ is an entire function of order $1 / \alpha$.
lean statement:

codex statement:
theorem entire_of_sum_frac_power_factorial:
  fixes \<alpha>::real
  assumes "\<alpha> > 0"
  shows "entire (\<lambda>z. (\<Sum>n. z^n / (fact n)^\<alpha>))"
Our comment on the codex statement: <YOU CAN LEAVE YOUR COMMENT HERE>
 *)
theorem exercise_5_3: undefined
  text \<open>The order of an entire function has not been defined yet.\<close>
  oops

end


(*<*)
theory Trace
  imports "HOL-Library.Stream"
begin
(*>*)

section \<open>Infinite Traces\<close>

coinductive ssorted :: "'a :: linorder stream \<Rightarrow> bool" where
  "shd s \<le> shd (stl s) \<Longrightarrow> ssorted (stl s) \<Longrightarrow> ssorted s"

lemma ssorted_siterate[simp]: "(\<And>n. n \<le> f n) \<Longrightarrow> ssorted (siterate f n)"
  by (coinduction arbitrary: n) auto

lemma ssortedD: "ssorted s \<Longrightarrow> s !! i \<le> stl s !! i"
  by (induct i arbitrary: s) (auto elim: ssorted.cases)

lemma ssorted_sdrop: "ssorted s \<Longrightarrow> ssorted (sdrop i s)"
  by (coinduction arbitrary: i s) (auto elim: ssorted.cases ssortedD)

lemma ssorted_monoD: "ssorted s \<Longrightarrow> i \<le> j \<Longrightarrow> s !! i \<le> s !! j"
proof (induct "j - i" arbitrary: j)
  case (Suc x)
  from Suc(1)[of "j - 1"] Suc(2-4) ssortedD[of s "j - 1"]
    show ?case by (cases j) (auto simp: le_Suc_eq Suc_diff_le)
qed simp

lemma sorted_stake: "ssorted s \<Longrightarrow> sorted (stake i s)"
  by (induct i arbitrary: s)
    (auto elim: ssorted.cases simp: in_set_conv_nth
      intro!: ssorted_monoD[of _ 0, simplified, THEN order_trans, OF _ ssortedD])

lemma ssorted_monoI: "\<forall>i j. i \<le> j \<longrightarrow> s !! i \<le> s !! j \<Longrightarrow> ssorted s"
  by (coinduction arbitrary: s)
    (auto dest: spec2[of _ "Suc _" "Suc _"] spec2[of _ 0 "Suc 0"])

lemma ssorted_iff_mono: "ssorted s \<longleftrightarrow> (\<forall>i j. i \<le> j \<longrightarrow> s !! i \<le> s !! j)"
  using ssorted_monoI ssorted_monoD by metis

definition "sincreasing s = (\<forall>i. \<exists>j>i. s !! i < s !! j)"

lemma sincreasing_siterate[simp]:
  assumes "(\<And>n. n < f n)"
  shows "sincreasing (siterate f n)"
unfolding sincreasing_def proof
  fix i
  show "\<exists>j>i. siterate f n !! i < siterate f n !! j" (is "\<exists>j. ?P n i j")
  proof (induct i arbitrary: n)
    case (Suc i)
    from Suc[of "f n"] obtain j where "?P (f n) i j" by blast
    then show ?case
      by (intro exI[of _ "Suc j"]) auto
  qed (auto intro!: exI[of _ "Suc 0"] assms)
qed

typedef 'a trace = "{s :: ('a set \<times> nat) stream. ssorted (smap snd s) \<and> sincreasing (smap snd s)}"
  by (intro exI[of _ "smap (\<lambda>i. ({}, i)) nats"])
    (auto simp: stream.map_comp stream.map_ident cong: stream.map_cong)

setup_lifting type_definition_trace

lift_definition \<Gamma> :: "'a trace \<Rightarrow> nat \<Rightarrow> 'a set" is
  "\<lambda>s i. fst (s !! i)" .
lift_definition \<tau> :: "'a trace \<Rightarrow> nat \<Rightarrow> nat" is
  "\<lambda>s i. snd (s !! i)" .

lemma \<tau>_mono[simp]: "i \<le> j \<Longrightarrow> \<tau> s i \<le> \<tau> s j"
  by transfer (auto simp: ssorted_iff_mono)

lemma ex_le_\<tau>: "\<exists>j\<ge>i. x \<le> \<tau> s j"
proof (transfer fixing: i x)
  fix s :: "('a set \<times> nat) stream"
  presume sincreasing: "sincreasing (smap snd s)"
  show "\<exists>j\<ge>i. x \<le> snd (s !! j)" proof (induction x)
    case 0
    show ?case by auto
  next
    case (Suc x)
    then show ?case
      using sincreasing unfolding sincreasing_def
      by (metis Suc_le_eq le_less_trans less_imp_le_nat snth_smap)
  qed
qed simp

lemma le_\<tau>_less: "\<tau> \<sigma> i \<le> \<tau> \<sigma> j \<Longrightarrow> j < i \<Longrightarrow> \<tau> \<sigma> i = \<tau> \<sigma> j"
  by (simp add: antisym)

lemma less_\<tau>D: "\<tau> \<sigma> i < \<tau> \<sigma> j \<Longrightarrow> i < j"
  by (meson \<tau>_mono less_le_not_le not_le_imp_less)

abbreviation "\<Delta> s i \<equiv> \<tau> s i - \<tau> s (i - 1)"

lift_definition map_\<Gamma> :: "('a set \<Rightarrow> 'b set) \<Rightarrow> 'a trace \<Rightarrow> 'b trace" is
  "\<lambda>f s. smap (\<lambda>(x, i). (f x, i)) s"
  by (auto simp: stream.map_comp prod.case_eq_if cong: stream.map_cong)

lemma \<Gamma>_map_\<Gamma>[simp]: "\<Gamma> (map_\<Gamma> f s) i = f (\<Gamma> s i)"
  by transfer (simp add: prod.case_eq_if)

lemma \<tau>_map_\<Gamma>[simp]: "\<tau> (map_\<Gamma> f s) i = \<tau> s i"
  by transfer (simp add: prod.case_eq_if)

lemma map_\<Gamma>_id[simp]: "map_\<Gamma> id s = s"
  by transfer (simp add: stream.map_id)

lemma map_\<Gamma>_comp: "map_\<Gamma> g (map_\<Gamma> f s) = map_\<Gamma> (g \<circ> f) s"
  by transfer (simp add: stream.map_comp comp_def prod.case_eq_if case_prod_beta')

lemma map_\<Gamma>_cong: "\<sigma>\<^sub>1 = \<sigma>\<^sub>2 \<Longrightarrow> (\<And>x. f\<^sub>1 x = f\<^sub>2 x) \<Longrightarrow> map_\<Gamma> f\<^sub>1 \<sigma>\<^sub>1 = map_\<Gamma> f\<^sub>2 \<sigma>\<^sub>2"
  by transfer (auto intro!: stream.map_cong)

section \<open>Finite Trace Prefixes\<close>

typedef 'a prefix = "{p :: ('a set \<times> nat) list. sorted (map snd p)}"
  by (auto intro!: exI[of _ "[]"])

setup_lifting type_definition_prefix

lift_definition last_ts :: "'a prefix \<Rightarrow> nat" is
  "\<lambda>p. (case p of [] \<Rightarrow> 0 | _ \<Rightarrow> snd (last p))" .

lift_definition first_ts :: "nat \<Rightarrow> 'a prefix \<Rightarrow> nat" is
  "\<lambda>n p. (case p of [] \<Rightarrow> n | _ \<Rightarrow> snd (hd p))" .

lift_definition pnil :: "'a prefix" is "[]" by simp

lift_definition plen :: "'a prefix \<Rightarrow> nat" is "length" .

lift_definition psnoc :: "'a prefix \<Rightarrow> 'a set \<times> nat \<Rightarrow> 'a prefix" is
  "\<lambda>p x. if (case p of [] \<Rightarrow> 0 | _ \<Rightarrow> snd (last p)) \<le> snd x then p @ [x] else []"
proof (goal_cases sorted_psnoc)
  case (sorted_psnoc p x)
  then show ?case
    by (induction p) (auto split: if_splits list.splits)
qed

instantiation prefix :: (type) order begin

lift_definition less_eq_prefix :: "'a prefix \<Rightarrow> 'a prefix \<Rightarrow> bool" is
  "\<lambda>p q. \<exists>r. q = p @ r" .

definition less_prefix :: "'a prefix \<Rightarrow> 'a prefix \<Rightarrow> bool" where
  "less_prefix x y = (x \<le> y \<and> \<not> y \<le> x)"

instance
proof (standard, goal_cases less refl trans antisym)
  case (less x y)
  then show ?case unfolding less_prefix_def ..
next
  case (refl x)
  then show ?case by transfer auto
next
  case (trans x y z)
  then show ?case by transfer auto
next
  case (antisym x y)
  then show ?case by transfer auto
qed

end

lemma psnoc_inject[simp]:
  "last_ts p \<le> snd x \<Longrightarrow> last_ts q \<le> snd y \<Longrightarrow> psnoc p x = psnoc q y \<longleftrightarrow> (p = q \<and> x = y)"
  by transfer auto

lift_definition prefix_of :: "'a prefix \<Rightarrow> 'a trace \<Rightarrow> bool" is "\<lambda>p s. stake (length p) s = p" .

lemma prefix_of_pnil[simp]: "prefix_of pnil \<sigma>"
  by transfer auto

lemma plen_pnil[simp]: "plen pnil = 0"
  by transfer auto

lemma plen_mono: "\<pi> \<le> \<pi>' \<Longrightarrow> plen \<pi> \<le> plen \<pi>'"
  by transfer auto

lemma prefix_of_psnocE: "prefix_of (psnoc p x) s \<Longrightarrow> last_ts p \<le> snd x \<Longrightarrow>
  (prefix_of p s \<Longrightarrow> \<Gamma> s (plen p) = fst x \<Longrightarrow> \<tau> s (plen p) = snd x \<Longrightarrow> P) \<Longrightarrow> P"
  by transfer (simp del: stake.simps add: stake_Suc)

lemma le_pnil[simp]: "pnil \<le> \<pi>"
  by transfer auto

lift_definition take_prefix :: "nat \<Rightarrow> 'a trace \<Rightarrow> 'a prefix" is stake
  by (auto dest: sorted_stake)

lemma plen_psnoc[simp]: "last_ts \<pi> \<le> snd x \<Longrightarrow> plen (psnoc \<pi> x) = plen \<pi> + 1"
  by transfer auto

lemma prefix_of_take_prefix[simp]: "prefix_of (take_prefix i \<sigma>) \<sigma>"
  by transfer auto

lift_definition pdrop :: "nat \<Rightarrow> 'a prefix \<Rightarrow> 'a prefix" is drop
  by (auto simp: drop_map[symmetric] sorted_drop)

lemma pdrop_0[simp]: "pdrop 0 \<pi> = \<pi>"
  by transfer auto

lemma prefix_of_antimono: "\<pi> \<le> \<pi>' \<Longrightarrow> prefix_of \<pi>' s \<Longrightarrow> prefix_of \<pi> s"
  by transfer (auto simp del: stake_add simp add: stake_add[symmetric])

lemma ex_prefix_of: "\<exists>s. prefix_of p s"
proof (transfer, intro bexI CollectI conjI)
  fix p :: "('a set \<times> nat) list"
  assume *: "sorted (map snd p)"
  let ?\<sigma> = "p @- smap (Pair undefined) (fromN (snd (last p)))"
  show "stake (length p) ?\<sigma> = p" by (simp add: stake_shift)
  have le_last: "snd (p ! i) \<le> snd (last p)" if "i < length p" for i
    using sorted_nth_mono[OF *, of i "length p - 1"] that
    by (cases p) (auto simp: last_conv_nth nth_Cons')
  with * show "ssorted (smap snd ?\<sigma>)"
    by (force simp: ssorted_iff_mono sorted_iff_nth_mono shift_snth)
  show "sincreasing (smap snd ?\<sigma>)" unfolding sincreasing_def
  proof (rule allI)
    fix i
    show "\<exists>j > i.  smap snd ?\<sigma> !! i < smap snd ?\<sigma> !! j"
    proof (cases "i < length p")
      case True
      with le_last[of i] show ?thesis
        by (auto intro!: exI[of _ "Suc (length p)"])
    next
      case False
      then show ?thesis
        by (auto simp: neq_Nil_conv intro!: exI[of _ "Suc i"])
    qed
  qed
qed

lemma \<tau>_prefix_conv: "prefix_of p s \<Longrightarrow> prefix_of p s' \<Longrightarrow> i < plen p \<Longrightarrow> \<tau> s i = \<tau> s' i"
  by transfer (simp add: stake_nth[symmetric])

lemma \<Gamma>_prefix_conv: "prefix_of p s \<Longrightarrow> prefix_of p s' \<Longrightarrow> i < plen p \<Longrightarrow> \<Gamma> s i = \<Gamma> s' i"
  by transfer (simp add: stake_nth[symmetric])

lemma sincreasing_sdrop:
  assumes "sincreasing s"
  shows "sincreasing (sdrop n s)"
proof (unfold sincreasing_def; safe)
  fix i
  from assms obtain j where "n + i < j" "s !! (n + i) < s !! j"
    unfolding sincreasing_def by auto
  then show "\<exists>j>i. sdrop n s !! i < sdrop n s !! j"
    by (auto simp: sdrop_snth intro!: exI[of _ "j - n"])
qed

lemma ssorted_shift:
  "ssorted (xs @- s) = (sorted xs \<and> ssorted s \<and> (\<forall>x\<in>set xs. \<forall>y\<in>sset s. x \<le> y))"
proof safe
  assume *: "ssorted (xs @- s)"
  then show "sorted xs"
    by (auto simp: ssorted_iff_mono shift_snth sorted_iff_nth_mono split: if_splits)
  from ssorted_sdrop[OF *, of "length xs"] show "ssorted s"
    by (auto simp: sdrop_shift)
  fix x y assume "x \<in> set xs" "y \<in> sset s"
  then obtain i j where "i < length xs" "xs ! i = x" "s !! j = y"
    by (auto simp: set_conv_nth sset_range)
  with ssorted_monoD[OF *, of i "j + length xs"] show "x \<le> y" by auto
next
  assume "sorted xs" "ssorted s" "\<forall>x\<in>set xs. \<forall>y\<in>sset s. x \<le> y"
  then show "ssorted (xs @- s)"
  proof (coinduction arbitrary: xs s)
    case (ssorted xs s)
    with \<open>ssorted s\<close> show ?case
      by (subst (asm) ssorted.simps) (auto 0 4 simp: neq_Nil_conv shd_sset intro: exI[of _ "_ # _"])
  qed
qed

lemma sincreasing_shift:
  assumes "ssorted (xs @- s)" "sincreasing s"
  shows "sincreasing (xs @- s)"
proof (unfold sincreasing_def; safe)
  fix i
  show "\<exists>j>i. (xs @- s) !! i < (xs @- s) !! j"
  proof (cases "i < length xs")
    case True
    with assms(1) have "xs ! i \<le> shd s" unfolding ssorted_shift by (auto simp: shd_sset)
    also obtain j where "\<dots> < s !! j"
      using assms(2) by (auto simp: sincreasing_def dest: spec[of _ 0])
    finally show ?thesis using True by (auto intro!: exI[of _ "j + length xs"])
  next
    case False
    then obtain j where "i - length xs < j" "s !! (i - length xs) < s !! j"
      using assms(2) by (auto simp: sincreasing_def)
    then show ?thesis using False by (auto simp: not_less intro!: exI[of _ "j + length xs"])
  qed
qed

lift_definition replace_prefix :: "'a prefix \<Rightarrow> 'a trace \<Rightarrow> 'a trace" is
   "\<lambda>\<pi> \<sigma>. if ssorted (smap snd (\<pi> @- sdrop (length \<pi>) \<sigma>)) then
     \<pi> @- sdrop (length \<pi>) \<sigma> else smap (\<lambda>i. ({}, i)) nats"
  by (auto split: if_splits simp: stream.map_comp stream.map_ident sdrop_smap[symmetric]
    simp del: sdrop_smap intro!: sincreasing_shift sincreasing_sdrop cong: stream.map_cong)

(*<*)
end
(*>*)