\<^marker>\<open>creator "Alexander Krauss"\<close>
\<^marker>\<open>creator "Josh Chen"\<close>
\<^marker>\<open>creator "Kevin Kappelmann"\<close>
section \<open>Basics for natural numbers\<close>
theory Nat_Base
imports
  HOL_Basics.HOL_Syntax_Bundles_Groups
  HOL_Basics.HOL_Syntax_Bundles_Orders
  Ordinals
begin

text \<open>The basic results have already been shown for \<nat> = \<omega>.\<close>

definition "nat \<equiv> \<omega>"

bundle isa_set_nat_syntax begin notation nat ("\<nat>") end
bundle no_isa_set_nat_syntax begin no_notation nat ("\<nat>") end
unbundle isa_set_nat_syntax

definition "nat_zero \<equiv> {}"
definition "nat_one \<equiv> succ nat_zero"

unbundle no_HOL_groups_syntax

bundle isa_set_nat_zero_syntax begin notation nat_zero ("0") end
bundle no_isa_set_nat_zero_syntax begin no_notation nat_zero ("0") end

bundle isa_set_nat_one_syntax begin notation nat_one ("1") end
bundle no_isa_set_nat_one_syntax begin no_notation nat_one ("1") end

unbundle
  isa_set_nat_zero_syntax
  isa_set_nat_one_syntax

lemmas fixpoint_nat [iff] = fixpoint_omega[folded nat_def nat_zero_def]
  and zero_mem_nat [iff] = empty_mem_omega[folded nat_def nat_zero_def]
  and succ_mem_nat_if_mem [intro!] = succ_mem_omega_if_mem[folded nat_def]
  and mem_natE = mem_omegaE[folded nat_def nat_zero_def, case_names _ zero succ]
  and nat_induct [case_names zero succ, induct set: nat] =
    omega_induct[folded nat_def nat_zero_def]
  and succ_ne_zero [iff] = Ordinals.succ_ne_empty[folded nat_zero_def]

lemma nat_one_in_nat [iff]: "1 \<in> \<nat>"
  unfolding nat_one_def by auto

lemma nat_zero_ne_one [iff]: "0 \<noteq> 1"
  unfolding nat_one_def by (fact succ_ne_self[symmetric])

subsection \<open>\<nat> as a type\<close>

abbreviation "Nat \<equiv> Element \<nat>"

(*TODO: could be auto-generated*)
lemma Nat_induct [case_names zero succ, induct pred: Nat]:
  assumes "n : Nat"
  and "P 0"
  and "\<And>n. n : Nat \<Longrightarrow> P n \<Longrightarrow> P (succ n)"
  shows "P n"
  using assms by (simp only: mem_iff_Element[symmetric]) (rule nat_induct)

(*TODO: could be auto-generated*)
lemma NatE:
  assumes "n : Nat"
  obtains (zero) "n = 0" | (succ) m where "m : Nat" "n = succ m"
  using assms by (simp only: mem_iff_Element[symmetric]) (rule mem_natE)

lemma Nat_Ord [derive]: "x : Nat \<Longrightarrow> x : Ord"
  by (induction x rule: Nat_induct) (simp only: nat_zero_def)

lemma Nat_zero_type [type]: "0 : Nat" by unfold_types auto

lemma Nat_succ_type [type]: "succ : Nat \<Rightarrow> Nat" by unfold_types auto

lemma Nat_one_type [type]: "1 : Nat" unfolding nat_one_def by discharge_types

subsection \<open>The \<open><\<close> and \<open>\<le>\<close> orders on Nat\<close>

definition "lt m n \<equiv> m \<in> n"

bundle isa_set_nat_lt_syntax begin notation lt (infix "<" 60) end
bundle no_isa_set_nat_lt_syntax begin no_notation lt (infix "<" 60) end

unbundle no_HOL_order_syntax
unbundle isa_set_nat_lt_syntax

lemmas lt_succ_self [iff] = mem_succ_self[folded lt_def]
  and lt_succ_if_lt = mem_succ_if_mem[folded lt_def]
  and lt_succE = mem_succE [folded lt_def]

lemma not_lt_zero [iff]: "\<not>(n < 0)"
  unfolding nat_zero_def lt_def by simp

lemma lt_irrefl [iff]: "\<not>(n < n)"
  unfolding nat_zero_def lt_def by simp

lemma lt_asym: "m < n \<Longrightarrow> \<not>(n < m)"
  unfolding lt_def by (fact not_mem_if_mem)

lemma ne_if_lt: "m < n \<Longrightarrow> m \<noteq> n"
  unfolding lt_def by (fact ne_if_mem)

lemma Nat_zero_lt_succ [simp]: "n : Nat \<Longrightarrow> 0 < succ n"
  unfolding lt_def nat_def nat_zero_def
  by (rule empty_mem_succ_if_mem_omega) discharge_types

lemma Nat_lt_trans [trans]: "\<lbrakk>n : Nat; l < m; m < n\<rbrakk> \<Longrightarrow> l < n"
  unfolding lt_def nat_def by (rule mem_trans_if_mem_omega') discharge_types

lemma Nat_lt_if_succ_lt: "n : Nat \<Longrightarrow> succ m < n \<Longrightarrow> m < n"
  unfolding lt_def nat_def
  by (rule mem_if_succ_mem_if_mem_omega) discharge_types

lemma Nat_succ_lt_succ_if_lt:
  "n : Nat \<Longrightarrow> m < n \<Longrightarrow> succ m < succ n"
  unfolding lt_def nat_def
  by (rule succ_mem_succ_if_mem_if_mem_omega) discharge_types

lemma Nat_lt_if_succ_lt_succ: "\<lbrakk>n : Nat; succ m < succ n\<rbrakk> \<Longrightarrow> m < n"
  unfolding lt_def nat_def
  by (rule mem_if_succ_mem_succ_if_mem_omega) discharge_types

corollary Nat_succ_lt_succ_iff_lt [iff]:
  "n : Nat \<Longrightarrow> succ m < succ n \<longleftrightarrow> m < n"
  using Nat_succ_lt_succ_if_lt Nat_lt_if_succ_lt_succ by blast

lemma Nat_trichotomy:
  assumes "m : Nat" "n : Nat"
  obtains (lt) "m < n" | (eq) "m = n" | (gt) "n < m"
  (*Good example of type derivation helpfulness*)
  unfolding lt_def by (rule Ord_trichotomy[of m n]) discharge_types

lemma Nat_zero_lt_iff_ne_zero: "n : Nat \<Longrightarrow> 0 < n \<longleftrightarrow> n \<noteq> 0"
  by (rule Nat_trichotomy[of 0 n]) auto

definition "le m n \<equiv> m < n \<or> m = n"

bundle isa_set_nat_le_syntax begin notation le (infix "\<le>" 60) end
bundle no_isa_set_nat_le_syntax begin no_notation le (infix "\<le>" 60) end
unbundle isa_set_nat_le_syntax

lemma leE:
  assumes "m \<le> n"
  obtains (lt) "m < n" | (eq) "m = n"
  using assms unfolding le_def by auto

lemma le_self [iff]: "n \<le> n" unfolding le_def by simp

lemma Nat_le_trans [trans]: "\<lbrakk>n : Nat; l \<le> m; m \<le> n\<rbrakk> \<Longrightarrow> l \<le> n"
  unfolding le_def using Nat_lt_trans[of n l m] by auto

lemma le_succ_if_le: "m \<le> n \<Longrightarrow> m \<le> succ n"
  unfolding le_def using lt_succ_if_lt by auto

lemma Nat_le_if_succ_le: "n : Nat \<Longrightarrow> succ m \<le> n \<Longrightarrow> m \<le> n"
  unfolding le_def by (auto intro: Nat_lt_trans[of n m "succ m"])

lemma le_if_lt: "m < n \<Longrightarrow> m \<le> n" unfolding le_def by simp

lemma not_succ_le_zero [iff]: "\<not>(succ n \<le> 0)"
  unfolding le_def nat_zero_def lt_def by simp

lemma Nat_zero_le [simp]: "n : Nat \<Longrightarrow> 0 \<le> n"
  unfolding le_def by (rule Nat_trichotomy[of 0 n]) auto

lemma eq_zero_if_le_zero [simp]: "n \<le> 0 \<Longrightarrow> n = 0"
  unfolding le_def by auto

lemma Nat_lt_if_le_if_lt [trans]: "\<lbrakk>n : Nat; l < m; m \<le> n\<rbrakk> \<Longrightarrow> l < n"
  unfolding le_def using Nat_lt_trans[of n l m] by auto

lemma Nat_lt_if_lt_if_le [trans]: "\<lbrakk>n : Nat; l \<le> m; m < n\<rbrakk> \<Longrightarrow> l < n"
  unfolding le_def using Nat_lt_trans[of n l m] by auto

lemma Nat_le_if_not_lt:
  assumes "m : Nat" "n : Nat" "\<not>(m < n)"
  shows "n \<le> m"
  by (rule Nat_trichotomy[of m n]) (auto simp: assms dest: le_if_lt)

lemma Nat_not_lt_if_le:
  assumes "m : Nat" "n : Nat" "m \<le> n"
  shows "\<not>(n < m)"
  using assms Nat_lt_if_lt_if_le[of m m n] by auto

corollary Nat_not_lt_iff_le:
  assumes "m : Nat" "n : Nat"
  shows "\<not>(n < m) \<longleftrightarrow> m \<le> n"
  using assms Nat_le_if_not_lt Nat_not_lt_if_le by blast

lemma Nat_succ_le_succ_if_le: "\<lbrakk>n : Nat; m \<le> n\<rbrakk> \<Longrightarrow> succ m \<le> succ n"
  unfolding le_def by auto

lemma Nat_le_if_succ_le_succ: "\<lbrakk>n : Nat; succ m \<le> succ n\<rbrakk> \<Longrightarrow> m \<le> n"
  unfolding le_def by auto

corollary Nat_succ_le_succ_iff_le [iff]: "n : Nat \<Longrightarrow> succ m \<le> succ n \<longleftrightarrow> m \<le> n"
  using Nat_le_if_succ_le_succ Nat_succ_le_succ_if_le by blast

lemma le_if_lt_succ: "m < succ n \<Longrightarrow> m \<le> n"
  unfolding lt_def le_def by auto

lemma Nat_lt_succ_if_le: "n : Nat \<Longrightarrow> m \<le> n \<Longrightarrow> m < succ n"
  unfolding lt_def le_def by auto

corollary Nat_lt_succ_iff_le: "n : Nat \<Longrightarrow> m < succ n \<longleftrightarrow> m \<le> n"
  using le_if_lt_succ Nat_lt_succ_if_le by blast

lemma Nat_succ_le_if_lt: "n : Nat \<Longrightarrow> m < n \<Longrightarrow> succ m \<le> n"
  using le_if_lt_succ by auto

lemma Nat_lt_if_succ_le: "n : Nat \<Longrightarrow> succ m \<le> n \<Longrightarrow> m < n"
  using Nat_lt_succ_if_le by auto

corollary Nat_succ_le_iff_lt: "n : Nat \<Longrightarrow> succ m \<le> n \<longleftrightarrow> m < n"
  using Nat_succ_le_if_lt Nat_lt_if_succ_le by blast

(*TODO: the following should be part of the type checker*)
lemma Nat_if_lt_Nat: "n : Nat \<Longrightarrow> m < n \<Longrightarrow> m : Nat"
  (*TODO: would be nice if this works*)
  (* unfolding nat_def lt_def using mem_omega_if_mem_if_mem_omega by auto *)
  unfolding nat_def lt_def by unfold_types (fact mem_omega_if_mem_if_mem_omega)

lemma Nat_if_le_Nat: "n : Nat \<Longrightarrow> m \<le> n \<Longrightarrow> m : Nat"
  unfolding le_def using Nat_if_lt_Nat by auto

lemma Nat_lt_if_lt_succ_if_lt: "n : Nat \<Longrightarrow> l < m \<Longrightarrow> m < succ n \<Longrightarrow> l < n"
  using Nat_lt_if_le_if_lt[of n l m] by (auto intro: le_if_lt_succ)

lemma Nat_succ_lt_if_lt_if_lt: "n : Nat \<Longrightarrow> l < m \<Longrightarrow> m < n \<Longrightarrow> succ l < n"
  by (rule Nat_lt_if_lt_if_le[of n "succ l" m])
    (auto intro: le_if_lt_succ Nat_if_lt_Nat)

subsection \<open>More induction principles\<close>

lemma Nat_strong_induct [case_names step, induct pred: Nat]:
  assumes "n : Nat"
  and step: "\<And>m. m : Nat \<Longrightarrow> (\<And>l. l : Nat \<Longrightarrow> l < m \<Longrightarrow> P l) \<Longrightarrow> P m"
  shows "P n"
proof -
  {
    fix m assume "m : Nat"
    then have "\<And>l. l : Nat \<Longrightarrow> l < m \<Longrightarrow> P l"
    proof (induction m rule: Nat_induct)
      case (succ m)
      show "P l"
      proof (rule step)
        fix l' assume "l' : Nat" "l' < l"
        then have "l' < m"
          using \<open>l < succ m\<close> Nat_lt_if_lt_succ_if_lt[of m l'] by auto
        then show "P l'" by (intro succ.IH[of l']) auto
      qed fact
    qed auto
  }
  note P_if_lt_Nat = this
  show "P n" by (rule P_if_lt_Nat) auto
qed

lemma Nat_le_induct [case_names le step, induct pred: Nat]:
  assumes "n : Nat"
  and "m \<le> n"
  and step: "\<And>m. m : Nat \<Longrightarrow> m \<le> n \<Longrightarrow> (\<And>l. l : Nat \<Longrightarrow> l < m \<Longrightarrow> P l) \<Longrightarrow> P m"
  shows "P m"
proof (rule Nat_strong_induct[where ?n=m and ?P="\<lambda>m. m \<le> n \<longrightarrow> P m", rule_format])
  fix m assume "m : Nat" "m \<le> n"
    and IH: "\<And>l. l : Nat \<Longrightarrow> l < m \<Longrightarrow> l \<le> n \<Longrightarrow> P l"
  show "P m"
  proof (rule step)
    fix l assume "l : Nat" "l < m"
    moreover with \<open>m \<le> n\<close> have "l \<le> n"
      by (auto intro!: Nat_lt_if_le_if_lt[of n l m] le_if_lt)
    ultimately show "P l" using IH by auto
  qed fact+
qed (auto intro: Nat_if_le_Nat assms)

subsection \<open>Truncated predecessor function\<close>

definition "pred n = (if n = 0 then 0 else (THE m \<in> \<nat>. n = succ m))"

lemma pred_type [type]: "pred : Nat \<Rightarrow> Nat"
  unfolding pred_def by unfold_types (auto intro: bthe_memI elim: mem_natE)

lemma pred_zero_eq [simp]: "pred 0 = 0"
  unfolding pred_def by simp

lemma Nat_pred_succ_eq [simp]: "n : Nat \<Longrightarrow> pred (succ n) = n"
  unfolding pred_def by auto

lemma Nat_succ_pred_eq_if_ne_zero [simp]:
  "n : Nat \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> succ (pred n) = n"
  unfolding pred_def by (rule NatE) (auto intro!: arg_cong[where ?f="succ"])

subsubsection \<open>\<open>pred\<close> and \<open><\<close>\<close>

lemma Nat_pred_lt_self_if_ne_zero [iff]:
  "n : Nat \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> pred n < n"
  by (rule NatE) auto

lemma Nat_pred_lt_if_lt: "n : Nat \<Longrightarrow> m < n \<Longrightarrow> pred m < n"
  by (rule NatE[of m]) (auto intro: Nat_lt_if_succ_lt Nat_if_lt_Nat)

lemma Nat_lt_if_lt_pred: "n : Nat \<Longrightarrow> m < pred n \<Longrightarrow> m < n"
  by (rule NatE[of n]) (auto intro: Nat_if_lt_Nat lt_succ_if_lt)

lemma Nat_pred_lt_pred_if_lt_if_ne_zero:
  assumes "n : Nat"
  and "m \<noteq> 0"
  and "m < n"
  shows "pred m < pred n"
  by (rule NatE[of m]; rule NatE[of n])
    (insert assms, auto intro: Nat_if_lt_Nat)

lemma Nat_lt_if_pred_lt_pred:
  assumes "m : Nat" "n : Nat"
  and "pred m < pred n"
  shows "m < n"
  by (rule NatE[of m]; rule NatE[of n]) (insert assms, auto)

corollary Nat_pred_lt_pred_iff_lt_if_ne_zero [iff]:
  assumes "m : Nat" "n : Nat"
  and "m \<noteq> 0"
  shows "pred m < pred n \<longleftrightarrow> m < n"
  using assms Nat_pred_lt_pred_if_lt_if_ne_zero Nat_lt_if_pred_lt_pred by blast

lemma Nat_lt_pred_if_succ_lt:
  assumes "n : Nat"
  assumes "succ m < n"
  shows "m < pred n"
  by (rule NatE[of n]) (insert assms, auto)

lemma Nat_succ_lt_if_lt_pred:
  assumes "n : Nat"
  and "m < pred n"
  shows "succ m < n"
  by (rule NatE[of n]) (insert assms, auto)

lemma Nat_lt_if_lt_if_pred_lt:
  assumes "l : Nat" "n : Nat"
  and "pred l < m" "m < n"
  shows "l < n"
  by (rule NatE[of l])
    (insert assms, auto dest: Nat_succ_lt_if_lt_if_lt Nat_lt_trans)

lemma Nat_lt_pred_if_lt_if_lt:
  assumes "n : Nat"
  and "l < m" "m < n"
  shows "l < pred n"
  by (rule NatE[of n]) (insert assms, auto dest: Nat_succ_lt_if_lt_if_lt)

subsubsection \<open>\<open>pred\<close> and \<open>\<le>\<close>\<close>

lemma Nat_pred_le_self [iff]: "n : Nat \<Longrightarrow> pred n \<le> n"
  by (rule NatE) (auto intro: le_succ_if_le)

lemma Nat_pred_le_if_le: "n : Nat \<Longrightarrow> m \<le> n \<Longrightarrow> pred m \<le> n"
  by (rule NatE[of m]) (auto intro: Nat_if_le_Nat Nat_le_if_succ_le)

lemma Nat_le_if_le_pred: "n : Nat \<Longrightarrow> m \<le> pred n \<Longrightarrow> m \<le> n"
  by (rule NatE[of n]) (auto intro: le_succ_if_le)

lemma Nat_pred_le_pred_if_le:
  assumes "n : Nat"
  and "m \<le> n"
  shows "pred m \<le> pred n"
  by (rule NatE[of m]; rule NatE[of n])
    (insert assms, auto intro: Nat_if_le_Nat)

lemma Nat_le_if_pred_le_pred_if_ne_zero:
  assumes "m : Nat" "n : Nat"
  and "n \<noteq> 0"
  and "pred m \<le> pred n"
  shows "m \<le> n"
  by (rule NatE[of m]; rule NatE[of n]) (insert assms, auto)

corollary Nat_pred_le_pred_iff_le_if_ne_zero [iff]:
  assumes "m : Nat" "n : Nat"
  and "n \<noteq> 0"
  shows "pred m \<le> pred n \<longleftrightarrow> m \<le> n"
  using assms Nat_pred_le_pred_if_le Nat_le_if_pred_le_pred_if_ne_zero by blast

lemma Nat_le_pred_if_succ_le:
  assumes "n : Nat"
  assumes "succ m \<le> n"
  shows "m \<le> pred n"
  by (rule NatE[of n]) (insert assms, auto)

lemma Nat_succ_le_if_le_pred_if_ne_zero:
  assumes "n : Nat"
  and "n \<noteq> 0"
  and "m \<le> pred n"
  shows "succ m \<le> n"
  by (rule NatE[of n]) (insert assms, auto)

subsubsection \<open>\<open>pred\<close> and \<open><\<close> and \<open>\<le>\<close>\<close>

lemma Nat_le_if_pred_lt: "n : Nat \<Longrightarrow> m : Nat \<Longrightarrow> pred m < n \<Longrightarrow> m \<le> n"
  by (rule NatE[of m]) (auto dest: Nat_succ_le_if_lt)

lemma Nat_pred_lt_if_le_if_ne_zero: "n : Nat \<Longrightarrow> m \<noteq> 0 \<Longrightarrow> m \<le> n \<Longrightarrow> pred m < n"
  by (rule NatE[of m]) (auto intro: Nat_if_le_Nat Nat_lt_if_succ_le)

corollary Nat_pred_lt_iff_le_if_ne_zero:
  assumes "n : Nat" "m : Nat"
  and "m \<noteq> 0"
  shows "pred m < n \<longleftrightarrow> m \<le> n"
  using assms Nat_le_if_pred_lt Nat_pred_lt_if_le_if_ne_zero by blast

lemma Nat_le_pred_if_lt: "n : Nat \<Longrightarrow> m < n \<Longrightarrow> m \<le> pred n"
  by (rule NatE[of n]) (auto dest: le_if_lt_succ)

lemma Nat_lt_if_le_pred_if_ne_zero: "n : Nat \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> m \<le> pred n \<Longrightarrow> m < n"
  by (rule NatE[of n]) (auto dest: Nat_lt_if_succ_le)

corollary Nat_le_pred_iff_lt_if_ne_zero:
  "n : Nat \<Longrightarrow> n \<noteq> 0 \<Longrightarrow> m \<le> pred n \<longleftrightarrow> m < n"
  using Nat_lt_if_le_pred_if_ne_zero Nat_le_pred_if_lt by blast

lemma Nat_pred_eq_zero_iff: "n : Nat \<Longrightarrow> pred n = 0 \<longleftrightarrow> n = 0 \<or> n = 1"
unfolding nat_one_def
proof
  fix n assume "n : Nat" "pred n = 0"
  then show "n = 0 \<or> n = succ 0"
  proof (cases n rule: NatE)
    case (succ m)
    then have "m = pred n" by simp
    also have "... = 0" by fact
    finally have "m = 0" .
    with \<open>n = succ m\<close> show "n = 0 \<or> n = succ 0" by simp
  qed auto
qed auto

end


(*
    This file is a part of IsarMathLib -
    a library of formalized mathematics written for Isabelle/Isar.

    Copyright (C) 2005, 2006  Slawomir Kolodynski

    This program is free software; Redistribution and use in source and binary forms,
    with or without modification, are permitted provided that the following conditions are met:

   1. Redistributions of source code must retain the above copyright notice,
   this list of conditions and the following disclaimer.
   2. Redistributions in binary form must reproduce the above copyright notice,
   this list of conditions and the following disclaimer in the documentation and/or
   other materials provided with the distribution.
   3. The name of the author may not be used to endorse or promote products
   derived from this software without specific prior written permission.

THIS SOFTWARE IS PROVIDED BY THE AUTHOR ``AS IS'' AND ANY EXPRESS OR IMPLIED
WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF
MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED.
IN NO EVENT SHALL THE AUTHOR BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO,
PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS;
OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY,
WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE,
EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

*)

section \<open>Groups - and alternative definition\<close>

theory Group_ZF_1b imports Group_ZF

begin

text\<open>In a typical textbook a group is defined as a set $G$ with an
  associative operation such that two conditions hold:

  A: there is an element $e\in G$ such that for all
  $g\in G$ we have $e\cdot g = g$ and $g\cdot e =g$. We call this element a
  "unit" or a "neutral element" of the group.

  B: for every $a\in G$ there exists a $b\in G$ such that $a\cdot b = e$,
  where $e$ is the element of $G$ whose existence is guaranteed by A.

  The validity of this definition is rather dubious to me, as condition
  A does not define any specific element $e$ that can be referred to in
  condition B - it merely states that a set of such units
  $e$ is not empty. Of course it does work in the end as we can prove that
  the set of such neutral elements has exactly one element, but still the definition
  by itself is not valid. You just can't reference a variable bound by a quantifier
  outside of the scope of that quantifier.

  One way around this is to first use condition A to define
  the notion of a monoid, then prove the uniqueness of $e$ and then use the
  condition B to define groups.

  Another way is to write conditions A and B together as follows:

  $\exists_{e \in G} \ (\forall_{g \in G} \ e\cdot g = g \wedge g\cdot e = g)
  \wedge (\forall_{a\in G}\exists_{b\in G}\  a\cdot b = e).$

  This is rather ugly.

  What I want to talk about is an amusing way to define groups directly
  without any reference to the neutral elements. Namely, we can define
  a group as a non-empty set $G$ with an associative operation "$\cdot $"
  such that

  C: for every $a,b\in G$ the equations $a\cdot x = b$ and
  $y\cdot a = b$ can be solved in $G$.

  This theory file aims at proving the equivalence of this
  alternative definition with the usual definition of the group, as
  formulated in \<open>Group_ZF.thy\<close>. The informal proofs come from an Aug. 14, 2005
  post by buli on the matematyka.org forum.\<close>

subsection\<open>An alternative definition of group\<close>

text\<open>First we will define notation for writing about groups.\<close>

text\<open>We will use the multiplicative notation for the group operation. To do this, we
  define a context (locale) that tells Isabelle
  to interpret $a\cdot b$ as the value of function $P$ on the pair
  $\langle a,b \rangle$.\<close>

locale group2 =
  fixes P
  fixes dot (infixl "\<cdot>" 70)
  defines dot_def [simp]: "a \<cdot> b \<equiv> P`\<langle>a,b\<rangle>"

text\<open>The next theorem states that a set $G$ with an associative operation
  that satisfies condition C is a group, as defined in IsarMathLib
  \<open>Group_ZF\<close> theory.\<close>

theorem (in group2) altgroup_is_group:
  assumes A1: "G\<noteq>0" and A2: "P {is associative on} G"
  and A3: "\<forall>a\<in>G.\<forall>b\<in>G. \<exists>x\<in>G. a\<cdot>x = b"
  and A4: "\<forall>a\<in>G.\<forall>b\<in>G. \<exists>y\<in>G. y\<cdot>a = b"
  shows "IsAgroup(G,P)"
proof -
  from A1 obtain a where "a\<in>G" by auto
  with A3 obtain x where "x\<in>G" and "a\<cdot>x = a"
    by auto
  from A4 \<open>a\<in>G\<close> obtain y where "y\<in>G" and "y\<cdot>a = a"
    by auto
  have I: "\<forall>b\<in>G. b = b\<cdot>x \<and> b = y\<cdot>b"
  proof
    fix b assume "b\<in>G"
     with A4 \<open>a\<in>G\<close> obtain y\<^sub>b where "y\<^sub>b\<in>G"
      and "y\<^sub>b\<cdot>a = b" by auto
    from A3 \<open>a\<in>G\<close> \<open>b\<in>G\<close> obtain x\<^sub>b where "x\<^sub>b\<in>G"
      and "a\<cdot>x\<^sub>b = b" by auto
    from \<open>a\<cdot>x = a\<close> \<open>y\<cdot>a = a\<close> \<open>y\<^sub>b\<cdot>a = b\<close> \<open>a\<cdot>x\<^sub>b = b\<close>
    have "b = y\<^sub>b\<cdot>(a\<cdot>x)" and "b = (y\<cdot>a)\<cdot>x\<^sub>b"
      by auto
    moreover from A2 \<open>a\<in>G\<close> \<open>x\<in>G\<close> \<open>y\<in>G\<close> \<open>x\<^sub>b\<in>G\<close> \<open>y\<^sub>b\<in>G\<close> have
      "(y\<cdot>a)\<cdot>x\<^sub>b = y\<cdot>(a\<cdot>x\<^sub>b)"  "y\<^sub>b\<cdot>(a\<cdot>x) = (y\<^sub>b\<cdot>a)\<cdot>x"
      using IsAssociative_def by auto
    moreover from \<open>y\<^sub>b\<cdot>a = b\<close> \<open>a\<cdot>x\<^sub>b = b\<close> have
      "(y\<^sub>b\<cdot>a)\<cdot>x = b\<cdot>x"  "y\<cdot>(a\<cdot>x\<^sub>b) = y\<cdot>b"
      by auto
    ultimately show "b = b\<cdot>x \<and> b = y\<cdot>b" by simp
  qed
  moreover have "x = y"
  proof -
    from \<open>x\<in>G\<close> I have "x = y\<cdot>x" by simp
    also from \<open>y\<in>G\<close> I have "y\<cdot>x = y" by simp
    finally show "x = y" by simp
  qed
  ultimately have "\<forall>b\<in>G. b\<cdot>x = b \<and> x\<cdot>b = b" by simp
  with A2 \<open>x\<in>G\<close> have "IsAmonoid(G,P)" using IsAmonoid_def by auto
  with A3 show "IsAgroup(G,P)"
    using monoid0_def monoid0.unit_is_neutral IsAgroup_def
    by simp
qed

text\<open>The converse of \<open>altgroup_is_group\<close>:
  in every (classically defined) group condition C holds.
  In informal mathematics we can say "Obviously
  condition C holds in any group." In formalized mathematics the word "obviously"
  is not in the language. The next theorem is proven in the context called
  \<open>group0\<close> defined in the theory \<open>Group_ZF.thy\<close>. Similarly to the
  \<open>group2\<close> that context defines $a\cdot b$ as $P\langle a,b\rangle$
  It also defines notation related to the group inverse and
  adds an assumption that the pair $(G,P)$ is a group
  to all its theorems. This is why in the next theorem we don't
  explicitely assume that $(G,P)$ is a group - this assumption
  is implicit in the context.\<close>

theorem (in group0) group_is_altgroup: shows
  "\<forall>a\<in>G.\<forall>b\<in>G. \<exists>x\<in>G. a\<cdot>x = b" and "\<forall>a\<in>G.\<forall>b\<in>G. \<exists>y\<in>G. y\<cdot>a = b"
proof -
  { fix a b assume "a\<in>G"  "b\<in>G"
    let ?x = "a\<inverse>\<cdot> b"
    let ?y = "b\<cdot>a\<inverse>"
    from \<open>a\<in>G\<close>  \<open>b\<in>G\<close>  have
      "?x \<in> G"  "?y \<in> G"  and  "a\<cdot>?x = b"  "?y\<cdot>a = b"
      using inverse_in_group group_op_closed inv_cancel_two
      by auto
    hence "\<exists>x\<in>G. a\<cdot>x = b" and "\<exists>y\<in>G. y\<cdot>a = b" by auto
  } thus
      "\<forall>a\<in>G.\<forall>b\<in>G. \<exists>x\<in>G. a\<cdot>x = b" and
      "\<forall>a\<in>G.\<forall>b\<in>G. \<exists>y\<in>G. y\<cdot>a = b"
    by auto
qed

end


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

Intuitionistic First-Order Logic.

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

(*Note: for PROPOSITIONAL formulae...
  ~A is classically provable iff it is intuitionistically provable.
  Therefore A is classically provable iff ~~A is intuitionistically provable.

Let Q be the conjuction of the propositions A|~A, one for each atom A in
P.  If P is provable classically, then clearly P&Q is provable
intuitionistically, so ~~(P&Q) is also provable intuitionistically.
The latter is intuitionistically equivalent to ~~P&~~Q, hence to ~~P,
since ~~Q is intuitionistically provable.  Finally, if P is a negation then
~~P is intuitionstically equivalent to P.  [Andy Pitts]
*)

theory Intuitionistic
imports IFOLP
begin

schematic_lemma "?p : ~~(P&Q) <-> ~~P & ~~Q"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

schematic_lemma "?p : ~~~P <-> ~P"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

schematic_lemma "?p : ~~((P --> Q | R)  -->  (P-->Q) | (P-->R))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

schematic_lemma "?p : (P<->Q) <-> (Q<->P)"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

subsection {* Lemmas for the propositional double-negation translation *}

schematic_lemma "?p : P --> ~~P"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

schematic_lemma "?p : ~~(~~P --> P)"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

schematic_lemma "?p : ~~P & ~~(P --> Q) --> ~~Q"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

subsection {* The following are classically but not constructively valid *}

(*The attempt to prove them terminates quickly!*)
schematic_lemma "?p : ((P-->Q) --> P)  -->  P"
  apply (tactic {* IntPr.fast_tac @{context} 1 *})?
  oops

schematic_lemma "?p : (P&Q-->R)  -->  (P-->R) | (Q-->R)"
  apply (tactic {* IntPr.fast_tac @{context} 1 *})?
  oops

subsection {* Intuitionistic FOL: propositional problems based on Pelletier *}

text "Problem ~~1"
schematic_lemma "?p : ~~((P-->Q)  <->  (~Q --> ~P))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem ~~2"
schematic_lemma "?p : ~~(~~P  <->  P)"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem 3"
schematic_lemma "?p : ~(P-->Q) --> (Q-->P)"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem ~~4"
schematic_lemma "?p : ~~((~P-->Q)  <->  (~Q --> P))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem ~~5"
schematic_lemma "?p : ~~((P|Q-->P|R) --> P|(Q-->R))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem ~~6"
schematic_lemma "?p : ~~(P | ~P)"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem ~~7"
schematic_lemma "?p : ~~(P | ~~~P)"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem ~~8.  Peirce's law"
schematic_lemma "?p : ~~(((P-->Q) --> P)  -->  P)"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem 9"
schematic_lemma "?p : ((P|Q) & (~P|Q) & (P| ~Q)) --> ~ (~P | ~Q)"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem 10"
schematic_lemma "?p : (Q-->R) --> (R-->P&Q) --> (P-->(Q|R)) --> (P<->Q)"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "11.  Proved in each direction (incorrectly, says Pelletier!!) "
schematic_lemma "?p : P<->P"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem ~~12.  Dijkstra's law  "
schematic_lemma "?p : ~~(((P <-> Q) <-> R)  <->  (P <-> (Q <-> R)))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

schematic_lemma "?p : ((P <-> Q) <-> R)  -->  ~~(P <-> (Q <-> R))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem 13.  Distributive law"
schematic_lemma "?p : P | (Q & R)  <-> (P | Q) & (P | R)"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem ~~14"
schematic_lemma "?p : ~~((P <-> Q) <-> ((Q | ~P) & (~Q|P)))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem ~~15"
schematic_lemma "?p : ~~((P --> Q) <-> (~P | Q))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem ~~16"
schematic_lemma "?p : ~~((P-->Q) | (Q-->P))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem ~~17"
schematic_lemma "?p : ~~(((P & (Q-->R))-->S) <-> ((~P | Q | S) & (~P | ~R | S)))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})  -- slow

subsection {* Examples with quantifiers *}

text "The converse is classical in the following implications..."

schematic_lemma "?p : (EX x. P(x)-->Q)  -->  (ALL x. P(x)) --> Q"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

schematic_lemma "?p : ((ALL x. P(x))-->Q) --> ~ (ALL x. P(x) & ~Q)"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

schematic_lemma "?p : ((ALL x. ~P(x))-->Q)  -->  ~ (ALL x. ~ (P(x)|Q))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

schematic_lemma "?p : (ALL x. P(x)) | Q  -->  (ALL x. P(x) | Q)"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

schematic_lemma "?p : (EX x. P --> Q(x)) --> (P --> (EX x. Q(x)))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "The following are not constructively valid!"
text "The attempt to prove them terminates quickly!"

schematic_lemma "?p : ((ALL x. P(x))-->Q) --> (EX x. P(x)-->Q)"
  apply (tactic {* IntPr.fast_tac @{context} 1 *})?
  oops

schematic_lemma "?p : (P --> (EX x. Q(x))) --> (EX x. P-->Q(x))"
  apply (tactic {* IntPr.fast_tac @{context} 1 *})?
  oops

schematic_lemma "?p : (ALL x. P(x) | Q) --> ((ALL x. P(x)) | Q)"
  apply (tactic {* IntPr.fast_tac @{context} 1 *})?
  oops

schematic_lemma "?p : (ALL x. ~~P(x)) --> ~~(ALL x. P(x))"
  apply (tactic {* IntPr.fast_tac @{context} 1 *})?
  oops

(*Classically but not intuitionistically valid.  Proved by a bug in 1986!*)
schematic_lemma "?p : EX x. Q(x) --> (ALL x. Q(x))"
  apply (tactic {* IntPr.fast_tac @{context} 1 *})?
  oops

subsection "Hard examples with quantifiers"

text {*
  The ones that have not been proved are not known to be valid!
  Some will require quantifier duplication -- not currently available.
*}

text "Problem ~~18"
schematic_lemma "?p : ~~(EX y. ALL x. P(y)-->P(x))" oops
(*NOT PROVED*)

text "Problem ~~19"
schematic_lemma "?p : ~~(EX x. ALL y z. (P(y)-->Q(z)) --> (P(x)-->Q(x)))" oops
(*NOT PROVED*)

text "Problem 20"
schematic_lemma "?p : (ALL x y. EX z. ALL w. (P(x)&Q(y)-->R(z)&S(w)))
    --> (EX x y. P(x) & Q(y)) --> (EX z. R(z))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem 21"
schematic_lemma "?p : (EX x. P-->Q(x)) & (EX x. Q(x)-->P) --> ~~(EX x. P<->Q(x))" oops
(*NOT PROVED*)

text "Problem 22"
schematic_lemma "?p : (ALL x. P <-> Q(x))  -->  (P <-> (ALL x. Q(x)))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem ~~23"
schematic_lemma "?p : ~~ ((ALL x. P | Q(x))  <->  (P | (ALL x. Q(x))))"
  by (tactic {* IntPr.fast_tac @{context} 1 *})

text "Problem 24"
schematic_lemma "?p : ~(EX x. S(x)&Q(x)) & (ALL x. P(x) --> Q(x)|R(x)) &
     (~(EX x. P(x)) --> (EX x. Q(x))) & (ALL x. Q(x)|R(x) --> S(x))
    --> ~~(EX x. P(x)&R(x))"
(*Not clear why fast_tac, best_tac, ASTAR and ITER_DEEPEN all take forever*)
  apply (tactic "IntPr.safe_tac @{context}")
  apply (erule impE)
   apply (tactic "IntPr.fast_tac @{context} 1")
  apply (tactic "IntPr.fast_tac @{context} 1")
  done

text "Problem 25"
schematic_lemma "?p : (EX x. P(x)) &
        (ALL x. L(x) --> ~ (M(x) & R(x))) &
        (ALL x. P(x) --> (M(x) & L(x))) &
        ((ALL x. P(x)-->Q(x)) | (EX x. P(x)&R(x)))
    --> (EX x. Q(x)&P(x))"
  by (tactic "IntPr.best_tac @{context} 1")

text "Problem 29.  Essentially the same as Principia Mathematica *11.71"
schematic_lemma "?p : (EX x. P(x)) & (EX y. Q(y))
    --> ((ALL x. P(x)-->R(x)) & (ALL y. Q(y)-->S(y))   <->
         (ALL x y. P(x) & Q(y) --> R(x) & S(y)))"
  by (tactic "IntPr.fast_tac @{context} 1")

text "Problem ~~30"
schematic_lemma "?p : (ALL x. (P(x) | Q(x)) --> ~ R(x)) &
        (ALL x. (Q(x) --> ~ S(x)) --> P(x) & R(x))
    --> (ALL x. ~~S(x))"
  by (tactic "IntPr.fast_tac @{context} 1")

text "Problem 31"
schematic_lemma "?p : ~(EX x. P(x) & (Q(x) | R(x))) &
        (EX x. L(x) & P(x)) &
        (ALL x. ~ R(x) --> M(x))
    --> (EX x. L(x) & M(x))"
  by (tactic "IntPr.fast_tac @{context} 1")

text "Problem 32"
schematic_lemma "?p : (ALL x. P(x) & (Q(x)|R(x))-->S(x)) &
        (ALL x. S(x) & R(x) --> L(x)) &
        (ALL x. M(x) --> R(x))
    --> (ALL x. P(x) & M(x) --> L(x))"
  by (tactic "IntPr.best_tac @{context} 1") -- slow

text "Problem 39"
schematic_lemma "?p : ~ (EX x. ALL y. F(y,x) <-> ~F(y,y))"
  by (tactic "IntPr.best_tac @{context} 1")

text "Problem 40.  AMENDED"
schematic_lemma "?p : (EX y. ALL x. F(x,y) <-> F(x,x)) -->
              ~(ALL x. EX y. ALL z. F(z,y) <-> ~ F(z,x))"
  by (tactic "IntPr.best_tac @{context} 1") -- slow

text "Problem 44"
schematic_lemma "?p : (ALL x. f(x) -->
              (EX y. g(y) & h(x,y) & (EX y. g(y) & ~ h(x,y))))  &
              (EX x. j(x) & (ALL y. g(y) --> h(x,y)))
              --> (EX x. j(x) & ~f(x))"
  by (tactic "IntPr.best_tac @{context} 1")

text "Problem 48"
schematic_lemma "?p : (a=b | c=d) & (a=c | b=d) --> a=d | b=c"
  by (tactic "IntPr.best_tac @{context} 1")

text "Problem 51"
schematic_lemma
    "?p : (EX z w. ALL x y. P(x,y) <->  (x=z & y=w)) -->
     (EX z. ALL x. EX w. (ALL y. P(x,y) <-> y=w) <-> x=z)"
  by (tactic "IntPr.best_tac @{context} 1") -- {*60 seconds*}

text "Problem 56"
schematic_lemma "?p : (ALL x. (EX y. P(y) & x=f(y)) --> P(x)) <-> (ALL x. P(x) --> P(f(x)))"
  by (tactic "IntPr.best_tac @{context} 1")

text "Problem 57"
schematic_lemma
    "?p : P(f(a,b), f(b,c)) & P(f(b,c), f(a,c)) &
     (ALL x y z. P(x,y) & P(y,z) --> P(x,z))    -->   P(f(a,b), f(a,c))"
  by (tactic "IntPr.best_tac @{context} 1")

text "Problem 60"
schematic_lemma "?p : ALL x. P(x,f(x)) <-> (EX y. (ALL z. P(z,y) --> P(z,f(x))) & P(x,y))"
  by (tactic "IntPr.best_tac @{context} 1")

end


theory Pointer_Examples
  imports VC_KAD_Examples "$ISABELLE_HOME/src/HOL/Hoare/Heap"
begin

type_synonym 'a state = "string  \<Rightarrow> ('a ref + ('a \<Rightarrow> 'a ref))"

lemma list_reversal:
  "PRE (\<lambda>s :: 'a state. List (projr (s ''h'')) (projl (s ''p'')) Ps
        \<and> List (projr (s ''h'')) (projl (s ''q'')) Qs
        \<and> set Ps \<inter> set Qs = {})
    (WHILE (\<lambda>s. projl (s ''p'') \<noteq> Null)
     INV (\<lambda>s. \<exists>ps qs. List (projr (s ''h'')) (projl (s ''p'')) ps
              \<and> List (projr (s ''h'')) (projl (s ''q'')) qs
              \<and> set ps \<inter> set qs = {} \<and> rev ps @ qs = rev Ps @ Qs)
     DO
      (''r'' ::= (\<lambda>s. s ''p''));
      (''p'' ::= (\<lambda>s. Inl (projr (s ''h'') (addr (projl (s ''p''))))) );
      (''h'' ::= (\<lambda>s. Inr ((projr (s ''h''))(addr (projl (s ''r'')) := projl (s ''q''))) ));
      (''q'' ::= (\<lambda>s. s ''r''))
     OD)
  POST (\<lambda>s. List (projr (s ''h'')) (projl (s ''q'')) (rev Ps @ Qs))"
  apply hoare
  apply auto
  apply(fastforce intro: notin_List_update[THEN iffD2])
done

end