diff --git a/thys/Aristotles_Assertoric_Syllogistic/AristotlesAssertoric.thy b/thys/Aristotles_Assertoric_Syllogistic/AristotlesAssertoric.thy
--- a/thys/Aristotles_Assertoric_Syllogistic/AristotlesAssertoric.thy
+++ b/thys/Aristotles_Assertoric_Syllogistic/AristotlesAssertoric.thy
@@ -1,247 +1,247 @@
 (*
 Title: Aristotle's Assertoric Syllogistic
 Author: Angeliki Koutsoukou-Argyraki, University of Cambridge.
 October 2019
 
 We formalise with Isabelle/HOL some basic elements of Aristotle's assertoric syllogistic following
 the article from the Stanford Encyclopedia of Philosophy by Robin Smith:
 https://plato.stanford.edu/entries/aristotle-logic/.
 To this end, we use a set theoretic formulation (covering both individual and general predication).
 In particular, we formalise the deductions in the Figures and after that we present Aristotle's
 metatheoretical observation that all deductions in the Figures can in fact be reduced to either
 Barbara or Celarent. As the formal proofs prove to be straightforward, the interest of this entry 
 lies in illustrating the functionality of Isabelle and high efficiency of Sledgehammer for simple 
 exercises in philosophy.*)
 
 
 section\<open>Aristotle's Assertoric Syllogistic\<close>
 
 theory AristotlesAssertoric 
   imports Main 
 begin
 
 
 subsection\<open>Aristotelean Categorical Sentences\<close>
 
 text\<open> Aristotle's universal, particular and indefinite predications (affirmations and denials)
 are expressed here using a set theoretic formulation.
 Aristotle handles in the same way individual and general predications i.e. 
 he gives the same logical analysis to "Socrates is an animal" and "humans are animals".
 Here we define the general predication i.e. predications are defined as relations between sets.
 This has the benefit that individual predication can also be expressed as set membership (e.g. see
 the lemma SocratesMortal). \<close>
 
 definition universal_affirmation :: "'a set  \<Rightarrow>'a set  \<Rightarrow> bool"  (infixr "Q" 80)
   where "A Q B \<equiv> \<forall> b \<in> B . b \<in> A " 
 
 definition universal_denial ::  "'a set  \<Rightarrow>'a set   \<Rightarrow> bool"  (infixr "E" 80)
   where "A E B \<equiv> \<forall> b \<in> B. ( b \<notin> A)  "
 
 definition particular_affirmation ::  " 'a set  \<Rightarrow>'a set  \<Rightarrow> bool"  (infixr "I" 80)
   where "A I B \<equiv> \<exists> b \<in> B. ( b \<in> A) "
 
 definition particular_denial ::  "'a set  \<Rightarrow>'a set \<Rightarrow> bool"  (infixr "Z" 80)
   where "A Z B \<equiv> \<exists> b \<in> B. ( b \<notin> A) "
 
 text\<open> The above four definitions are known as the "square of opposition".\<close>
 
 definition indefinite_affirmation ::  " 'a set \<Rightarrow>'a set \<Rightarrow> bool"  (infixr "QI" 80)
   where "A QI B \<equiv>(( \<forall> b \<in> B. (b \<in> A)) \<or>  (\<exists> b \<in> B. (b \<in> A))) "
 
 definition indefinite_denial ::  "'a set  \<Rightarrow>'a set \<Rightarrow> bool"  (infixr "EZ" 80)
   where "A EZ  B \<equiv> (( \<forall> b \<in> B. (b \<notin> A)) \<or> (\<exists> b \<in> B. (b \<notin> A)))  "
 
 lemma aristo_conversion1 : 
   assumes "A E B" shows "B E A"
   using assms universal_denial_def by blast
 
 lemma aristo_conversion2 : 
   assumes "A I B" shows "B I A"
   using assms unfolding  particular_affirmation_def
   by blast
 
 lemma aristo_conversion3 : assumes "A Q B" and "B \<noteq>{} "  shows "B I A"
   using assms 
   unfolding universal_affirmation_def particular_affirmation_def by blast
 
 text\<open>Remark: Aristotle in general supposes that sets have to be nonempty. Indeed, we observe that 
  in many instances it is necessary to assume that the sets are nonempty,
  otherwise Isabelle's automation finds counterexamples.\<close>
 
 subsection\<open>The Deductions in the Figures ("Moods")\<close>
 
 text\<open>The medieval mnemonic names are used.\<close> 
 
 subsubsection\<open>First Figure\<close>
 
 lemma Barbara:
   assumes "A Q B " and "B Q C" shows "A Q C"
 by (meson assms universal_affirmation_def)
 
 lemma Celarent:
   assumes "A E B " and "B Q C" shows "A E C"
 by (meson assms universal_affirmation_def universal_denial_def)
 
 lemma Darii:
   assumes  "A Q B" and "B I C" shows "A I C"
 by (meson assms particular_affirmation_def universal_affirmation_def)
 
 lemma Ferio:
   assumes  "A E B" and "B I C" shows "A Z C"
 by (meson assms particular_affirmation_def particular_denial_def universal_denial_def)
 
 subsubsection\<open>Second Figure\<close>
 
 lemma Cesare:
   assumes  "A E B " and "A Q C" shows "B E C"
 using Celarent aristo_conversion1 assms by blast
 
 lemma Camestres:
   assumes  "A Q B " and "A E C" shows "B E C "
 using Cesare aristo_conversion1 assms by blast
 
 lemma Festino:
   assumes  "A E B " and "A I C" shows "B Z C "
 using Ferio aristo_conversion1 assms by blast
 
 lemma Baroco:
   assumes  "A Q B " and "A Z C" shows "B Z C   "
 by (meson assms particular_denial_def universal_affirmation_def)
 
 
 subsubsection\<open>Third Figure\<close>
 
 lemma Darapti:
   assumes  "A Q C " and "B Q C" and "C \<noteq>{}"   shows "A I B "
   using Darii assms unfolding  universal_affirmation_def particular_affirmation_def
   by blast
 
 lemma Felapton:
   assumes  "A E C" and "B Q C"  and  "C \<noteq>{}"   shows "A Z B"
  using Festino aristo_conversion1 aristo_conversion3 assms by blast
 
 lemma Disamis:
   assumes  "A I C" and "B Q C" shows "A I B"
   using Darii aristo_conversion2 assms by blast
 
 lemma Datisi:
   assumes  "A Q C" and "B I C" shows "A I B"
   using Disamis aristo_conversion2 assms by blast
 
 lemma Bocardo:
   assumes  "A Z C" and "B Q C" shows "A Z B"
  by (meson assms particular_denial_def universal_affirmation_def)
 
 lemma Ferison:  
   assumes  "A E C " and "B I C" shows "A Z B   "
 using Ferio aristo_conversion2 assms by blast
 
 subsubsection\<open>Examples\<close>
 
 text\<open>Example of a deduction with general predication.\<close>
 
 lemma GreekMortal : 
   assumes  "Mortal Q Human" and "Human Q Greek "
   shows " Mortal Q Greek "
 using assms Barbara by auto
 
 text\<open>Example of a deduction with individual predication.\<close>
 
 lemma SocratesMortal:
   assumes "Socrates \<in> Human " and "Mortal Q Human"  
   shows "Socrates \<in> Mortal " 
 using assms by (simp add: universal_affirmation_def)
 
 subsection\<open>Metatheoretical comments\<close>
 
 text\<open>The following are presented to demonstrate one of Aristotle's metatheoretical
 explorations. Namely, Aristotle's metatheorem that:
 "All deductions in all three Figures can eventually be reduced to either Barbara or Celarent"
 is demonstrated by the proofs below and by considering the proofs from the previous subsection. \<close>
 
 lemma Darii_reducedto_Camestres:  
   assumes "A Q B " and "B I C" and "A E C  " (*assms, concl. of Darii  and A E C *)
   shows "A I C"
 proof-
   have "B E C" using Camestres \<open> A Q B   \<close>  \<open>A E C\<close>    by blast
   show ?thesis using \<open> B I C \<close>   \<open>B E C\<close> 
     by (simp add: particular_affirmation_def universal_denial_def)
 qed
 
 text\<open>It is already evident from the proofs in the previous subsection that:
 
 Camestres can be reduced to Cesare.
 
 Cesare can be reduced to Celarent.
 
 Festino can be reduced to Ferio.\<close>
 
 lemma Ferio_reducedto_Cesare:  assumes
   "A E B " and "B I C" and "A Q C  " (*assms, concl. of Ferio  and A Q C *)
 shows "A Z C"
  proof-
   have "B E C" using Cesare \<open>A E B \<close>  \<open>A Q C\<close>  by blast
   show ?thesis using  \<open>B I C \<close>  \<open>B E C\<close>
     by (simp add: particular_affirmation_def universal_denial_def)
 qed
 
 lemma Baroco_reducedto_Barbara :
   assumes "A Q B " and " A Z C  " and " B Q C " 
   shows "B Z C" (*assms , concl. of Baroco and  B Q C *)
 proof-
   have "A Q C" using  \<open>A Q B \<close>  \<open> B Q C \<close> Barbara by blast
   show ?thesis using  \<open>A Q C\<close>  \<open> A Z C \<close>
     by (simp add: particular_denial_def universal_affirmation_def)
 qed
 
 lemma Bocardo_reducedto_Barbara :
   assumes " A Z C" and "B Q C" and "A Q B" 
   shows "A Z B" (*assms, concl of Bocardo and A Q B *)
 proof-
   have "A Q C" using  \<open>B Q C\<close>  \<open> A Q B\<close> using Barbara by blast
   show ?thesis using  \<open>A Q C\<close> \<open> A Z C\<close> 
     by (simp add: particular_denial_def universal_affirmation_def)
 qed
 
 text\<open>Finally, it is already evident from the proofs in the previous subsection that :
 
  Darapti can be reduced to Darii.
 
  Felapton can be reduced to Festino. 
 
  Disamis can be reduced to Darii. 
 
  Datisi can be reduced to Disamis. 
 
  Ferison can be reduced to Ferio. \<close>
 
 text\<open>In conclusion, the aforementioned deductions have thus been shown to be reduced to either 
 Barbara or Celarent as follows:
 
 Baroco  $\Rightarrow$ Barbara 
 
 Bocardo $\Rightarrow$ Barbara 
 
 Felapton $\Rightarrow$ Festino $\Rightarrow$ Ferio $\Rightarrow$ Cesare $\Rightarrow$ Celarent 
 
 Datisi $\Rightarrow$ Disamis $\Rightarrow$ Darii $\Rightarrow$ Camestres $\Rightarrow$ Cesare 
 
 Darapti $\Rightarrow$ Darii 
 
 Ferison $\Rightarrow$ Ferio 
 \<close>
 
 subsection\<open>Acknowledgements\<close>
  
 text\<open>A.K.-A. was supported by the ERC Advanced Grant ALEXANDRIA (Project 742178)
  funded by the European Research Council and led by Professor Lawrence Paulson
  at the University of Cambridge, UK. Thanks to Wenda Li.\<close>
 
 subsection\<open>Bibliography\<close>
-text\<open>Smith, Robin, "Aristotle’s Logic", 
+text\<open>Smith, Robin, "Aristotle's Logic", 
 The Stanford Encyclopedia of Philosophy (Summer 2019 Edition),
 Edward N. Zalta (ed.), URL = @{url "https://plato.stanford.edu/archives/sum2019/entries/aristotle-logic/"}
 \<close>
 
 end
 
diff --git a/thys/Attack_Trees/GDPRhealthcare.thy b/thys/Attack_Trees/GDPRhealthcare.thy
--- a/thys/Attack_Trees/GDPRhealthcare.thy
+++ b/thys/Attack_Trees/GDPRhealthcare.thy
@@ -1,387 +1,387 @@
 section \<open>Application example from IoT healthcare\<close> 
 text \<open>The  example of an IoT healthcare systems is taken from the context of the CHIST-ERA project
 SUCCESS \cite{suc:16}.  In this system architecture, data is collected by sensors 
 in the home or via a smart phone helping to monitor bio markers of the patient. The data 
 collection is in a cloud based server to enable hospitals (or scientific institutions) 
 to access the data which is controlled via the smart phone.
 The identities Patient and Doctor represent patients
 and their doctors; double quotes ''s'' indicate strings 
 in Isabelle/HOL.
 The global policy is `only the patient and the doctor can access the data in the cloud'.\<close>
 theory GDPRhealthcare
 imports Infrastructure
 begin
 text \<open>Local policies are represented as a function over an @{text \<open>igraph G\<close>} 
       that additionally assigns each location of a scenario to its local policy 
       given as a pair of requirements to an actor (first element of the pair) in 
       order to grant him actions in the location (second element of the pair). 
       The predicate @{text \<open>@G\<close>} checks whether an actor is at a given location 
        in the @{text \<open>igraph G\<close>}.\<close>
 locale scenarioGDPR = 
 fixes gdpr_actors :: "identity set"
 defines gdpr_actors_def: "gdpr_actors \<equiv> {''Patient'', ''Doctor''}"
 fixes gdpr_locations :: "location set"
 defines gdpr_locations_def: "gdpr_locations \<equiv> 
           {Location 0, Location 1, Location 2, Location 3}"
 fixes sphone :: "location"
 defines sphone_def: "sphone \<equiv> Location 0"
 fixes home :: "location"
 defines home_def: "home \<equiv> Location 1"
 fixes hospital :: "location"
 defines hospital_def: "hospital \<equiv> Location 2"
 fixes cloud :: "location"
 defines cloud_def: "cloud \<equiv> Location 3"
 fixes global_policy :: "[infrastructure, identity] \<Rightarrow> bool"
 defines global_policy_def: "global_policy I a \<equiv> a \<noteq> ''Doctor'' 
                  \<longrightarrow> \<not>(enables I hospital (Actor a) eval)"
 fixes global_policy' :: "[infrastructure, identity] \<Rightarrow> bool"
 defines global_policy'_def: "global_policy' I a \<equiv> a \<notin> gdpr_actors 
                  \<longrightarrow> \<not>(enables I cloud (Actor a) get)"  
 fixes ex_creds :: "actor \<Rightarrow> (string set * string set)"
 defines ex_creds_def: "ex_creds \<equiv> (\<lambda> x. if x = Actor ''Patient'' then 
                          ({''PIN'',''skey''}, {}) else 
                             (if x = Actor ''Doctor'' then
                                 ({''PIN''},{}) else ({},{})))"
 fixes ex_locs :: "location \<Rightarrow> string * (dlm * data) set"
 defines "ex_locs \<equiv> (\<lambda> x.  if x = cloud then
              (''free'',{((Actor ''Patient'',{Actor ''Doctor''}),42)}) 
              else ('''',{}))"
 fixes ex_loc_ass :: "location \<Rightarrow> identity set"
 defines ex_loc_ass_def: "ex_loc_ass \<equiv>
           (\<lambda> x.  if x = home then {''Patient''}  
                  else (if x = hospital then {''Doctor'', ''Eve''} 
                        else {}))"
 (* The nicer representation with case suffers from
    not so nice presentation in the cases (need to unfold the syntax)  
 fixes ex_loc_ass_alt :: "location \<Rightarrow> identity set"
 defines ex_loc_ass_alt_def: "ex_loc_ass_alt \<equiv>
           (\<lambda> x.  (case x of 
              Location (Suc 0) \<Rightarrow> {''Patient''}  
            | Location (Suc (Suc 0)) \<Rightarrow> {''Doctor'', ''Eve''} 
            |  _ \<Rightarrow> {}))"
 *)
 fixes ex_graph :: "igraph"
 defines ex_graph_def: "ex_graph \<equiv> Lgraph 
      {(home, cloud), (sphone, cloud), (cloud,hospital)}
      ex_loc_ass
      ex_creds ex_locs"
 fixes ex_graph' :: "igraph"
 defines ex_graph'_def: "ex_graph' \<equiv> Lgraph 
      {(home, cloud), (sphone, cloud), (cloud,hospital)}
        (\<lambda> x. if x = cloud then {''Patient''} else 
            (if x = hospital then {''Doctor'',''Eve''} else {})) 
      ex_creds ex_locs"
 fixes ex_graph'' :: "igraph"
 defines ex_graph''_def: "ex_graph'' \<equiv> Lgraph 
      {(home, cloud), (sphone, cloud), (cloud,hospital)}
        (\<lambda> x. if x = cloud then {''Patient'', ''Eve''} else 
            (if x = hospital then {''Doctor''} else {})) 
      ex_creds ex_locs"
 (* Same as above: the nicer representation with case suffers from
    not so nice presentation in the cases (need to unfold the syntax) 
 fixes local_policies_alt :: "[igraph, location] \<Rightarrow> policy set"
 defines local_policies_alt_def: "local_policies_alt G \<equiv> 
     (\<lambda> x. case x of 
          Location (Suc 0) \<Rightarrow> {(\<lambda> y. True, {put,get,move,eval})}
        | Location 0 \<Rightarrow> {((\<lambda> y. has G (y, ''PIN'')), {put,get,move,eval})} 
        | Location (Suc (Suc (Suc 0))) \<Rightarrow> {(\<lambda> y. True, {put,get,move,eval})}
        | Location (Suc (Suc 0)) \<Rightarrow>
                 {((\<lambda> y. (\<exists> n. (n  @\<^bsub>G\<^esub> hospital) \<and> Actor n = y \<and> 
                            has G (y, ''skey''))), {put,get,move,eval})} 
        | _ \<Rightarrow>  {})"
 *)
 fixes local_policies :: "[igraph, location] \<Rightarrow> policy set"
 defines local_policies_def: "local_policies G \<equiv> 
     (\<lambda> x. if x = home then
         {(\<lambda> y. True, {put,get,move,eval})}
           else (if x = sphone then 
              {((\<lambda> y. has G (y, ''PIN'')), {put,get,move,eval})} 
                 else (if x = cloud then
                 {(\<lambda> y. True, {put,get,move,eval})}
                        else (if x = hospital then
                 {((\<lambda> y. (\<exists> n. (n  @\<^bsub>G\<^esub> hospital) \<and> Actor n = y \<and> 
                            has G (y, ''skey''))), {put,get,move,eval})} else {}))))"
 (* problems with case in locales?
 defines local_policies_def: "local_policies G x \<equiv> 
      (case x of 
        home \<Rightarrow> {(\<lambda> y. True, {put,get,move,eval})}
      | sphone \<Rightarrow> {((\<lambda> y. has G (y, ''PIN'')), {put,get,move,eval})} 
      | cloud \<Rightarrow> {(\<lambda> y. True, {put,get,move,eval})}
      | hospital \<Rightarrow> {((\<lambda> y. (\<exists> n. (n  @\<^bsub>G\<^esub> hospital) \<and> Actor n = y \<and> 
                            has G (y, ''skey''))), {put,get,move,eval})} 
      | _ \<Rightarrow>  {})"
 *)
 fixes gdpr_scenario :: "infrastructure"
 defines gdpr_scenario_def:
 "gdpr_scenario \<equiv> Infrastructure ex_graph local_policies"
 fixes Igdpr :: "infrastructure set"
 defines Igdpr_def:
   "Igdpr \<equiv> {gdpr_scenario}"
 (* other states of scenario *)
 (* First step: Patient goes onto cloud *)
 fixes gdpr_scenario' :: "infrastructure"
 defines gdpr_scenario'_def:
 "gdpr_scenario' \<equiv> Infrastructure ex_graph' local_policies"
 fixes GDPR' :: "infrastructure set"
 defines GDPR'_def:
   "GDPR' \<equiv> {gdpr_scenario'}"
 (* Second step: Eve goes onto cloud from where she'll be able to get the data *)
 fixes gdpr_scenario'' :: "infrastructure"
 defines gdpr_scenario''_def:
 "gdpr_scenario'' \<equiv> Infrastructure ex_graph'' local_policies"
 fixes GDPR'' :: "infrastructure set"
 defines GDPR''_def:
   "GDPR'' \<equiv> {gdpr_scenario''}"
 fixes gdpr_states
 defines gdpr_states_def: "gdpr_states \<equiv> { I. gdpr_scenario \<rightarrow>\<^sub>i* I }"
 fixes gdpr_Kripke
 defines "gdpr_Kripke \<equiv> Kripke gdpr_states {gdpr_scenario}"
 fixes sgdpr 
 defines "sgdpr \<equiv> {x. \<not> (global_policy' x ''Eve'')}"  
 begin
 subsection \<open>Using Attack Tree Calculus\<close>
 text \<open>Since we consider a predicate transformer semantics, we use sets of states 
      to represent properties. For example, the attack property is given by the above
      @{text \<open>set sgdpr\<close>}.
 
 The attack we are interested in is to see whether for the scenario
 
 @{text \<open>gdpr scenario \<equiv> Infrastructure ex_graph local_policies\<close>}
 
 from the initial state 
 
 @{text \<open>Igdpr \<equiv>{gdpr scenario}\<close>}, 
 
 the critical state
 @{text \<open>sgdpr\<close>} can be reached, i.e., is there a valid attack @{text \<open>(Igdpr,sgdpr)\<close>}?
 
 We first present a number of lemmas showing single and multi-step state transitions
 for relevant states reachable from our @{text \<open>gdpr_scenario\<close>}.\<close>
 lemma step1: "gdpr_scenario  \<rightarrow>\<^sub>n gdpr_scenario'"
 proof (rule_tac l = home and a = "''Patient''" and l' = cloud in move)
   show "graphI gdpr_scenario = graphI gdpr_scenario" by (rule refl)
 next show "''Patient'' @\<^bsub>graphI gdpr_scenario\<^esub> home" 
     by (simp add: gdpr_scenario_def ex_graph_def ex_loc_ass_def atI_def nodes_def)
 next show "home \<in> nodes (graphI gdpr_scenario)"
     by (simp add: gdpr_scenario_def ex_graph_def ex_loc_ass_def atI_def nodes_def, blast)
 next show "cloud \<in> nodes (graphI gdpr_scenario)"
     by (simp add: gdpr_scenario_def nodes_def ex_graph_def, blast)
 next show "''Patient'' \<in> actors_graph (graphI gdpr_scenario)"
     by (simp add: actors_graph_def gdpr_scenario_def ex_graph_def ex_loc_ass_def nodes_def, blast)
 next show "enables gdpr_scenario cloud (Actor ''Patient'') move"
     by (simp add: enables_def gdpr_scenario_def ex_graph_def local_policies_def
                     ex_creds_def ex_locs_def has_def credentials_def)
 next show "gdpr_scenario' =
     Infrastructure (move_graph_a ''Patient'' home cloud (graphI gdpr_scenario)) (delta gdpr_scenario)"
     apply (simp add: gdpr_scenario'_def ex_graph'_def move_graph_a_def 
                      gdpr_scenario_def ex_graph_def home_def cloud_def hospital_def
                      ex_loc_ass_def ex_creds_def)
     apply (rule ext)
     by (simp add: hospital_def)
 qed
 
 lemma step1r: "gdpr_scenario  \<rightarrow>\<^sub>n* gdpr_scenario'"
 proof (simp add: state_transition_in_refl_def)
   show " (gdpr_scenario, gdpr_scenario') \<in> {(x::infrastructure, y::infrastructure). x \<rightarrow>\<^sub>n y}\<^sup>*"
   by (insert step1, auto)
 qed
 
 lemma step2: "gdpr_scenario'  \<rightarrow>\<^sub>n gdpr_scenario''"
 proof (rule_tac l = hospital and a = "''Eve''" and l' = cloud in move, rule refl)
   show "''Eve'' @\<^bsub>graphI gdpr_scenario'\<^esub> hospital"
    by (simp add: gdpr_scenario'_def ex_graph'_def hospital_def cloud_def atI_def nodes_def)
 next show "hospital \<in> nodes (graphI gdpr_scenario')"
     by (simp add: gdpr_scenario'_def ex_graph'_def hospital_def cloud_def atI_def nodes_def, blast)
 next show "cloud \<in> nodes (graphI gdpr_scenario')"
     by (simp add: gdpr_scenario'_def nodes_def ex_graph'_def, blast)
 next show "''Eve'' \<in> actors_graph (graphI gdpr_scenario')"
     by (simp add: actors_graph_def gdpr_scenario'_def ex_graph'_def nodes_def
                      hospital_def cloud_def, blast)
 next show "enables gdpr_scenario' cloud (Actor ''Eve'') move"
     by (simp add: enables_def gdpr_scenario'_def ex_graph_def local_policies_def
                   ex_creds_def ex_locs_def has_def credentials_def cloud_def sphone_def)
 next show "gdpr_scenario'' =
     Infrastructure (move_graph_a ''Eve'' hospital cloud (graphI gdpr_scenario')) (delta gdpr_scenario')"
     apply (simp add: gdpr_scenario'_def ex_graph''_def move_graph_a_def gdpr_scenario''_def 
                      ex_graph'_def home_def cloud_def hospital_def ex_creds_def)
     apply (rule ext)
     apply (simp add: hospital_def)
     by blast
 qed
 
 lemma step2r: "gdpr_scenario'  \<rightarrow>\<^sub>n* gdpr_scenario''"
 proof (simp add: state_transition_in_refl_def)
   show "(gdpr_scenario', gdpr_scenario'') \<in> {(x::infrastructure, y::infrastructure). x \<rightarrow>\<^sub>n y}\<^sup>*"
     by (insert step2, auto)
 qed
      
 (* Attack example: Eve can get onto cloud and get Patient's data 
    because the policy allows Eve to get on cloud.
    This attack can easily be fixed by disabling Eve to "get"
    in the policy (just change the "True" for cloud to a set with no 
    Eve in it).
    However, it would not prevent Insider attacks (where Eve is 
    impersonating the Doctor, for example). Insider attacks can
    be checked using the UasI predicate.
 *)
 text \<open>For the Kripke structure
 
 @{text \<open>gdpr_Kripke \<equiv> Kripke { I. gdpr_scenario \<rightarrow>\<^sub>i* I } {gdpr_scenario}\<close>}
 
 we first derive a valid and-attack using the attack tree proof calculus.
 
 @{text \<open>"\<turnstile>[\<N>\<^bsub>(Igdpr,GDPR')\<^esub>, \<N>\<^bsub>(GDPR',sgdpr)\<^esub>] \<oplus>\<^sub>\<and>\<^bsup>(Igdpr,sgdpr)\<^esup>\<close>}
 
 The set @{text \<open>GDPR'\<close>} (see above) is an intermediate state where Eve accesses the cloud.\<close>
 
 lemma gdpr_ref: "[\<N>\<^bsub>(Igdpr,sgdpr)\<^esub>] \<oplus>\<^sub>\<and>\<^bsup>(Igdpr,sgdpr)\<^esup> \<sqsubseteq>
                   ([\<N>\<^bsub>(Igdpr,GDPR')\<^esub>, \<N>\<^bsub>(GDPR',sgdpr)\<^esub>] \<oplus>\<^sub>\<and>\<^bsup>(Igdpr,sgdpr)\<^esup>)"  
 proof (rule_tac l = "[]" and l' = "[\<N>\<^bsub>(Igdpr,GDPR')\<^esub>, \<N>\<^bsub>(GDPR',sgdpr)\<^esub>]" and
                   l'' = "[]" and si = Igdpr and si' = Igdpr and 
                   si'' = sgdpr and si''' = sgdpr in refI, simp, rule refl)
   show "([\<N>\<^bsub>(Igdpr, GDPR')\<^esub>, \<N>\<^bsub>(GDPR', sgdpr)\<^esub>] \<oplus>\<^sub>\<and>\<^bsup>(Igdpr, sgdpr)\<^esup>) =
     ([] @ [\<N>\<^bsub>(Igdpr, GDPR')\<^esub>, \<N>\<^bsub>(GDPR', sgdpr)\<^esub>] @ [] \<oplus>\<^sub>\<and>\<^bsup>(Igdpr, sgdpr)\<^esup>)"
   by simp
 qed
 
 lemma att_gdpr: "\<turnstile>([\<N>\<^bsub>(Igdpr,GDPR')\<^esub>, \<N>\<^bsub>(GDPR',sgdpr)\<^esub>] \<oplus>\<^sub>\<and>\<^bsup>(Igdpr,sgdpr)\<^esup>)"
 proof (subst att_and, simp, rule conjI)
   show " \<turnstile>\<N>\<^bsub>(Igdpr, GDPR')\<^esub>"
     apply (simp add: Igdpr_def GDPR'_def att_base)
     using state_transition_infra_def step1 by blast
 next 
   have "\<not> global_policy' gdpr_scenario'' ''Eve''" "gdpr_scenario' \<rightarrow>\<^sub>n gdpr_scenario''"
       using step2
       by (auto simp: global_policy'_def gdpr_scenario''_def gdpr_actors_def 
                       enables_def local_policies_def cloud_def sphone_def intro!: step2)
   then show "\<turnstile>([\<N>\<^bsub>(GDPR', sgdpr)\<^esub>] \<oplus>\<^sub>\<and>\<^bsup>(GDPR', sgdpr)\<^esup>)"
     apply (subst att_and)
     apply (simp add: GDPR'_def sgdpr_def att_base)
     using state_transition_infra_def by blast
 qed
 
 lemma gdpr_abs_att: "\<turnstile>\<^sub>V([\<N>\<^bsub>(Igdpr,sgdpr)\<^esub>] \<oplus>\<^sub>\<and>\<^bsup>(Igdpr,sgdpr)\<^esup>)"
   by (rule ref_valI, rule gdpr_ref, rule att_gdpr)
 
 text \<open>We can then simply apply the Correctness theorem @{text \<open>AT EF\<close>} to immediately 
       prove the following CTL statement.
 
       @{text \<open>gdpr_Kripke \<turnstile> EF sgdpr\<close>}
 
 This application of the meta-theorem of Correctness of attack trees saves us
 proving the CTL formula tediously by exploring the state space.\<close>
 lemma gdpr_att: "gdpr_Kripke \<turnstile> EF {x. \<not>(global_policy' x ''Eve'')}"
 proof -
   have a: " \<turnstile>([\<N>\<^bsub>(Igdpr, GDPR')\<^esub>, \<N>\<^bsub>(GDPR', sgdpr)\<^esub>] \<oplus>\<^sub>\<and>\<^bsup>(Igdpr, sgdpr)\<^esup>)"
     by (rule att_gdpr)
   hence "(Igdpr,sgdpr) = attack ([\<N>\<^bsub>(Igdpr, GDPR')\<^esub>, \<N>\<^bsub>(GDPR', sgdpr)\<^esub>] \<oplus>\<^sub>\<and>\<^bsup>(Igdpr, sgdpr)\<^esup>)"
     by simp
   hence "Kripke {s::infrastructure. \<exists>i::infrastructure\<in>Igdpr. i \<rightarrow>\<^sub>i* s} Igdpr \<turnstile> EF sgdpr"
     using ATV_EF gdpr_abs_att by fastforce 
   thus "gdpr_Kripke \<turnstile> EF {x::infrastructure. \<not> global_policy' x ''Eve''}"
     by (simp add: gdpr_Kripke_def gdpr_states_def Igdpr_def sgdpr_def)
 qed
 
 theorem gdpr_EF: "gdpr_Kripke \<turnstile> EF sgdpr"
   using gdpr_att sgdpr_def by blast 
 
 text \<open>Similarly, vice-versa, the CTL statement proved in @{text \<open>gdpr_EF\<close>}
     can now be directly translated into Attack Trees using the Completeness 
     Theorem\footnote{This theorem could easily 
     be proved as a direct instance of @{text \<open>att_gdpr\<close>} above but we want to illustrate
     an alternative proof method using Completeness here.}.\<close>
 theorem gdpr_AT: "\<exists> A. \<turnstile> A \<and> attack A = (Igdpr,sgdpr)"
 proof -
   have a: "gdpr_Kripke \<turnstile> EF sgdpr " by (rule gdpr_EF)
   have b: "Igdpr \<noteq> {}" by (simp add: Igdpr_def)
   thus "\<exists>A::infrastructure attree. \<turnstile>A \<and> attack A = (Igdpr, sgdpr)" 
   proof (rule Completeness)
     show "Kripke {s. \<exists>i\<in>Igdpr. i \<rightarrow>\<^sub>i* s} Igdpr \<turnstile> EF sgdpr"
       using a by (simp add: gdpr_Kripke_def Igdpr_def gdpr_states_def)
   qed (auto simp: Igdpr_def)
 qed
 
 text \<open>Conversely, since we have an attack given by rule @{text \<open>gdpr_AT\<close>}, we can immediately 
    infer @{text \<open>EF s\<close>} using Correctness @{text \<open>AT_EF\<close>}\footnote{Clearly, this theorem is identical
    to @{text \<open>gdpr_EF\<close>} and could thus be inferred from that one but we want to show here an 
    alternative way of proving it using the Correctness theorem @{text \<open>AT_EF\<close>}.}.\<close>
 theorem gdpr_EF': "gdpr_Kripke \<turnstile> EF sgdpr"
   using gdpr_AT by (auto simp: gdpr_Kripke_def gdpr_states_def Igdpr_def dest: AT_EF)
 
 
 (* However, when integrating DLM into the model and hence labeling
    information becomes part of the conditions of the get_data rule this isn't
    possible any more: gdpr_EF is not true any more *)    
 (** GDPR properties  for the illustration of the DLM labeling **)    
 section \<open>Data Protection by Design for GDPR compliance\<close>
 subsection \<open>General Data Protection Regulation (GDPR)\<close>
 text \<open>Since 26th May 2018, the GDPR has become mandatory within the European Union and hence 
 also for any supplier of IT products. Breaches of the regulation will be fined with penalties 
 of 20 Million EUR. Despite the relatively large size of the document of 209 pages, the technically 
 relevant portion for us is only about 30 pages (Pages 81--111, Chapters I to Chapter III, Section 3). 
 In summary, Chapter III specifies that the controller must give the data subject read access (1) 
-to any information, communications, and “meta-data” of the data, e.g., retention time and purpose. 
+to any information, communications, and ``meta-data'' of the data, e.g., retention time and purpose. 
 In addition, the system must enable deletion of data (2) and restriction of processing.
 An invariant condition for data processing resulting from these Articles is that the system functions 
 must preserve any of the access rights of personal data (3).
 
 Using labeled data, we can now express the essence of Article 4 Paragraph (1): 
-’personal data’ means any information relating to an identified or identifiable natural 
-person (’data subject’).
+`personal data' means any information relating to an identified or identifiable natural 
+person (`data subject').
 
 The labels of data must not be changed by processing: we have identified this  as 
 an invariant (3) resulting from the GDPR above. This invariant is formalized in 
 our Isabelle model by the type definition of functions on labeled data @{text \<open>label_fun\<close>}
 (see Section 4.2) that preserve the data labels.\<close>
 
 subsection \<open>Policy enforcement and privacy preservation\<close>
 text \<open>We can now use the labeled data to encode the privacy constraints of the 
     GDPR in the rules. For example, the get data rule (see Section 4.3) has labelled data 
-    @{text \<open>((Actor a’, as), n)\<close>} and uses the labeling in the precondition to guarantee 
+    @{text \<open>((Actor a', as), n)\<close>} and uses the labeling in the precondition to guarantee 
     that only entitled users can get data.
 
 We can prove that processing preserves ownership as defined in the initial state for all paths 
 globally (AG) within the Kripke structure and in all locations of the graph.\<close>
 (* GDPR three: Processing preserves ownership in any location *)    
 lemma gdpr_three: "h \<in> gdpr_actors \<Longrightarrow> l \<in> gdpr_locations \<Longrightarrow>
          owns (Igraph gdpr_scenario) l (Actor h) d \<Longrightarrow>
          gdpr_Kripke \<turnstile> AG {x. \<forall> l \<in> gdpr_locations. owns (Igraph x) l (Actor h) d }"  
 proof (simp add: gdpr_Kripke_def check_def, rule conjI)
   show "gdpr_scenario \<in> gdpr_states" by (simp add: gdpr_states_def state_transition_refl_def)
 next 
   show "h \<in> gdpr_actors \<Longrightarrow>
     l \<in> gdpr_locations \<Longrightarrow>
     owns (Igraph gdpr_scenario) l (Actor h) d \<Longrightarrow>
     gdpr_scenario \<in> AG {x::infrastructure. \<forall>l\<in>gdpr_locations. owns (Igraph x) l (Actor h) d}"
     apply (simp add: AG_def gfp_def)
     apply (rule_tac x = "{x::infrastructure. \<forall>l\<in>gdpr_locations. owns (Igraph x) l (Actor h) d}" in exI)
     by (auto simp: AX_def gdpr_scenario_def owns_def)
 qed
 
 text \<open>The final application example of Correctness contraposition 
    shows that there is no attack to ownership possible.
 The proved meta-theory for attack trees can be applied to facilitate the proof. 
 The contraposition of the Correctness property grants that if there is no attack on 
 @{text \<open>(I,\<not>f)\<close>}, then @{text \<open>(EF \<not>f)\<close>} does not hold in the Kripke structure. This 
 yields the theorem since the @{text \<open>AG f\<close>} statement corresponds to @{text \<open>\<not>(EF \<not>f)\<close>}.
 \<close>
 theorem no_attack_gdpr_three: 
 "h \<in> gdpr_actors \<Longrightarrow> l \<in> gdpr_locations \<Longrightarrow> 
  owns (Igraph gdpr_scenario) l (Actor h) d \<Longrightarrow>
 attack A = (Igdpr, -{x. \<forall> l \<in> gdpr_locations. owns (Igraph x) l (Actor h) d })
 \<Longrightarrow> \<not> (\<turnstile> A)"
 proof (rule_tac I = Igdpr and 
            s = "-{x::infrastructure. \<forall>l\<in>gdpr_locations. owns (Igraph x) l (Actor h) d}" 
        in contrapos_corr)
   show "h \<in> gdpr_actors \<Longrightarrow>
     l \<in> gdpr_locations \<Longrightarrow>
     owns (Igraph gdpr_scenario) l (Actor h) d \<Longrightarrow>
     attack A = (Igdpr, - {x::infrastructure. \<forall>l\<in>gdpr_locations. owns (Igraph x) l (Actor h) d}) \<Longrightarrow>
     \<not> (Kripke {s::infrastructure. \<exists>i::infrastructure\<in>Igdpr. i \<rightarrow>\<^sub>i* s}
         Igdpr \<turnstile> EF (- {x::infrastructure. \<forall>l\<in>gdpr_locations. owns (Igraph x) l (Actor h) d}))"
     apply (rule AG_imp_notnotEF) 
      apply (simp add: gdpr_Kripke_def Igdpr_def gdpr_states_def)
     using Igdpr_def gdpr_Kripke_def gdpr_states_def gdpr_three by auto
 qed
 end
 end
\ No newline at end of file
diff --git a/thys/Attack_Trees/MC.thy b/thys/Attack_Trees/MC.thy
--- a/thys/Attack_Trees/MC.thy
+++ b/thys/Attack_Trees/MC.thy
@@ -1,467 +1,467 @@
 section "Kripke structures and CTL"
 
 text \<open>We apply Kripke structures and CTL to model state based systems and analyse properties under 
 dynamic state changes. Snapshots of systems are the states on which we define a state transition. 
 Temporal logic is then employed to express security and privacy properties.\<close>
 theory MC
 imports Main
 begin
 
 subsection "Lemmas to support least and greatest fixpoints"
 
 lemma predtrans_empty: 
   assumes "mono (\<tau> :: 'a set \<Rightarrow> 'a set)"
   shows "\<forall> i. (\<tau> ^^ i) ({}) \<subseteq> (\<tau> ^^(i + 1))({})"
   using assms funpow_decreasing le_add1 by blast
 
 lemma ex_card: "finite S \<Longrightarrow> \<exists> n:: nat. card S = n"
 by simp
 
 lemma less_not_le: "\<lbrakk>(x:: nat) < y; y \<le> x\<rbrakk> \<Longrightarrow> False"
 by arith
 
 lemma infchain_outruns_all: 
   assumes "finite (UNIV :: 'a set)" 
     and "\<forall>i :: nat. ((\<tau> :: 'a set \<Rightarrow> 'a set)^^ i) ({}:: 'a set) \<subset> (\<tau> ^^ (i + 1)) {}"
   shows "\<forall>j :: nat. \<exists>i :: nat. j < card ((\<tau> ^^ i) {})"
 proof (rule allI, induct_tac j)
   show "\<exists>i. 0 < card ((\<tau> ^^ i) {})" using assms
     by (metis bot.not_eq_extremum card_gt_0_iff finite_subset subset_UNIV)
 next show "\<And>j n. \<exists>i. n < card ((\<tau> ^^ i) {}) 
              \<Longrightarrow> \<exists>i. Suc n < card ((\<tau> ^^ i) {})"
     proof -
       fix j n
       assume a: "\<exists>i. n < card ((\<tau> ^^ i) {})"
       obtain i where "n < card ((\<tau> ^^ i) {})"
         using a by blast 
       thus "\<exists> i. Suc n < card ((\<tau> ^^ i) {})" using assms
         by (meson finite_subset le_less_trans le_simps(3) psubset_card_mono subset_UNIV)
     qed
   qed
 
 lemma no_infinite_subset_chain: 
    assumes "finite (UNIV :: 'a set)"
     and    "mono (\<tau> :: ('a set \<Rightarrow> 'a set))"
     and    "\<forall>i :: nat. ((\<tau> :: 'a set \<Rightarrow> 'a set) ^^ i) {} \<subset> (\<tau> ^^ (i + (1 :: nat))) ({} :: 'a set)" 
   shows   "False"
 text \<open>Proof idea: since @{term "UNIV"} is finite, we have from @{text \<open>ex_card\<close>} that there is
     an n with @{term "card UNIV = n"}. Now, use @{text \<open>infchain_outruns_all\<close>} to show as 
     contradiction point that
     @{term "\<exists> i :: nat. card UNIV < card ((\<tau> ^^ i) {})"}. 
     Since all sets are subsets of @{term "UNIV"}, we also have 
     @{term "card ((\<tau> ^^ i) {}) \<le> card UNIV"}:
     Contradiction!, i.e. proof of False  \<close>
 proof -
   have a: "\<forall> (j :: nat). (\<exists> (i :: nat). (j :: nat) < card((\<tau> ^^ i)({} :: 'a set)))" using assms
     by (erule_tac \<tau> = \<tau> in infchain_outruns_all)
   hence b: "\<exists> (n :: nat). card(UNIV :: 'a set) = n" using assms
     by (erule_tac S = UNIV in ex_card)
   from this obtain n where c: "card(UNIV :: 'a set) = n" by (erule exE)
   hence   d: "\<exists>i. card UNIV < card ((\<tau> ^^ i) {})" using a
     by (drule_tac x = "card UNIV" in spec)
   from this obtain i where e: "card (UNIV :: 'a set) < card ((\<tau> ^^ i) {})"
     by (erule exE)
   hence f: "(card((\<tau> ^^ i){})) \<le> (card (UNIV :: 'a set))" using assms
     apply (erule_tac A = "((\<tau> ^^ i){})" in Finite_Set.card_mono)
     by (rule subset_UNIV)
   thus "False" using e
     by (erule_tac y = "card((\<tau> ^^ i){})" in less_not_le)
 qed
 
 lemma finite_fixp: 
   assumes "finite(UNIV :: 'a set)" 
       and "mono (\<tau> :: ('a set \<Rightarrow> 'a set))"
     shows "\<exists> i. (\<tau> ^^ i) ({}) = (\<tau> ^^(i + 1))({})"
 text \<open>Proof idea: 
 with @{text predtrans_empty} we know 
 
 @{term "\<forall> i. (\<tau> ^^ i){} \<subseteq> (\<tau> ^^(i + 1))({})"} (1).
 
 If we can additionally show 
 
 @{term "\<exists> i.  (\<tau> ^^ i)({}) \<supseteq> (\<tau> ^^(i + 1))({})"} (2),
 
 we can get the goal together with equalityI 
 @{text "\<subseteq> + \<supseteq> \<longrightarrow> ="}. 
 To prove (1) we observe that 
 @{term "(\<tau> ^^ i)({}) \<supseteq> (\<tau> ^^(i + 1))({})"} 
 can be inferred from 
 @{term "\<not>((\<tau> ^^ i)({}) \<subseteq> (\<tau> ^^(i + 1))({}))"} 
 and (1).
 Finally, the latter is solved directly by @{text \<open>no_infinite_subset_chain\<close>}.\<close>
 proof -
   have a: "\<forall>i. (\<tau> ^^ i) ({}:: 'a set) \<subseteq> (\<tau> ^^ (i + (1))) {}" 
     by(rule predtrans_empty, rule assms(2))
   have a3: "\<not> (\<forall> i :: nat. (\<tau> ^^ i) {} \<subset> (\<tau> ^^(i + 1)) {})" 
     by (rule notI, rule no_infinite_subset_chain, (rule assms)+)
   hence b: "(\<exists> i :: nat. \<not>((\<tau> ^^ i) {} \<subset> (\<tau> ^^(i + 1)) {}))" using assms a3
     by blast
   thus "\<exists> i. (\<tau> ^^ i) ({}) = (\<tau> ^^(i + 1))({})" using a
     by blast
 qed
 
 lemma predtrans_UNIV: 
   assumes "mono (\<tau> :: ('a set \<Rightarrow> 'a set))"
   shows "\<forall> i. (\<tau> ^^ i) (UNIV) \<supseteq> (\<tau> ^^(i + 1))(UNIV)"
 proof (rule allI, induct_tac i)
   show "(\<tau> ^^ ((0) + (1))) UNIV \<subseteq> (\<tau> ^^ (0)) UNIV" 
     by simp
 next show "\<And>(i) n.
        (\<tau> ^^ (n + (1))) UNIV \<subseteq> (\<tau> ^^ n) UNIV \<Longrightarrow> (\<tau> ^^ (Suc n + (1))) UNIV \<subseteq> (\<tau> ^^ Suc n) UNIV"
   proof -
     fix i n
     assume a: "(\<tau> ^^ (n + (1))) UNIV \<subseteq> (\<tau> ^^ n) UNIV"
     have "(\<tau> ((\<tau> ^^ n) UNIV)) \<supseteq> (\<tau> ((\<tau> ^^ (n + (1 :: nat))) UNIV))" using assms a
       by (rule monoE)
     thus "(\<tau> ^^ (Suc n + (1))) UNIV \<subseteq> (\<tau> ^^ Suc n) UNIV" by simp
    qed
  qed
 
 lemma Suc_less_le: "x < (y - n) \<Longrightarrow> x \<le> (y - (Suc n))"
  by simp
 
 lemma card_univ_subtract: 
   assumes "finite (UNIV :: 'a set)" and  "mono \<tau>"
      and  "(\<forall>i :: nat. ((\<tau> :: 'a set \<Rightarrow> 'a set) ^^ (i + (1 :: nat)))(UNIV :: 'a set) \<subset> (\<tau> ^^ i) UNIV)"
    shows "(\<forall> i :: nat. card((\<tau> ^^ i) (UNIV ::'a set)) \<le> (card (UNIV :: 'a set)) - i)"
 proof (rule allI, induct_tac i) 
   show "card ((\<tau> ^^ (0)) UNIV) \<le> card (UNIV :: 'a set) - (0)" using assms
     by (simp)
 next show "\<And>(i) n.
        card ((\<tau> ^^ n) (UNIV :: 'a set)) \<le> card (UNIV :: 'a set) - n \<Longrightarrow>
        card ((\<tau> ^^ Suc n) (UNIV :: 'a set)) \<le> card (UNIV :: 'a set) - Suc n" using assms
   proof -
     fix i n
     assume a: "card ((\<tau> ^^ n) (UNIV :: 'a set)) \<le> card (UNIV :: 'a set) - n"
     have b: "(\<tau> ^^ (n + (1)))(UNIV :: 'a set) \<subset> (\<tau> ^^ n) UNIV" using assms
       by (erule_tac x = n in spec)
     have "card((\<tau> ^^ (n + (1 :: nat)))(UNIV :: 'a set)) < card((\<tau> ^^ n) (UNIV :: 'a set))"       
       by (rule psubset_card_mono, rule finite_subset, rule subset_UNIV, rule assms(1), rule b)
     thus "card ((\<tau> ^^ Suc n) (UNIV :: 'a set)) \<le> card (UNIV :: 'a set) - Suc n" using a
       by simp
     qed
   qed
 
 lemma card_UNIV_tau_i_below_zero: 
   assumes "finite (UNIV :: 'a set)" and "mono \<tau>"
    and  "(\<forall>i :: nat. ((\<tau> :: ('a set \<Rightarrow> 'a set)) ^^ (i + (1 :: nat)))(UNIV :: 'a set) \<subset> (\<tau> ^^ i) UNIV)"
  shows "card((\<tau> ^^ (card (UNIV ::'a set))) (UNIV ::'a set)) \<le> 0"
 proof -
   have "(\<forall> i :: nat. card((\<tau> ^^ i) (UNIV ::'a set)) \<le> (card (UNIV :: 'a set)) - i)" using assms
     by (rule card_univ_subtract)
   thus "card((\<tau> ^^ (card (UNIV ::'a set))) (UNIV ::'a set)) \<le> 0"
    by (drule_tac x = "card (UNIV ::'a set)" in spec, simp)
 qed
 
 lemma finite_card_zero_empty: "\<lbrakk> finite S; card S \<le> 0\<rbrakk> \<Longrightarrow> S = {}"
 by simp
 
 lemma UNIV_tau_i_is_empty:
   assumes "finite (UNIV :: 'a set)" and "mono (\<tau> :: ('a set \<Rightarrow> 'a set))"
     and   "(\<forall>i :: nat. ((\<tau> :: 'a set \<Rightarrow> 'a set) ^^ (i + (1 :: nat)))(UNIV :: 'a set) \<subset> (\<tau> ^^ i) UNIV)"
   shows "(\<tau> ^^ (card (UNIV ::'a set))) (UNIV ::'a set) = {}"
   by (meson assms card_UNIV_tau_i_below_zero finite_card_zero_empty finite_subset subset_UNIV)
 
 lemma down_chain_reaches_empty:
   assumes "finite (UNIV :: 'a set)" and "mono (\<tau> :: 'a set \<Rightarrow> 'a set)"
    and "(\<forall>i :: nat. ((\<tau> :: 'a set \<Rightarrow> 'a set) ^^ (i + (1 :: nat))) UNIV \<subset> (\<tau> ^^ i) UNIV)"
  shows "\<exists> (j :: nat). (\<tau> ^^ j) UNIV = {}"
   using UNIV_tau_i_is_empty assms by blast
 
 lemma no_infinite_subset_chain2: 
   assumes "finite (UNIV :: 'a set)" and "mono (\<tau> :: ('a set \<Rightarrow> 'a set))"
       and "\<forall>i :: nat. (\<tau> ^^ i) UNIV \<supset> (\<tau> ^^ (i + (1 :: nat))) UNIV"
   shows "False"
 proof -
   have "\<exists> j :: nat. (\<tau> ^^ j) UNIV = {}" using assms
     by (rule down_chain_reaches_empty)
   from this obtain j where a: "(\<tau> ^^ j) UNIV = {}" by (erule exE)
   have "(\<tau> ^^ (j + (1))) UNIV \<subset> (\<tau> ^^ j) UNIV" using assms
     by (erule_tac x = j in spec)
   thus False using a by simp 
 qed
 
 lemma finite_fixp2: 
   assumes "finite(UNIV :: 'a set)" and "mono (\<tau> :: ('a set \<Rightarrow> 'a set))"
   shows "\<exists> i. (\<tau> ^^ i) UNIV = (\<tau> ^^(i + 1)) UNIV"
 proof -
   have "\<forall>i. (\<tau> ^^ (i + (1))) UNIV \<subseteq> (\<tau> ^^ i) UNIV" 
     by (rule predtrans_UNIV , simp add: assms(2))  
   moreover have "\<exists>i. \<not> (\<tau> ^^ (i + (1))) UNIV \<subset> (\<tau> ^^ i) UNIV" using assms
   proof -
     have "\<not> (\<forall> i :: nat. (\<tau> ^^ i) UNIV \<supset> (\<tau> ^^(i + 1)) UNIV)"
       using assms(1) assms(2) no_infinite_subset_chain2 by blast 
     thus "\<exists>i. \<not> (\<tau> ^^ (i + (1))) UNIV \<subset> (\<tau> ^^ i) UNIV" by blast
   qed
   ultimately show "\<exists> i. (\<tau> ^^ i) UNIV = (\<tau> ^^(i + 1)) UNIV" 
     by blast
 qed
 
 lemma lfp_loop: 
   assumes "finite (UNIV :: 'b set)" and "mono (\<tau> :: ('b set \<Rightarrow> 'b set))"
   shows "\<exists> n . lfp \<tau>  = (\<tau> ^^ n) {}"
 proof -
   have "\<exists>i. (\<tau> ^^ i) {} = (\<tau> ^^ (i + (1))) {}"  using assms
     by (rule finite_fixp)
   from this obtain i where " (\<tau> ^^ i) {} = (\<tau> ^^ (i + (1))) {}"
     by (erule exE)
   hence "(\<tau> ^^ i) {} = (\<tau> ^^ Suc i) {}"
     by simp
   hence "(\<tau> ^^ Suc i) {} = (\<tau> ^^ i) {}"
     by (rule sym)
   hence "lfp \<tau> = (\<tau> ^^ i) {}"
      by (simp add: assms(2) lfp_Kleene_iter)
    thus "\<exists> n . lfp \<tau>  = (\<tau> ^^ n) {}" 
    by (rule exI) 
 qed
 
 text \<open>These next two are repeated from the corresponding
    theorems in HOL/ZF/Nat.thy for the sake of self-containedness of the exposition.\<close>
 lemma Kleene_iter_gpfp:
   assumes "mono f" and "p \<le> f p" shows "p \<le> (f^^k) (top::'a::order_top)"
 proof(induction k)
   case 0 show ?case by simp
 next
   case Suc
   from monoD[OF assms(1) Suc] assms(2)
   show ?case by simp
 qed
 
 lemma gfp_loop: 
   assumes "finite (UNIV :: 'b set)"
    and "mono (\<tau> :: ('b set \<Rightarrow> 'b set))"
     shows "\<exists> n . gfp \<tau>  = (\<tau> ^^ n)UNIV"
 proof -
   have " \<exists>i. (\<tau> ^^ i)(UNIV :: 'b set) = (\<tau> ^^ (i + (1))) UNIV" using assms
     by (rule finite_fixp2)
   from this obtain i where "(\<tau> ^^ i)UNIV = (\<tau> ^^ (i + (1))) UNIV" by (erule exE)
   thus "\<exists> n . gfp \<tau>  = (\<tau> ^^ n)UNIV" using assms
     by (metis Suc_eq_plus1 gfp_Kleene_iter)
 qed
 
 subsection \<open>Generic type of state with state transition and CTL operators\<close>
 text \<open>The system states and their transition relation are defined as a class called
  @{text \<open>state\<close>} containing an abstract constant@{text \<open>state_transition\<close>}. It introduces the 
-syntactic infix notation @{text \<open>I \<rightarrow>\<^sub>i I'\<close>} to denote that system state @{text \<open>I\<close>} and @{text \<open>I’\<close>} 
+syntactic infix notation @{text \<open>I \<rightarrow>\<^sub>i I'\<close>} to denote that system state @{text \<open>I\<close>} and @{text \<open>I'\<close>} 
 are in this relation over an arbitrary (polymorphic) type @{text \<open>'a\<close>}.\<close>
 class state =
   fixes state_transition :: "['a :: type, 'a] \<Rightarrow> bool"  (infixr "\<rightarrow>\<^sub>i" 50)
 
 text \<open>The above class definition lifts Kripke structures and CTL to a general level. 
 The definition of the inductive relation is given by a set of specific rules which are, 
 however, part of an application like infrastructures. Branching time temporal logic CTL 
 is defined in general over Kripke structures with arbitrary state transitions and can later 
 be applied to suitable theories, like infrastructures.
 Based on the generic state transition @{text \<open>\<rightarrow>\<close>} of the type class state, the CTL-operators 
 EX and AX express that property f holds in some or all next states, respectively.\<close> 
     
 definition AX where "AX f \<equiv> {s. {f0. s \<rightarrow>\<^sub>i f0} \<subseteq> f}"
 definition EX' where "EX' f \<equiv> {s . \<exists> f0 \<in> f. s \<rightarrow>\<^sub>i f0 }"
 
 text \<open>The CTL formula @{text \<open>AG f\<close>} means that on all paths branching from a state @{text \<open>s\<close>} 
-the formula @{text \<open>f\<close>} is always true (@{text \<open>G\<close>} stands for ‘globally’). It can be defined 
+the formula @{text \<open>f\<close>} is always true (@{text \<open>G\<close>} stands for `globally'). It can be defined 
 using the Tarski fixpoint theory by applying the greatest fixpoint operator. In a similar way, 
 the other CTL operators are defined.\<close>
 definition AF where "AF f \<equiv> lfp (\<lambda> Z. f \<union> AX Z)"
 definition EF where "EF f \<equiv> lfp (\<lambda> Z. f \<union> EX' Z)"
 definition AG where "AG f \<equiv> gfp (\<lambda> Z. f \<inter> AX Z)"
 definition EG where "EG f \<equiv> gfp (\<lambda> Z. f \<inter> EX' Z)"
 definition AU where "AU f1 f2 \<equiv> lfp(\<lambda> Z. f2 \<union> (f1 \<inter> AX Z))"
 definition EU where "EU f1 f2 \<equiv> lfp(\<lambda> Z. f2 \<union> (f1 \<inter> EX' Z))"
 definition AR where "AR f1 f2 \<equiv> gfp(\<lambda> Z. f2 \<inter> (f1 \<union> AX Z))"
 definition ER where "ER f1 f2 \<equiv> gfp(\<lambda> Z. f2 \<inter> (f1 \<union> EX' Z))"
 
 subsection  \<open>Kripke structures and Modelchecking\<close>
 datatype 'a kripke = 
   Kripke "'a set" "'a set"
 
 primrec states where "states (Kripke S I) = S" 
 primrec init where "init (Kripke S I) = I" 
 
 text \<open>The formal Isabelle definition of what it means that formula f holds 
 in a Kripke structure M can be stated as: the initial states of the Kripke 
 structure init M need to be contained in the set of all states states M that 
 imply f.\<close>
 definition check ("_ \<turnstile> _" 50)
  where "M \<turnstile> f \<equiv> (init M) \<subseteq> {s \<in> (states M). s \<in> f }"
 
 definition state_transition_refl (infixr "\<rightarrow>\<^sub>i*" 50)
 where "s \<rightarrow>\<^sub>i* s' \<equiv> ((s,s') \<in> {(x,y). state_transition x y}\<^sup>*)"
   
 subsection \<open>Lemmas for CTL operators\<close>
 
 subsubsection \<open>EF lemmas\<close>
 lemma EF_lem0: "(x \<in> EF f) = (x \<in> f \<union> EX' (lfp (\<lambda>Z :: ('a :: state) set. f \<union> EX' Z)))"
 proof -
   have "lfp (\<lambda>Z :: ('a :: state) set. f \<union> EX' Z) = 
                     f \<union> (EX' (lfp (\<lambda>Z :: 'a set. f \<union> EX' Z)))"
     by (rule def_lfp_unfold, rule reflexive, unfold mono_def EX'_def, auto)
   thus "(x \<in> EF (f :: ('a :: state) set)) = (x \<in> f \<union> EX' (lfp (\<lambda>Z :: ('a :: state) set. f \<union> EX' Z)))"
     by (simp add: EF_def) 
 qed
 
 lemma EF_lem00: "(EF f) = (f \<union> EX' (lfp (\<lambda> Z :: ('a :: state) set. f \<union> EX' Z)))"
   by (auto simp: EF_lem0)
 
 lemma EF_lem000: "(EF f) = (f \<union> EX' (EF f))"
   by (metis EF_def EF_lem00)
 
 lemma EF_lem1: "x \<in> f \<or> x \<in> (EX' (EF f)) \<Longrightarrow> x \<in> EF f"
 proof (simp add: EF_def)
   assume a: "x \<in> f \<or> x \<in> EX' (lfp (\<lambda>Z::'a set. f \<union> EX' Z))"
   show "x \<in> lfp (\<lambda>Z::'a set. f \<union> EX' Z)"
   proof -
     have b: "lfp (\<lambda>Z :: ('a :: state) set. f \<union> EX' Z) =
                     f \<union> (EX' (lfp (\<lambda>Z :: ('a :: state) set. f \<union> EX' Z)))"
       using EF_def EF_lem00 by blast
     thus "x \<in> lfp (\<lambda>Z::'a set. f \<union> EX' Z)" using a
       by (subst b, blast)
   qed   
 qed
 
 lemma EF_lem2b: 
   assumes "x \<in> (EX' (EF f))"
   shows "x \<in> EF f"
   by (simp add: EF_lem1 assms)
 
 lemma EF_lem2a: assumes "x \<in> f" shows "x \<in> EF f"
   by (simp add: EF_lem1 assms)
 
 lemma EF_lem2c: assumes "x \<notin> f" shows "x \<in> EF (- f)"
   by (simp add: EF_lem1 assms)
 
 lemma EF_lem2d: assumes "x \<notin> EF f" shows "x \<notin> f"
   using EF_lem1 assms by auto
 
 lemma EF_lem3b: assumes "x \<in> EX' (f \<union> EX' (EF f))" shows "x \<in> (EF f)"
   by (metis EF_lem000 EF_lem2b assms)
 
 lemma EX_lem0l: "x \<in> (EX' f) \<Longrightarrow> x \<in> (EX' (f \<union> g))"
   by (auto simp: EX'_def)
 
 lemma EX_lem0r: "x \<in> (EX' g) \<Longrightarrow> x \<in> (EX' (f \<union> g))"
   by (auto simp: EX'_def)
 
 lemma EX_step: assumes "x  \<rightarrow>\<^sub>i y" and "y \<in> f" shows "x \<in> EX' f"
   using assms by (auto simp: EX'_def)
 
 lemma EF_E[rule_format]: "\<forall> f. x \<in> (EF f) \<longrightarrow> x \<in> (f \<union> EX' (EF f))"
   using EF_lem000 by blast
 
 lemma EF_step: assumes "x  \<rightarrow>\<^sub>i y" and "y \<in> f" shows "x \<in> EF f"
   using EF_lem3b EX_step assms by blast
 
 lemma EF_step_step: assumes "x  \<rightarrow>\<^sub>i y" and "y \<in> EF f" shows  "x \<in> EF f"
   using EF_lem2b EX_step assms by blast
 
 lemma EF_step_star: "\<lbrakk> x  \<rightarrow>\<^sub>i* y; y \<in> f \<rbrakk> \<Longrightarrow> x \<in> EF f"
 proof (simp add: state_transition_refl_def)
   show "(x, y) \<in> {(x::'a, y::'a). x \<rightarrow>\<^sub>i y}\<^sup>* \<Longrightarrow> y \<in> f \<Longrightarrow> x \<in> EF f"
   proof (erule converse_rtrancl_induct)
     show "y \<in> f \<Longrightarrow> y \<in> EF f" 
       by (erule EF_lem2a)
     next show "\<And>ya z::'a. y \<in> f \<Longrightarrow>
                  (ya, z) \<in> {(x,y). x \<rightarrow>\<^sub>i y} \<Longrightarrow>
                  (z, y) \<in> {(x,y). x \<rightarrow>\<^sub>i y}\<^sup>* \<Longrightarrow> z \<in> EF f \<Longrightarrow> ya \<in> EF f"
         by (simp add: EF_step_step)
     qed
   qed
 
 lemma EF_induct: "(a::'a::state) \<in> EF f \<Longrightarrow>
     mono (\<lambda> Z. f \<union> EX' Z) \<Longrightarrow>
     (\<And>x. x \<in> ((\<lambda> Z. f \<union> EX' Z)(EF f \<inter> {x::'a::state. P x})) \<Longrightarrow> P x) \<Longrightarrow>
     P a"
   by (metis (mono_tags, lifting) EF_def def_lfp_induct_set)
 
 lemma valEF_E: "M \<turnstile> EF f \<Longrightarrow> x \<in> init M \<Longrightarrow> x \<in> EF f"
   by (auto simp: check_def)
 
 lemma EF_step_star_rev[rule_format]: "x \<in> EF s \<Longrightarrow>  (\<exists> y \<in> s.  x  \<rightarrow>\<^sub>i* y)"
 proof (erule EF_induct)
   show "mono (\<lambda>Z::'a set. s \<union> EX' Z)"
     by (force simp add: mono_def EX'_def)
 next show "\<And>x::'a. x \<in> s \<union> EX' (EF s \<inter> {x::'a. \<exists>y::'a\<in>s. x \<rightarrow>\<^sub>i* y}) \<Longrightarrow> \<exists>y::'a\<in>s. x \<rightarrow>\<^sub>i* y"
     apply (erule UnE)
     using state_transition_refl_def apply auto[1]
     by (auto simp add: EX'_def state_transition_refl_def intro: converse_rtrancl_into_rtrancl)
 qed
 
 lemma EF_step_inv: "(I \<subseteq> {sa::'s :: state. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> EF s})  
          \<Longrightarrow> \<forall> x \<in> I. \<exists> y \<in> s. x \<rightarrow>\<^sub>i* y"
   using EF_step_star_rev by fastforce
   
 subsubsection \<open>AG lemmas\<close> 
 
 lemma AG_in_lem:   "x \<in> AG s \<Longrightarrow> x \<in> s"  
   by (auto simp add: AG_def gfp_def)
 
 lemma AG_lem1: "x \<in> s \<and> x \<in> (AX (AG s)) \<Longrightarrow> x \<in> AG s"
 proof (simp add: AG_def)
   have "gfp (\<lambda>Z::'a set. s \<inter> AX Z) = s \<inter> (AX (gfp (\<lambda>Z::'a set. s \<inter> AX Z)))"
     by (rule def_gfp_unfold) (auto simp: mono_def AX_def)
   then show "x \<in> s \<and> x \<in> AX (gfp (\<lambda>Z::'a set. s \<inter> AX Z)) \<Longrightarrow> x \<in> gfp (\<lambda>Z::'a set. s \<inter> AX Z)"
     by blast
 qed
 
 lemma AG_lem2: "x \<in> AG s \<Longrightarrow> x \<in> (s \<inter> (AX (AG s)))"
 proof -
   have a: "AG s = s \<inter> (AX (AG s))"
     unfolding AG_def
     by (rule def_gfp_unfold) (auto simp: mono_def AX_def)
   thus "x \<in> AG s \<Longrightarrow> x \<in> (s \<inter> (AX (AG s)))"
    by (erule subst)
 qed
 
 lemma AG_lem3: "AG s = (s \<inter> (AX (AG s)))"    
   using AG_lem1 AG_lem2 by blast
 
 lemma AG_step: "y \<rightarrow>\<^sub>i z \<Longrightarrow> y \<in> AG s \<Longrightarrow> z \<in> AG s"
   using AG_lem2 AX_def by blast  
 
 lemma AG_all_s: " x \<rightarrow>\<^sub>i* y \<Longrightarrow> x \<in> AG s \<Longrightarrow> y \<in> AG s"
 proof (simp add: state_transition_refl_def)
   show "(x, y) \<in> {(x,y). x \<rightarrow>\<^sub>i y}\<^sup>* \<Longrightarrow> x \<in> AG s \<Longrightarrow> y \<in> AG s" 
     by (erule rtrancl_induct) (auto simp add: AG_step)
 qed
 
 lemma AG_imp_notnotEF: 
 "I \<noteq> {} \<Longrightarrow> ((Kripke {s. \<exists> i \<in> I. (i \<rightarrow>\<^sub>i* s)} I  \<turnstile> AG s)) \<Longrightarrow> 
  (\<not>(Kripke {s. \<exists> i \<in> I. (i \<rightarrow>\<^sub>i* s)} (I :: ('s :: state)set)  \<turnstile> EF (- s)))"
 proof (rule notI, simp add: check_def)
   assume a0: "I \<noteq> {}" and
     a1: "I \<subseteq> {sa::'s. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> AG s}" and
     a2: "I \<subseteq> {sa::'s. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> EF (- s)}" 
   show "False"
   proof - 
     have a3: "{sa::'s. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> AG s} \<inter>
                         {sa::'s. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> EF (- s)} = {}"
       proof -
         have "(? x. x \<in> {sa::'s. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> AG s} \<and>
                            x \<in> {sa::'s. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> EF (- s)}) \<Longrightarrow> False"
         proof -
           assume a4: "(? x. x \<in> {sa::'s. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> AG s} \<and>
                            x \<in> {sa::'s. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> EF (- s)})"          
             from a4 obtain x where  a5: "x \<in> {sa::'s. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> AG s} \<and>
                                    x \<in> {sa::'s. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> EF (- s)}"
             by (erule exE) 
             thus "False"
               by (metis (mono_tags, lifting) AG_all_s AG_in_lem ComplD EF_step_star_rev a5 mem_Collect_eq)
           qed
         thus "{sa::'s. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> AG s} \<inter>
                         {sa::'s. (\<exists>i\<in>I. i \<rightarrow>\<^sub>i* sa) \<and> sa \<in> EF (- s)} = {}"
         by blast
       qed
     moreover have b: "? x. x : I" using a0
       by blast
     moreover obtain x where "x \<in> I"
       using b by blast 
     ultimately show "False" using a0 a1 a2
       by blast
   qed
 qed
 
 text \<open>A simplified way of Modelchecking is given by the following lemma.\<close>
 lemma check2_def: "(Kripke S I \<turnstile> f) = (I \<subseteq> S \<inter> f)" 
   by (auto simp add: check_def)
     
 end
\ No newline at end of file
diff --git a/thys/Belief_Revision/AGM_Logic.thy b/thys/Belief_Revision/AGM_Logic.thy
--- a/thys/Belief_Revision/AGM_Logic.thy
+++ b/thys/Belief_Revision/AGM_Logic.thy
@@ -1,480 +1,480 @@
 (*<*)
 \<comment>\<open> ******************************************************************** 
  * Project         : AGM Theory
  * Version         : 1.0
  *
  * Authors         : Valentin Fouillard, Safouan Taha, Frederic Boulanger
                      and Nicolas Sabouret
  *
  * This file       : AGM logics
  *
  * Copyright (c) 2021 Université Paris Saclay, France
  *
  ******************************************************************************\<close>
 
 theory AGM_Logic
 
 imports Main
 
 begin
 (*>*)
 
 section \<open>Introduction\<close>
 
 text\<open>
 The 1985 paper by Carlos Alchourrón, Peter Gärdenfors,
-and David Makinson (AGM), “On the Logic of Theory Change: Partial Meet
-Contraction and Revision Functions” @{cite "alchourron1985logic"} launches a large and
+and David Makinson (AGM), ``On the Logic of Theory Change: Partial Meet
+Contraction and Revision Functions'' @{cite "alchourron1985logic"} launches a large and
 rapidly growing literature that employs formal models and logics to handle changing beliefs of a rational agent
 and to take into account new piece of information observed by this agent. 
 In 2011, a review book titled "AGM 25 Years: Twenty-Five Years of Research in Belief Change"
 was edited to summarize the first twenty five years of works based on AGM 
 @{cite "Ferme2011"}.
 
 According to Google Scholar, the original AGM paper was cited 4000 times! 
 This AFP entry is HOL-based and it is a faithful formalization of the logic operators (e.g. contraction, revision, remainder \dots )
 axiomatized in the AGM paper. It also contains the proofs of all the theorems stated in the paper that show how these operators combine.
 Both proofs of Harper and Levi identities are established.
 \<close>
 
 text\<open>A belief state can be considered as a consistent set of beliefs (logical propositions) closed under logical reasoning.
 Belief changes represent the operations that apply on a belief state to remove some of it and/or to add new beliefs (propositions). 
 In the latter case, it is possible that other beliefs are affected by these changes (to preserve consistency for example). 
 AGM define several postulates to guarantee that such operations preserve consistency meaning that the agent keeps rational. 
 Three kinds of operators are defined :
 \<^item> The contraction @{text \<open>\<div>\<close>} : where a proposition is removed from a belief set
 \<^item> The expansion @{text \<open>\<oplus>\<close>} : where a proposition is added to a belief set
 \<^item> The revision @{text \<open>\<^bold>*\<close>} : where a proposition is added to a belief set such that the belief set remains consistent
 \<close>
 
 text\<open>In this AFP entry, there are three theory files: 
 \<^enum> The AGM Logic file contains a classification of logics used in the AGM framework.
 \<^enum> The AGM Remainder defines a important operator used in the AGM framework.
 \<^enum> The AGM Contraction file contains the postulates of the AGM contraction and its relation with the meet contraction.
 \<^enum> The AGM Revision file contains the postulates of the AGM revision and its relation with the meet revision.  
 \<close>
 
 section \<open>Logics\<close>
 
 text\<open>The AGM framework depends on the underlying logic used to express beliefs. AGM requires at least a Tarskian propositional calculus. 
 If this logic is also supra-classical and/or compact, new properties are established and the main theorems of AGM are strengthened. 
 To model AGM it is therefore important to start by formalizing this underlying logic and its various extensions. 
 We opted for a deep embedding in HOL which required the redefinition of all the logical operators and an axiomatization of their rules. 
 This is certainly not efficient in terms of proof but it gives a total control of our formalization and an assurance 
 that the logic used has no hidden properties depending on the Isabelle/HOL implementation. 
 We use the Isabelle \<^emph>\<open>locales\<close> feature and we take advantage of the inheritance/extension mechanisms between locales.\<close>
 
 
 subsection \<open>Tarskian Logic\<close>
 
 text \<open>
 The first locale formalizes a Tarskian logic based on the famous Tarski's consequence operator: @{term \<open>Cn(A)\<close>} 
 which gives the set of all propositions (\<^bold>\<open>closure\<close>) that can be inferred from the set of propositions @{term \<open>A\<close>}, 
 Exactly as it is classically axiomatized in the literature, three assumptions of the locale define the consequence operator.
 \<close>
 locale Tarskian_logic =
 fixes Cn::\<open>'a set \<Rightarrow> 'a set\<close>
 assumes monotonicity_L:     \<open>A \<subseteq> B \<Longrightarrow> Cn(A) \<subseteq> Cn(B)\<close>
     and inclusion_L:        \<open>A \<subseteq> Cn(A)\<close> 
     and transitivity_L:     \<open>Cn(Cn(A)) \<subseteq> Cn(A)\<close>
 
 \<comment> \<open>
   Short notation for ``@{term \<open>\<phi>\<close>} can be inferred from the propositions in @{term \<open>A\<close>}''.
 \<close>
 fixes infer::\<open>'a set \<Rightarrow> 'a \<Rightarrow> bool\<close>  (infix \<open>\<turnstile>\<close> 50)
 defines \<open>A \<turnstile> \<phi> \<equiv> \<phi> \<in> Cn(A)\<close>
 
 \<comment> \<open>
   @{term \<open>\<phi>\<close>} is valid (a tautology) if it can be inferred from nothing.
 \<close>
 fixes valid::\<open>'a \<Rightarrow> bool\<close>            (\<open>\<tturnstile>\<close>)
 defines \<open>\<tturnstile> \<phi> \<equiv> {} \<turnstile> \<phi>\<close>
 
 \<comment> \<open>
   @{term \<open>A \<oplus> \<phi>\<close>} is all that can be infered from  @{term \<open>A\<close>} and  @{term \<open>\<phi>\<close>}.
 \<close>
 fixes expansion::\<open>'a set \<Rightarrow> 'a \<Rightarrow> 'a set\<close> (infix \<open>\<oplus>\<close> 57)
 defines \<open>A \<oplus> \<phi> \<equiv> Cn(A \<union> {\<phi>})\<close>
 
 begin 
 
 lemma idempotency_L: \<open>Cn(Cn(A)) = Cn(A)\<close>
   by (simp add: inclusion_L transitivity_L subset_antisym)
 
 lemma assumption_L: \<open>\<phi> \<in> A \<Longrightarrow> A \<turnstile> \<phi>\<close>
   using inclusion_L infer_def by blast 
 
 lemma validD_L: \<open>\<tturnstile> \<phi> \<Longrightarrow> \<phi> \<in> Cn(A)\<close>
   using monotonicity_L valid_def infer_def by fastforce
 
 lemma valid_expansion: \<open>K = Cn(A) \<Longrightarrow> \<tturnstile> \<phi> \<Longrightarrow> K \<oplus> \<phi> = K\<close>
   by (simp add: idempotency_L insert_absorb validD_L valid_def expansion_def)
 
 lemma transitivity2_L:
   assumes \<open>\<forall>\<phi> \<in> B. A \<turnstile> \<phi>\<close>
       and \<open>B \<turnstile> \<psi>\<close>
     shows \<open>A \<turnstile> \<psi>\<close>
 proof -
   from assms(1) have \<open>B \<subseteq> Cn(A)\<close> by (simp add: infer_def subsetI)
   hence \<open>Cn(B) \<subseteq> Cn(A)\<close>  using idempotency_L monotonicity_L by blast
   moreover from assms(2) have \<open>\<psi> \<in> Cn(B)\<close> by (simp add: infer_def)
   ultimately show ?thesis using infer_def by blast
 qed
 
 lemma Cn_same: \<open>(Cn(A) = Cn(B)) \<longleftrightarrow> (\<forall>C. A \<subseteq> Cn(C) \<longleftrightarrow> B \<subseteq> Cn(C))\<close>
 proof
   { assume h:\<open>Cn(A) = Cn(B)\<close>
     from h have \<open>\<forall>\<phi> \<in> B. A \<turnstile> \<phi>\<close> 
       by (simp add: Tarskian_logic.assumption_L Tarskian_logic_axioms infer_def)
     moreover from h[symmetric] have \<open>\<forall>\<phi> \<in> A. B \<turnstile> \<phi>\<close>
       by (simp add: Tarskian_logic.assumption_L Tarskian_logic_axioms infer_def)
     ultimately have \<open>\<forall>C. A \<subseteq> Cn(C) \<longleftrightarrow> B \<subseteq> Cn(C)\<close>
       using h idempotency_L inclusion_L monotonicity_L by blast
   } thus \<open>Cn(A) = Cn(B) \<Longrightarrow> \<forall>C. (A \<subseteq> Cn(C)) = (B \<subseteq> Cn(C))\<close> .
 next
   { assume h:\<open>\<forall>C. (A \<subseteq> Cn(C)) = (B \<subseteq> Cn(C))\<close>
     from h have \<open>(A \<subseteq> Cn(A)) = (B \<subseteq> Cn(A))\<close> and \<open>(A \<subseteq> Cn(B)) = (B \<subseteq> Cn(B))\<close> by simp+
     hence \<open>B \<subseteq> Cn(A)\<close> and \<open>A \<subseteq> Cn(B)\<close> by (simp add: inclusion_L)+
     hence \<open>Cn(A) = Cn(B)\<close>
       using idempotency_L monotonicity_L by blast
   } thus \<open>(\<forall>C. (A \<subseteq> Cn(C)) = (B \<subseteq> Cn(C))) \<Longrightarrow> Cn(A) = Cn(B)\<close> .
 qed
 
 \<comment> \<open>
 The closure of the union of two consequence closures.
 \<close>
 lemma Cn_union: \<open>Cn(Cn(A) \<union> Cn(B)) = Cn(A \<union> B)\<close>
 proof
   have \<open>Cn(Cn(A) \<union> Cn(B)) \<subseteq> Cn(Cn (A \<union> B))\<close> by (simp add: monotonicity_L)
   thus \<open>Cn(Cn(A) \<union> Cn(B)) \<subseteq> Cn(A \<union> B)\<close> by (simp add: idempotency_L)
 next
   have \<open>(A \<union> B) \<subseteq> (Cn(A) \<union> Cn(B))\<close> using inclusion_L by blast
   thus \<open>Cn(A \<union> B) \<subseteq> Cn(Cn(A) \<union> Cn(B))\<close> by (simp add: monotonicity_L)
 qed
 
 \<comment> \<open>
 The closure of an infinite union of consequence closures.
 \<close>
 lemma Cn_Union: \<open>Cn(\<Union>{Cn(B)|B. P B}) = Cn(\<Union>{B. P B})\<close> (is \<open>?A = ?B\<close>)
 proof
   have \<open>?A \<subseteq> Cn ?B\<close>
     apply(rule monotonicity_L, rule Union_least, auto) 
     by (metis Sup_upper in_mono mem_Collect_eq monotonicity_L)
   then show \<open>?A \<subseteq> ?B\<close>
     by (simp add: idempotency_L)
 next
   show \<open>?B \<subseteq> ?A\<close> 
     by (metis (mono_tags, lifting) Union_subsetI inclusion_L mem_Collect_eq monotonicity_L)
 qed
 
 \<comment> \<open>
 The intersection of two closures is closed.
 \<close>
 lemma Cn_inter: \<open>K = Cn(A) \<inter> Cn(B) \<Longrightarrow> K = Cn(K)\<close>
 proof -
   { fix K assume h:\<open>K = Cn(A) \<inter> Cn(B)\<close>
     from h have \<open>K \<subseteq> Cn(A)\<close> and \<open>K \<subseteq> Cn(B)\<close> by simp+
     hence \<open>Cn(K) \<subseteq> Cn(A)\<close> and \<open>Cn(K) \<subseteq> Cn(B)\<close> using idempotency_L monotonicity_L by blast+
     hence \<open>Cn(K) \<subseteq> Cn(A) \<inter> Cn(B)\<close> by simp
     with h have \<open>K = Cn(K)\<close> by (simp add: inclusion_L subset_antisym)
   } thus \<open>K = Cn(A) \<inter> Cn(B) \<Longrightarrow> K = Cn(K)\<close> .
 qed
 
 \<comment> \<open>
 An infinite intersection of closures is closed.
 \<close>
 lemma Cn_Inter: \<open>K = \<Inter>{Cn(B)|B. P B} \<Longrightarrow> K = Cn(K)\<close>
 proof -
   { fix K assume h:\<open>K = \<Inter>{Cn(B)|B. P B}\<close>
     from h have \<open>\<forall>B. P B \<longrightarrow> K \<subseteq> Cn(B)\<close> by blast
     hence \<open>\<forall>B. P B \<longrightarrow> Cn(K) \<subseteq> Cn(B)\<close> using idempotency_L monotonicity_L by blast
     hence \<open>Cn(K) \<subseteq> \<Inter>{Cn(B)|B. P B}\<close> by blast
     with h have \<open>K = Cn(K)\<close> by (simp add: inclusion_L subset_antisym)
   } thus \<open>K = \<Inter>{Cn(B)|B. P B} \<Longrightarrow> K = Cn(K)\<close> .
 qed
 
 end
 
 subsection \<open>Supraclassical Logic\<close>
 
 text \<open>
 A Tarskian logic has only one abstract operator catching the notion of consequence. A basic case of such a logic is a \<^bold>\<open>Supraclassical\<close> logic that 
 is a logic with all classical propositional operators (e.g. conjunction (\<open>\<and>\<close>), implication(\<open>\<longrightarrow>\<close>), negation (\<open>\<not>\<close>) \dots ) together with their classical semantics.
 
 We define a new locale. In order to distinguish the propositional operators of our supraclassical logic from those of Isabelle/HOL, we use dots (e.g. \<open>.\<and>.\<close> stands for conjunction). 
 We axiomatize the introduction and elimination rules of each operator as it is commonly established in the classical literature. As explained before, 
 we give priority to a complete control of our logic instead of an efficient shallow embedding in Isabelle/HOL.
 \<close>
 
 locale Supraclassical_logic = Tarskian_logic +
 
 fixes true_PL::   \<open>'a\<close>             (\<open>\<top>\<close>)
   and false_PL::  \<open>'a\<close>             (\<open>\<bottom>\<close>)
   and imp_PL::    \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close> (infix \<open>.\<longrightarrow>.\<close> 55)
   and not_PL::    \<open>'a \<Rightarrow> 'a\<close>       (\<open>.\<not>\<close>)  
   and conj_PL::   \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close> (infix \<open>.\<and>.\<close> 55)
   and disj_PL::   \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close> (infix \<open>.\<or>.\<close> 55)
   and equiv_PL::  \<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close> (infix \<open>.\<longleftrightarrow>.\<close> 55)
 
 assumes true_PL:     \<open>A \<turnstile> \<top>\<close>
 
     and false_PL:    \<open>{\<bottom>} \<turnstile> p\<close>
 
     and impI_PL:     \<open>A \<union> {p} \<turnstile> q \<Longrightarrow> A \<turnstile> (p .\<longrightarrow>. q)\<close>
     and mp_PL:       \<open>A \<turnstile> p .\<longrightarrow>. q \<Longrightarrow> A \<turnstile> p \<Longrightarrow> A \<turnstile> q\<close>
 
     and notI_PL:     \<open>A \<turnstile> p .\<longrightarrow>. \<bottom> \<Longrightarrow> A \<turnstile> .\<not> p\<close>
     and notE_PL:     \<open>A \<turnstile> .\<not> p \<Longrightarrow> A \<turnstile> (p .\<longrightarrow>. \<bottom>)\<close>
 
     and conjI_PL:    \<open>A \<turnstile> p \<Longrightarrow> A \<turnstile> q \<Longrightarrow> A \<turnstile> (p .\<and>. q)\<close>
     and conjE1_PL:   \<open>A \<turnstile> p .\<and>. q \<Longrightarrow> A \<turnstile> p\<close>
     and conjE2_PL:   \<open>A \<turnstile> p .\<and>. q \<Longrightarrow> A \<turnstile> q\<close>
 
     and disjI1_PL:   \<open>A \<turnstile> p \<Longrightarrow> A \<turnstile> (p .\<or>. q)\<close>
     and disjI2_PL:   \<open>A \<turnstile> q \<Longrightarrow> A \<turnstile> (p .\<or>. q)\<close>
     and disjE_PL:    \<open>A \<turnstile> p .\<or>. q \<Longrightarrow> A \<turnstile> p .\<longrightarrow>. r \<Longrightarrow> A \<turnstile> q.\<longrightarrow>. r \<Longrightarrow> A \<turnstile> r\<close>
 
     and equivI_PL:   \<open>A \<turnstile> p .\<longrightarrow>. q \<Longrightarrow> A \<turnstile> q .\<longrightarrow>. p \<Longrightarrow> A \<turnstile> (p .\<longleftrightarrow>. q)\<close>
     and equivE1_PL:  \<open>A \<turnstile> p .\<longleftrightarrow>. q \<Longrightarrow> A \<turnstile> p .\<longrightarrow>. q\<close>
     and equivE2_PL:  \<open>A \<turnstile> p .\<longleftrightarrow>. q \<Longrightarrow> A \<turnstile> q .\<longrightarrow>. p\<close>
 
 \<comment> \<open>non intuitionistic rules\<close>
     and absurd_PL:   \<open>A \<turnstile> .\<not> (.\<not> p) \<Longrightarrow> A \<turnstile> p\<close>
     and ex_mid_PL:   \<open>A \<turnstile> p .\<or>. (.\<not> p)\<close>
 
 begin 
 
 text \<open>In the following, we will first retrieve the classical logic operators semantics coming from previous introduction and elimination rules\<close>
 
 lemma non_consistency:
   assumes \<open>A \<turnstile> .\<not> p\<close>
       and \<open>A \<turnstile> p\<close>
     shows \<open>A \<turnstile> q\<close>
   by (metis assms(1) assms(2) false_PL mp_PL notE_PL singleton_iff transitivity2_L)
 
 \<comment> \<open>this direct result brings directly many remarkable properties of implication (i.e. transitivity)\<close>
 lemma imp_PL: \<open>A \<turnstile> p .\<longrightarrow>. q \<longleftrightarrow> A \<union> {p} \<turnstile> q\<close>
   apply (intro iffI impI_PL)
    apply(rule mp_PL[where p=p], meson UnI1 assumption_L transitivity2_L)
   using assumption_L by auto
 
 lemma not_PL: \<open>A \<turnstile> .\<not> p \<longleftrightarrow> A \<union> {p} \<turnstile> \<bottom>\<close>
   using notE_PL notI_PL imp_PL by blast
 
 \<comment> \<open>Classical logic result\<close>
 lemma notnot_PL: \<open>A \<turnstile> .\<not> (.\<not> p) \<longleftrightarrow> A \<turnstile> p\<close>
   apply(rule iffI, simp add:absurd_PL) 
   by (meson mp_PL notE_PL Un_upper1 Un_upper2 assumption_L infer_def monotonicity_L not_PL singletonI subsetD)
 
 lemma conj_PL: \<open>A \<turnstile> p .\<and>. q \<longleftrightarrow> (A \<turnstile> p \<and> A \<turnstile> q)\<close>
   using conjE1_PL conjE2_PL conjI_PL by blast 
 
 lemma disj_PL: \<open>A \<turnstile> p .\<or>. q \<longleftrightarrow> A \<union> {.\<not> p} \<turnstile> q\<close>
 proof
   assume a:\<open>A \<turnstile> p .\<or>. q\<close>
   have b:\<open>A \<turnstile> p .\<longrightarrow>. (.\<not> p .\<longrightarrow>. q)\<close> 
     by (intro impI_PL) (meson Un_iff assumption_L insertI1 non_consistency)
   have c:\<open>A \<turnstile> q .\<longrightarrow>. (.\<not> p .\<longrightarrow>. q)\<close> 
     by (simp add: assumption_L impI_PL)
   from a b c have \<open>A \<turnstile> .\<not> p .\<longrightarrow>. q\<close>
     by (erule_tac disjE_PL) simp_all
   then show \<open>A \<union> {.\<not> p} \<turnstile> q\<close> 
     using imp_PL by blast
 next 
   assume a:\<open>A \<union> {.\<not> p} \<turnstile> q\<close>
   hence b:\<open>A \<turnstile> .\<not> p .\<longrightarrow>. q\<close> by (simp add: impI_PL)
   then show \<open>A \<turnstile> p .\<or>. q\<close> 
     apply(rule_tac disjE_PL[OF ex_mid_PL, of A p \<open>p .\<or>. q\<close>]) 
     by (auto simp add: assumption_L disjI2_PL disjI1_PL impI_PL imp_PL) 
 qed
 
 lemma equiv_PL:\<open>A \<turnstile> p .\<longleftrightarrow>. q \<longleftrightarrow> (A \<union> {p} \<turnstile> q \<and> A \<union> {q} \<turnstile> p)\<close>
   using imp_PL equivE1_PL equivE2_PL equivI_PL by blast
 
 corollary valid_imp_PL:  \<open>\<tturnstile> (p .\<longrightarrow>. q) = ({p} \<turnstile> q)\<close>
       and valid_not_PL:  \<open>\<tturnstile> (.\<not> p) = ({p} \<turnstile> \<bottom>)\<close>
       and valid_conj_PL: \<open>\<tturnstile> (p .\<and>. q) = (\<tturnstile> p \<and> \<tturnstile> q)\<close>
       and valid_disj_PL: \<open>\<tturnstile> (p .\<or>. q) = ({.\<not> p} \<turnstile> q)\<close>
       and valid_equiv_PL:\<open>\<tturnstile> (p .\<longleftrightarrow>. q) = ({p} \<turnstile> q \<and> {q} \<turnstile> p)\<close>
   using imp_PL not_PL conj_PL disj_PL equiv_PL valid_def by auto
 
 text\<open>Second, we will combine each logical operator with the consequence operator \<open>Cn\<close>: it is a trick to profit from set theory to get many essential 
 lemmas without complex inferences\<close>
 declare infer_def[simp]
 
 lemma nonemptyCn: \<open>Cn(A) \<noteq> {}\<close>
   using true_PL by auto
 
 lemma Cn_true: \<open>Cn({\<top>}) = Cn({})\<close>
   using Cn_same true_PL by auto
 
 lemma Cn_false: \<open>Cn({\<bottom>}) = UNIV\<close> 
   using false_PL by auto
 
 lemma Cn_imp:     \<open>A \<turnstile> (p .\<longrightarrow>. q) \<longleftrightarrow> Cn({q}) \<subseteq> Cn(A \<union> {p})\<close> 
   and Cn_imp_bis: \<open>A \<turnstile> (p .\<longrightarrow>. q) \<longleftrightarrow> Cn(A \<union> {q}) \<subseteq> Cn(A \<union> {p})\<close> 
   using Cn_same imp_PL idempotency_L inclusion_L infer_def subset_insertI by force+
 
 lemma Cn_not: \<open>A \<turnstile> .\<not> p \<longleftrightarrow> Cn(A \<union> {p}) = UNIV\<close>
   using Cn_false Cn_imp notE_PL not_PL by fastforce
 
 lemma Cn_conj: \<open>A \<turnstile> (p .\<and>. q) \<longleftrightarrow> Cn({p}) \<union> Cn({q}) \<subseteq> Cn(A)\<close>
   apply(intro iffI conjI_PL, frule conjE1_PL, frule conjE2_PL) 
   using Cn_same Un_insert_right bot.extremum idempotency_L inclusion_L by auto
 
 lemma Cn_conj_bis: \<open>Cn({p .\<and>. q}) = Cn({p, q})\<close> 
   by (unfold Cn_same)
      (meson Supraclassical_logic.conj_PL Supraclassical_logic_axioms insert_subset)
 
 lemma Cn_disj:     \<open>A \<turnstile> (p .\<or>. q) \<longleftrightarrow> Cn({q}) \<subseteq> Cn(A \<union> {.\<not> p})\<close>
   and Cn_disj_bis: \<open>A \<turnstile> (p .\<or>. q) \<longleftrightarrow> Cn(A \<union> {q}) \<subseteq> Cn(A \<union> {.\<not> p})\<close>
   using disj_PL Cn_same imp_PL idempotency_L inclusion_L infer_def subset_insertI by force+
 
 lemma Cn_equiv: \<open>A \<turnstile> (p .\<longleftrightarrow>. q) \<longleftrightarrow> Cn(A \<union> {p}) = Cn(A \<union> {q})\<close>
   by (metis Cn_imp_bis equivE1_PL equivE2_PL equivI_PL set_eq_subset)
 
 corollary valid_nonemptyCn: \<open>Cn({}) \<noteq> {}\<close>
       and valid_Cn_imp:     \<open>\<tturnstile> (p .\<longrightarrow>. q) \<longleftrightarrow> Cn({q}) \<subseteq> Cn({p})\<close> 
       and valid_Cn_not:     \<open>\<tturnstile> (.\<not> p) \<longleftrightarrow> Cn({p}) = UNIV\<close>
       and valid_Cn_conj:    \<open>\<tturnstile> (p .\<and>. q) \<longleftrightarrow> Cn({p}) \<union> Cn({q}) \<subseteq> Cn({})\<close>
       and valid_Cn_disj:    \<open>\<tturnstile> (p .\<or>. q) \<longleftrightarrow> Cn({q}) \<subseteq> Cn({.\<not> p})\<close>
       and valid_Cn_equiv:   \<open>\<tturnstile> (p .\<longleftrightarrow>. q) \<longleftrightarrow> Cn({p}) = Cn({q})\<close>
   using nonemptyCn Cn_imp Cn_not Cn_conj Cn_disj Cn_equiv valid_def by auto
 
 \<comment> \<open>Finally, we group additional lemmas that were essential in further proofs\<close>
 lemma consistency: \<open>Cn({p}) \<inter> Cn({.\<not> p}) = Cn({})\<close>
 proof
   { fix q
     assume \<open>{p} \<turnstile> q\<close> and \<open>{.\<not> p} \<turnstile> q\<close>
     hence "{} \<turnstile> p .\<longrightarrow>. q" and "{} \<turnstile> (.\<not> p) .\<longrightarrow>. q" 
       using impI_PL by auto
     hence \<open>{} \<turnstile> q\<close> 
       using ex_mid_PL by (rule_tac disjE_PL[where p=p and q=\<open>.\<not> p\<close>]) blast   
   }
   then show \<open>Cn({p}) \<inter> Cn({.\<not> p}) \<subseteq> Cn({})\<close> by (simp add: subset_iff)
 next
   show \<open>Cn({}) \<subseteq> Cn({p}) \<inter> Cn({.\<not> p})\<close> by (simp add: monotonicity_L)
 qed
 
 lemma Cn_notnot: \<open>Cn({.\<not> (.\<not> \<phi>)}) = Cn({\<phi>})\<close>
   by (metis (no_types, opaque_lifting) notnot_PL valid_Cn_equiv valid_equiv_PL)
 
 lemma conj_com: \<open>A \<turnstile> p .\<and>. q \<longleftrightarrow> A \<turnstile> q .\<and>. p\<close>
   using conj_PL by auto
 
 lemma conj_com_Cn: \<open>Cn({p .\<and>. q}) = Cn({q .\<and>. p})\<close>
   by (simp add: Cn_conj_bis insert_commute) 
 
 lemma disj_com: \<open>A \<turnstile> p .\<or>. q \<longleftrightarrow> A \<turnstile> q .\<or>. p\<close>
 proof -
   { fix p q
     have \<open>A \<turnstile> p .\<or>. q \<Longrightarrow> A \<turnstile> q .\<or>. p\<close>
       apply(erule disjE_PL) 
       using assumption_L disjI2_PL disjI1_PL impI_PL by auto 
   }
   then show ?thesis by auto
 qed
 
 lemma disj_com_Cn: \<open>Cn({p .\<or>. q}) = Cn({q .\<or>. p})\<close>
   unfolding Cn_same using disj_com by simp
 
 lemma imp_contrapos: \<open>A \<turnstile> p .\<longrightarrow>. q \<longleftrightarrow> A \<turnstile> .\<not> q .\<longrightarrow>. .\<not> p\<close>
   by (metis Cn_not Un_insert_left Un_insert_right imp_PL notnot_PL)
 
 lemma equiv_negation: \<open>A \<turnstile> p .\<longleftrightarrow>. q \<longleftrightarrow> A \<turnstile> .\<not> p .\<longleftrightarrow>. .\<not> q\<close>
   using equivE1_PL equivE2_PL equivI_PL imp_contrapos by blast
 
 lemma imp_trans: \<open>A \<turnstile> p .\<longrightarrow>.q \<Longrightarrow> A \<turnstile> q .\<longrightarrow>.r \<Longrightarrow> A \<turnstile> p .\<longrightarrow>.r\<close>
   using Cn_imp_bis by auto
 
 lemma imp_recovery0: \<open>A \<turnstile> p .\<or>. (p .\<longrightarrow>. q)\<close>
   apply(subst disj_PL, subst imp_contrapos)
   using assumption_L impI_PL by auto
 
 lemma imp_recovery1: \<open>A \<union> {p .\<longrightarrow>. q} \<turnstile> p \<Longrightarrow> A \<turnstile> p\<close>
   using disjE_PL[OF imp_recovery0, of A p p q] assumption_L imp_PL by auto
 
 lemma imp_recovery2: \<open>A \<turnstile> p .\<longrightarrow>. q \<Longrightarrow> A \<turnstile> (q .\<longrightarrow>. p) .\<longrightarrow>. p \<Longrightarrow> A \<turnstile> q\<close>
   using imp_PL imp_recovery1 imp_trans by blast
 
 lemma impI2: \<open>A \<turnstile> q \<Longrightarrow> A \<turnstile> p .\<longrightarrow>. q\<close> 
   by (meson assumption_L impI_PL in_mono sup_ge1 transitivity2_L)
 
 lemma conj_equiv: \<open>A \<turnstile> p \<Longrightarrow> A \<turnstile> ((p .\<and>. q) .\<longleftrightarrow>. q)\<close>
   by (metis Un_insert_right assumption_L conjE2_PL conjI_PL equiv_PL impI2 imp_PL insertI1 sup_bot.right_neutral)
 
 lemma conj_imp: \<open>A \<turnstile> (p .\<and>. q) .\<longrightarrow>. r \<longleftrightarrow> A \<turnstile> p .\<longrightarrow>. (q .\<longrightarrow>. r)\<close>
 proof
   assume "A \<turnstile> (p .\<and>. q) .\<longrightarrow>. r"
   then have "Cn (A \<union> {r}) \<subseteq> Cn (A \<union> {p, q})"
     by (metis (no_types) Cn_conj_bis Cn_imp_bis Cn_union Un_insert_right sup_bot.right_neutral)
   then show \<open>A \<turnstile> p .\<longrightarrow>. (q .\<longrightarrow>. r)\<close>
     by (metis Un_insert_right impI_PL inclusion_L infer_def insert_commute insert_subset subset_eq sup_bot.right_neutral)
 next
    assume "A \<turnstile> p .\<longrightarrow>. (q .\<longrightarrow>. r)"
   then have "A \<union> {p} \<union> {q} \<turnstile> r"
     using imp_PL by auto
   then show "A \<turnstile> (p .\<and>. q) .\<longrightarrow>. r"
     by (metis (full_types) Cn_conj_bis Cn_union impI_PL infer_def insert_is_Un sup_assoc)
 qed
 
 lemma conj_not_impE_PL: \<open>A \<turnstile> (p .\<and>. q) .\<longrightarrow>. r \<Longrightarrow> A \<turnstile> (p .\<and>. .\<not> q) .\<longrightarrow>. r \<Longrightarrow> A \<turnstile> p .\<longrightarrow>. r\<close> 
   by (meson conj_imp disjE_PL ex_mid_PL imp_PL)
 
 lemma disj_notE_PL: \<open>A \<turnstile> q \<Longrightarrow> A \<turnstile> p .\<or>. .\<not> q \<Longrightarrow> A \<turnstile> p\<close>
   using Cn_imp Cn_imp_bis Cn_not disjE_PL notnot_PL by blast
 
 lemma disj_not_impE_PL: \<open>A \<turnstile> (p .\<or>. q) .\<longrightarrow>. r \<Longrightarrow> A \<turnstile> (p .\<or>. .\<not> q) .\<longrightarrow>. r \<Longrightarrow> A \<turnstile> r\<close> 
   by (metis Un_insert_right disjE_PL disj_PL disj_com ex_mid_PL insert_commute sup_bot.right_neutral)
 
 lemma imp_conj: \<open>A \<turnstile> p .\<longrightarrow>. q \<Longrightarrow> A \<turnstile> r .\<longrightarrow>. s \<Longrightarrow> A \<turnstile> (p .\<and>. r) .\<longrightarrow>. (q .\<and>. s)\<close>
   apply(intro impI_PL conjI_PL, unfold imp_PL[symmetric])
   by (meson assumption_L conjE1_PL conjE2_PL imp_trans infer_def insertI1 validD_L valid_imp_PL)+
 
 lemma conj_overlap: \<open>A \<turnstile> (p .\<and>. q) \<longleftrightarrow> A \<turnstile> (p .\<and>. ((.\<not> p) .\<or>. q))\<close>
   by (meson conj_PL disjI2_PL disj_com disj_notE_PL)
 
 lemma morgan: \<open>A \<turnstile> .\<not> (p .\<and>. q) \<longleftrightarrow> A \<turnstile> (.\<not> p) .\<or>. (.\<not> q)\<close>
   by (meson conj_imp disj_PL disj_com imp_PL imp_contrapos notE_PL notI_PL)
 
 lemma conj_superexpansion1: \<open>A \<turnstile> .\<not> (p .\<and>. q) .\<and>. .\<not> p \<longleftrightarrow> A \<turnstile> .\<not> p\<close>
   using conj_PL disjI1_PL morgan by auto
 
 lemma conj_superexpansion2: \<open>A \<turnstile> (p .\<or>. q) .\<and>. p \<longleftrightarrow> A \<turnstile> p\<close>
   using conj_PL disjI1_PL by auto
 
 end
 
 subsection \<open>Compact Logic\<close>
 text\<open>If the logic is compact, which means that any result is based on a finite set of hypothesis\<close>
 locale Compact_logic = Tarskian_logic +
   assumes compactness_L: \<open>A \<turnstile> \<phi> \<Longrightarrow> (\<exists>A'. A'\<subseteq> A \<and> finite A' \<and> A'\<turnstile> \<phi>)\<close>
 
 begin
 
 text \<open>Very important lemma preparing the application of the Zorn's lemma. It states that in a compact logic, we can not deduce \<open>\<phi>\<close>
 if we accumulate an infinity of hypothesis groups which locally do not deduce phi\<close>
 lemma chain_closure: \<open>\<not> \<tturnstile> \<phi> \<Longrightarrow> subset.chain {B. \<not> B \<turnstile> \<phi>} C \<Longrightarrow> \<not> \<Union>C \<turnstile> \<phi>\<close> 
 proof                                    
   assume a:\<open>subset.chain {B. \<not> B \<turnstile> \<phi>} C\<close> and b:\<open>\<not> \<tturnstile> \<phi>\<close> and \<open>\<Union> C \<turnstile> \<phi>\<close>
   then obtain A' where c:\<open>A'\<subseteq> \<Union> C\<close> and d:\<open>finite A'\<close>  and e:\<open>A' \<turnstile> \<phi>\<close> using compactness_L by blast
   define f where f:\<open>f \<equiv> \<lambda>a. SOME B. B \<in> C \<and> a \<in> B\<close>
   have g:\<open>finite (f ` A')\<close> using f d by simp
   have h:\<open>(f ` A') \<subseteq> C\<close> 
     unfolding f by auto (metis (mono_tags, lifting) Union_iff c someI_ex subset_eq)
   have i:\<open>subset.chain {B. \<not> B \<turnstile> \<phi>} (f ` A')\<close> using a h
     using a h by (meson subsetD subset_chain_def subset_trans)
   have \<open>A' \<noteq> {} \<Longrightarrow> \<Union> (f ` A') \<in> {B. \<not> B \<turnstile> \<phi>}\<close> using g i 
     by (meson Union_in_chain image_is_empty subset_chain_def subset_eq)
   hence j:\<open>A' \<noteq> {} \<Longrightarrow> \<not> \<Union>(f ` A') \<turnstile> \<phi>\<close> by simp
   have \<open>A' \<subseteq> \<Union>(f ` A')\<close> 
     unfolding f by auto (metis (no_types, lifting) Union_iff c someI_ex subset_iff)
   with j e b show False
     by (metis infer_def monotonicity_L subsetD valid_def)
 qed
 
 end
 
 end
 
 
diff --git a/thys/CoCon/Traceback_Properties.thy b/thys/CoCon/Traceback_Properties.thy
--- a/thys/CoCon/Traceback_Properties.thy
+++ b/thys/CoCon/Traceback_Properties.thy
@@ -1,682 +1,682 @@
 theory Traceback_Properties
 imports Safety_Properties
 begin
 
 
 section \<open>Traceback properties\<close>
 
 text \<open>In this section, we prove various traceback properties,
 by essentially giving trace-based justifications of certain
 occurring situations that are relevant for access to information:
 %
 \begin{description}
 \item{\bf Being an author. }
 If a user is an author of a paper, then either the user has registered the paper in the first
 place or, inductively, has been appointed as coauthor by another author.
 %
 \item{\bf Being a chair. }
 If a user is a chair of a conference, then either that user has registered the conference
 which has been approved by the superuser or, inductively, that user has been appointed
 by an existing chair of that conference.
 %
 %
 \item{\bf Being a PC member. }
 If a user is a PC member in a conference, then the user either must have been the original chair or must
 have been appointed by a chair.
 %
 \item{\bf Being a reviewer. }
-If a user is a paper’s reviewer, then the user must have been appointed by a chair (from
+If a user is a paper's reviewer, then the user must have been appointed by a chair (from
 among the PC members who have not declared a conflict with the paper).
 %
 \item{\bf Having conflict. }
 If a user has conflict with a paper, then the user is either an author of the paper or the
-conflict has been declared by that user or by a paper’s author, in such a way that between
+conflict has been declared by that user or by a paper's author, in such a way that between
 the moment when the conflict has been last declared and the current moment there is no
 transition that successfully removes the conflict.
 %
 \item{\bf Conference reaching a phase. }
 If a conference is in a given phase different from ``no phase'', then this has happened as
 a consequence of either a conference approval action by the superuser (if the phase is
 Setup) or a phase change action by a chair (otherwise).
 \end{description}
 
 More details and explanations can be found in \cite[Section 3.6]{cocon-JAR2021}.
 \<close>
 
 
 subsection \<open>Preliminaries\<close>
 
 inductive trace_between :: "state \<Rightarrow> (state,act,out) trans trace \<Rightarrow> state \<Rightarrow> bool" where
   empty[simp]: "trace_between s [] s"
 | step: "\<lbrakk>trace_between s tr sh; step sh a = (ou,s')\<rbrakk> \<Longrightarrow> trace_between s (tr@[Trans sh a ou s']) s'"
 
 inductive_simps
   trace_ft_empty[simp]: "trace_between s [] s'" and
   trace_ft_snoc: "trace_between s (tr@[trn]) s'"
 thm trace_ft_empty trace_ft_snoc
 
 lemma trace_ft_append: "trace_between s (tr1@tr2) s'
   \<longleftrightarrow> (\<exists>sh. trace_between s tr1 sh \<and> trace_between sh tr2 s')"
   apply (induction tr2 arbitrary: s' rule: rev_induct)
    apply simp
   apply (subst append_assoc[symmetric], subst trace_ft_snoc)
   apply (auto simp: trace_ft_snoc)
   done
 
 lemma trace_ft_Cons: "trace_between s (trn#tr) s'
   \<longleftrightarrow> (\<exists>sh ou a. trn = Trans s a ou sh \<and> step s a = (ou,sh) \<and> trace_between sh tr s')"
   apply (subst trace_ft_append[where ?tr1.0 = "[trn]", simplified])
   apply (subst trace_ft_snoc[where tr = "[]", simplified])
   by auto
 
 lemmas trace_ft_simps = trace_ft_empty trace_ft_snoc trace_ft_Cons trace_ft_append
 
 inductive trace_to :: " (state,act,out) trans trace \<Rightarrow> state \<Rightarrow> bool" where
   empty: "trace_to [] istate"
 | step: "\<lbrakk>trace_to tr s; step s a = (ou,s')\<rbrakk> \<Longrightarrow> trace_to (tr@[Trans s a ou s']) s'"
 
 lemma trace_to_ft: "trace_to tr s \<longleftrightarrow> trace_between istate tr s"
 proof (rule,goal_cases)
   case 1 thus ?case
     by induction (auto intro: trace_between.intros)
 next
   case 2
   moreover
   {fix s' assume "trace_between s' tr s" hence "s' = istate \<longrightarrow> trace_to tr s"
    by induction (auto intro: trace_to.intros)
   }
   ultimately show ?case by auto
 qed
 
 inductive_simps trace_to_empty[simp]: "trace_to [] s"
 
 lemma trace_to_reach: assumes "trace_to tr s" shows "reach s"
   using assms apply induction
    apply (rule reach.intros)
   by (metis reach_step snd_conv)
 
 lemma reach_to_trace: assumes "reach s" obtains tr where "trace_to tr s"
   using assms apply (induction rule: reach_step_induct)
    apply (auto intro: trace_to.intros) []
   by (metis surjective_pairing trace_to.step)
 
 lemma reach_trace_to_conv: "reach s \<longleftrightarrow> (\<exists>tr. trace_to tr s)"
   by (blast intro: trace_to_reach elim: reach_to_trace)
 
 thm trace_to.induct[no_vars]
 
 lemma trace_to_induct[case_names empty step, induct set]:
   "\<lbrakk>trace_to x1 x2; P [] istate;
   \<And>tr s a ou s'.
     \<lbrakk>trace_to tr s; P tr s; reach s; reach s'; step s a = (ou, s')\<rbrakk>
     \<Longrightarrow> P (tr ## Trans s a ou s') s'\<rbrakk>
   \<Longrightarrow> P x1 x2"
   apply (erule trace_to.induct)
    apply simp
   apply (frule trace_to_reach)
   using reach_PairI by blast
 
 
 
 subsection \<open>Authorship\<close>
 
 text \<open>
   Only the creator of a paper, and users explicitly added by other authors,
   are authors of a paper.
 \<close>
 
 inductive isAut' :: "(state,act,out) trans trace \<Rightarrow> confID \<Rightarrow> userID \<Rightarrow> paperID \<Rightarrow> bool" where
   creator: "\<lbrakk> trn = Trans _ (Cact (cPaper cid uid _ pid _ _)) outOK _ \<rbrakk>
     \<Longrightarrow> isAut' (tr@[trn]) cid uid pid"
   (* "The creator of a paper is an author"  *)
 | co_author: "\<lbrakk>
   isAut' tr cid uid' pid;
   trn = Trans _ (Cact (cAuthor cid uid' _ pid uid)) outOK _ \<rbrakk>
   \<Longrightarrow> isAut' (tr@[trn]) cid uid pid"
   (* "An author can add any other user as a coauthor" *)
 | irrelevant: "isAut' tr cid uid' pid \<Longrightarrow> isAut' (tr@[_]) cid uid' pid"
 
 lemma justify_author:
   assumes "trace_to tr s"
   assumes "isAut s cid uid pid"
   shows "isAut' tr cid uid pid"
   using assms
 proof (induction arbitrary: uid)
   case (empty s) thus ?case
     by (auto simp add: istate_def)
 next
   case (step tr s a ou s')
   show ?case
   proof (cases "isAut s cid uid pid")
     case True with step.IH show ?thesis by (blast intro: isAut'.intros)
   next
     case False
     with step.hyps step.prems obtain
       pass s1 s2 uid' where
       "a=Cact (cPaper cid uid pass pid s1 s2)
       \<or> (a=Cact (cAuthor cid uid' pass pid uid) \<and> isAut s cid uid' pid)"
       and [simp]: "ou=outOK"
       apply (cases a)
         subgoal for x1 apply (cases x1, auto simp add: c_defs) [] .
         subgoal for x2 apply (cases x2, auto simp add: u_defs) [] .
         subgoal for x3 apply (cases x3, auto simp add: uu_defs) [] .
         by simp_all
     thus ?thesis using step.IH
       apply (elim disjE)
       apply (rule isAut'.creator, auto) []
       apply (rule isAut'.co_author, auto) []
       done
   qed
 qed
 
 
 lemma author_justify:
   assumes "trace_to tr s"
   assumes "isAut' tr cid uid pid"
   shows "isAut s cid uid pid"
   using assms
 proof (induction arbitrary: uid)
   case (empty s) thus ?case
     by (auto simp add: istate_def elim: isAut'.cases)
 next
   case (step tr s a ou s')
   from step.prems
   show ?case
   proof (cases)
     case (creator _ _ pass s1 s2)
     hence [simp]: "a=Cact (cPaper cid uid pass pid s1 s2)" "ou=outOK" by simp_all
     from step.hyps show ?thesis
       by (auto simp add: c_defs)
   next
     case (co_author _ uid' _ _ pass)
     hence [simp]: "a=Cact (cAuthor cid uid' pass pid uid)" "ou=outOK" by simp_all
     from step.hyps show ?thesis
       by (auto simp add: c_defs)
   next
     case (irrelevant) with step.IH have AUT: "isAut s cid uid pid" by simp
 
     note roles_confIDs[OF \<open>reach s\<close> AUT]
     with AUT \<open>step s a = (ou, s')\<close> show ?thesis
       apply (cases a)
       subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
       subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
       subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
       by simp_all
   qed
 qed
 
 theorem isAut_eq: "trace_to tr s \<Longrightarrow> isAut s cid uid pid \<longleftrightarrow> isAut' tr cid uid pid"
   (* "Trace-based equivalent of authorship" *)
   using justify_author author_justify
   by (blast)
 
 
 subsection \<open>Becoming a Conference Chair\<close>
 
 inductive isChair' :: "(state,act,out) trans trace \<Rightarrow> confID \<Rightarrow> userID \<Rightarrow> bool" where
   creator: "\<lbrakk> trn=Trans _ (Cact (cConf cid uid _ _ _)) outOK _ \<rbrakk>
     \<Longrightarrow> isChair' (tr@[trn]) cid uid"
 | add_chair: "\<lbrakk> isChair' tr cid uid'; trn = Trans _ (Cact (cChair cid uid' _ uid)) outOK _ \<rbrakk>
   \<Longrightarrow> isChair' (tr@[trn]) cid uid"
 | irrelevant: "\<lbrakk>isChair' tr cid uid\<rbrakk> \<Longrightarrow> isChair' (tr@[_]) cid uid"
 
 lemma justify_chair:
   assumes "trace_to tr s"
   assumes "isChair s cid uid"
   shows "isChair' tr cid uid"
   using assms
 proof (induction arbitrary: uid)
   case (empty s) thus ?case
     by (auto simp add: istate_def)
 next
   case (step tr s a ou s')
   show ?case
   proof (cases "isChair s cid uid")
     case True with step.IH show ?thesis by (blast intro: isChair'.intros)
   next
     case False
     term cConf
     with step.hyps step.prems obtain
       pass s1 s2 uid' where
       "a=Cact (cConf cid uid pass s1 s2)
       \<or> (a=Cact (cChair cid uid' pass uid) \<and> isChair s cid uid')"
       and [simp]: "ou=outOK"
       apply (cases a)
       subgoal for x1 apply (cases x1, auto simp add: c_defs) [] .
       subgoal for x2 apply (cases x2, auto simp add: u_defs) [] .
       subgoal for x3 apply (cases x3, auto simp add: uu_defs) [] .
       by simp_all
     thus ?thesis using step.IH
       apply (elim disjE)
       apply (rule isChair'.creator, auto) []
       apply (rule isChair'.add_chair, auto) []
       done
   qed
 qed
 
 lemma chair_justify:
   assumes "trace_to tr s"
   assumes "isChair' tr cid uid"
   shows "isChair s cid uid"
   using assms
 proof (induction arbitrary: uid)
   case (empty s) thus ?case
     by (auto simp add: istate_def elim: isChair'.cases)
 next
   case (step tr s a ou s')
   from step.prems
   show ?case
   proof (cases)
     case (creator _ _ pass s1 s2)
     hence [simp]: "a=Cact (cConf cid uid pass s1 s2)" "ou=outOK" by simp_all
     from step.hyps show ?thesis
       by (auto simp add: c_defs)
   next
     case (add_chair _ uid' _ _ pass)
     hence [simp]: "a=Cact (cChair cid uid' pass uid)" "ou=outOK" by simp_all
     from step.hyps show ?thesis
       by (auto simp add: c_defs)
   next
     case (irrelevant) with step.IH have CH: "isChair s cid uid" by simp
 
     from CH \<open>step s a = (ou, s')\<close> show ?thesis
       apply (cases a)
       subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
       subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
       subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
       by simp_all
   qed
 qed
 
 theorem isChair_eq: "trace_to tr s \<Longrightarrow> isChair s cid uid = isChair' tr cid uid"
   (* "Trace-based equivalent of being a chair" *)
   using justify_chair chair_justify
   by (blast)
 
 
 subsection \<open>Committee Membership\<close>
 
 inductive isPC' :: "(state,act,out) trans trace \<Rightarrow> confID \<Rightarrow> userID \<Rightarrow> bool" where
   chair: "isChair' tr cid uid \<Longrightarrow> isPC' tr cid uid"
 | add_com: "\<lbrakk> isChair' tr cid uid'; trn = Trans _ (Cact (cPC cid uid' _ uid)) outOK _ \<rbrakk>
   \<Longrightarrow> isPC' (tr@[trn]) cid uid"
 | irrelevant: "\<lbrakk>isPC' tr cid uid\<rbrakk> \<Longrightarrow> isPC' (tr@[_]) cid uid"
 
 lemma justify_com:
   assumes "trace_to tr s"
   assumes "isPC s cid uid"
   shows "isPC' tr cid uid"
   using assms
 proof (induction arbitrary: uid)
   case (empty s) thus ?case
     by (auto simp add: istate_def)
 next
   case (step tr s a ou s')
 
   show ?case
   proof (cases "isPC s cid uid")
     case True with step.IH show ?thesis by (blast intro: isPC'.irrelevant)
   next
     case False note noPC = this
     show ?thesis proof (cases "isChair s' cid uid")
       case True thus ?thesis
         by (metis chair justify_chair step.hyps(1) step.hyps(4) trace_to.step)
     next
       case False note noChair=this
       from noPC noChair step.hyps step.prems obtain
         pass uid' where "(a=Cact (cPC cid uid' pass uid))"
         and "isChair s cid uid'"
         and [simp]: "ou=outOK"
         apply (cases a)
         subgoal for x1 apply (cases x1, auto simp add: c_defs) [] .
         subgoal for x2 apply (cases x2, auto simp add: u_defs) [] .
         subgoal for x3 apply (cases x3, auto simp add: uu_defs) [] .
         by simp_all
       thus ?thesis
         apply -
         apply (rule isPC'.add_com, auto simp: isChair_eq[OF \<open>trace_to tr s\<close>]) []
         done
     qed
   qed
 qed
 
 lemma com_justify:
   assumes "trace_to tr s"
   assumes "isPC' tr cid uid"
   shows "isPC s cid uid"
   using assms
 proof (induction arbitrary: uid)
   case (empty s) thus ?case
     by (auto simp add: istate_def elim!: isPC'.cases isChair'.cases)
 next
   case (step tr s a ou s')
   from step.prems
   show ?case
   proof (cases)
     case chair thus ?thesis
       by (metis isChair_eq isChair_isPC step.hyps(1) step.hyps(3) step.hyps(4) trace_to.step)
   next
     case (add_com _ uid' _ _ pass)
     hence [simp]: "a=Cact (cPC cid uid' pass uid)" "ou=outOK" by simp_all
     from step.hyps show ?thesis
       by (auto simp add: c_defs)
   next
     case (irrelevant) with step.IH have COM: "isPC s cid uid" by simp
 
     from COM \<open>step s a = (ou, s')\<close> show ?thesis
       apply (cases a)
       subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
       subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
       subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
       by simp_all
   qed
 qed
 
 theorem isPC_eq: "trace_to tr s \<Longrightarrow> isPC s cid uid = isPC' tr cid uid"
   (* "Trace-based equivalent of committee membership" *)
   using justify_com com_justify
   by (blast)
 
 
 subsection \<open>Being a Reviewer\<close>
 
 inductive isRev' :: "(state,act,out) trans trace \<Rightarrow> confID \<Rightarrow> userID \<Rightarrow> paperID \<Rightarrow> bool" where
   add_rev: "\<lbrakk> isChair' tr cid uid'; trn = Trans _ (Cact (cReview cid uid' _ pid uid)) outOK _ \<rbrakk>
   \<Longrightarrow> isRev' (tr@[trn]) cid uid pid"
 | irrelevant: "\<lbrakk>isRev' tr cid uid pid\<rbrakk> \<Longrightarrow> isRev' (tr@[_]) cid uid pid"
 
 lemma justify_rev:
   assumes "trace_to tr s"
   assumes "isRev s cid uid pid"
   shows "isRev' tr cid uid pid"
   using assms
 proof (induction)
   case empty thus ?case
     by (auto simp add: istate_def isRev_def)
 next
   case (step tr s a ou s')
 
   show ?case
   proof (cases "isRev s cid uid pid")
     case True with step.IH show ?thesis by (blast intro: isRev'.irrelevant)
   next
     case False note noRev = this
     with step.hyps step.prems obtain
       pass uid' where "(a=Cact (cReview cid uid' pass pid uid))"
       and "isChair s cid uid'"
       and [simp]: "ou=outOK"
       apply (cases a)
       subgoal for x1 apply (cases x1, auto simp add: c_defs isRev_def) [] .
       subgoal for x2 apply (cases x2, auto simp add: u_defs isRev_def) [] .
       subgoal for x3 apply (cases x3, auto simp add: uu_defs isRev_def) [] .
       by simp_all
     thus ?thesis
       apply -
       apply (rule isRev'.add_rev, auto simp: isChair_eq[OF \<open>trace_to tr s\<close>]) []
       done
   qed
 qed
 
 lemma rev_justify:
   assumes "trace_to tr s"
   assumes "isRev' tr cid uid pid"
   shows "isRev s cid uid pid"
   using assms
 proof (induction arbitrary: uid)
   case (empty s) thus ?case
     by (auto simp add: istate_def elim!: isRev'.cases)
 next
   case (step tr s a ou s')
   from step.prems
   show ?case
   proof (cases)
     case (add_rev _ uid' _ _ pass)
     hence [simp]: "a=Cact (cReview cid uid' pass pid uid)" "ou=outOK" by simp_all
     from step.hyps show ?thesis
       by (auto simp add: c_defs isRev_def)
   next
     case (irrelevant) with step.IH have REV: "isRev s cid uid pid" by simp
 
     note roles_confIDs[OF step.hyps(2)]
     with REV \<open>step s a = (ou, s')\<close> show ?thesis
       apply (cases a)
       subgoal for x1 apply (cases x1, auto simp: c_defs isRev_def) [] .
       subgoal for x2 apply (cases x2, auto simp: u_defs isRev_def) [] .
       subgoal for x3 apply (cases x3, auto simp: uu_defs isRev_def) [] .
       by simp_all
   qed
 qed
 
 theorem isRev_eq: "trace_to tr s \<Longrightarrow> isRev s cid uid pid = isRev' tr cid uid pid"
   (* "Trace-based equivalent of being a reviewer" *)
   using justify_rev rev_justify
   by (blast)
 
 
 
 subsection "Conflicts"
 
 fun irrev_conflict :: "userID \<Rightarrow> paperID \<Rightarrow> (state,act,out) trans \<Rightarrow> bool"
  (* "Transitions causing irrevokable conflicts" *)
 where
   "irrev_conflict uid pid (Trans _ (Cact (cPaper _ uid' _ pid' _ _)) outOK _)
     \<longleftrightarrow> uid'=uid \<and> pid'=pid"
 | "irrev_conflict uid pid (Trans _ (Cact (cAuthor _ _ _ pid' uid')) outOK _)
     \<longleftrightarrow> uid'=uid \<and> pid'=pid"
 | "irrev_conflict uid pid _ \<longleftrightarrow> False"
 
 fun set_conflict :: "userID \<Rightarrow> paperID \<Rightarrow> (state,act,out) trans \<Rightarrow> bool"
   (* "Transitions setting conflict state, can be revoked by later reset-actions" *)
   where
   "set_conflict uid pid (Trans _ (Cact (cConflict _ _ _ pid' uid')) outOK _)
     \<longleftrightarrow> uid'=uid \<and> pid'=pid"
 | "set_conflict uid pid (Trans _ (Uact (uPref _ uid' _ pid' Conflict)) outOK _)
     \<longleftrightarrow> uid'=uid \<and> pid'=pid"
 | "set_conflict _ _ _ \<longleftrightarrow> False"
 
 fun reset_conflict :: "userID \<Rightarrow> paperID \<Rightarrow> (state,act,out)trans \<Rightarrow> bool"
   (* "Transitions re-setting conflict state, can be revoked by later set-actions" *)
   where
   "reset_conflict uid pid (Trans _ (Uact (uPref _ uid' _ pid' pr)) outOK _)
     \<longleftrightarrow> uid'=uid \<and> pid'=pid \<and> pr\<noteq>Conflict"
 | "reset_conflict _ _ _ \<longleftrightarrow> False"
 
 definition conflict_trace :: "userID \<Rightarrow> paperID \<Rightarrow> (state,act,out) trans trace \<Rightarrow> bool"
   (* "Trace that causes a conflict: It contains either an irrevokable conflict action,
     or the last action concerning conflicts was set-conflict" *)
   where
   "conflict_trace uid pid tr \<equiv>
   (\<exists>trn\<in>set tr. irrev_conflict uid pid trn)
 \<or> (\<exists>tr1 trn tr2. tr=tr1@trn#tr2 \<and>
     set_conflict uid pid trn \<and> (\<forall>trn\<in>set tr2. \<not>reset_conflict uid pid trn))"
 
 lemma irrev_conflict_impl_author:
   assumes "trace_to tr s"
   assumes "\<exists>trn\<in>set tr. irrev_conflict uid pid trn"
   shows "\<exists>cid. isAut s cid uid pid"
   using assms
   apply induction
   apply (auto simp add: istate_def) []
   subgoal for _ _ a apply (cases a)
     subgoal for x1 apply (cases x1, auto simp: c_defs, (metis roles_confIDs)+) [] .
     subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
     subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
     by simp_all
   done
 
 lemma irrev_conflict_impl_conflict:
   assumes "trace_to tr s"
   assumes "\<exists>trn\<in>set tr. irrev_conflict uid pid trn"
   shows "pref s uid pid = Conflict"
   by (metis assms(1) assms(2) irrev_conflict_impl_author
     isAut_pref_Conflict reach_trace_to_conv)
 
 lemma conflict_justify:
   assumes TR: "trace_to tr s"
   assumes "conflict_trace uid pid tr"
   shows "pref s uid pid = Conflict"
   using assms(2)
   unfolding conflict_trace_def
 proof (cases rule: disjE[consumes 1, case_names irrev set])
   case irrev thus ?thesis by (simp add: irrev_conflict_impl_conflict[OF TR])
 next
   case set
   then obtain tr1 trn tr2 where
     [simp]: "tr = tr1 @ trn # tr2" and
     SET: "set_conflict uid pid trn"
     and NRESET: "\<forall>trn\<in>set tr2. \<not> reset_conflict uid pid trn"
     by blast
 
   from TR obtain s1 s2 a ou where
     [simp]: "trn = Trans s1 a ou s2" and
     TR1: "trace_to tr1 s1" and
     STEP: "step s1 a = (ou,s2)" and
     TR2: "trace_between s2 tr2 s"
     by (fastforce simp add: trace_to_ft trace_ft_simps)
 
   from STEP SET have "pref s2 uid pid = Conflict"
     apply (cases a)
       subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
       subgoal for x2 apply (cases x2, auto simp: u_defs) []
         subgoal for _ x65 apply (cases x65, auto) [] .
         subgoal for _ _ _ x65 apply (cases x65, auto) [] .
         subgoal for _ _ _ x65 apply (cases x65, auto) [] . .
       by simp_all
 
   with TR2 NRESET show ?thesis
     apply induction
     subgoal by simp
     subgoal for _ _ _ a apply (cases a)
       subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
       subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
       subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
       by simp_all
     done
 qed
 
 lemma justify_conflict:
   assumes TR: "trace_to tr s"
   assumes "pref s uid pid = Conflict"
   shows "conflict_trace uid pid tr"
   using assms
 proof induction
   case empty thus ?case by (auto simp add: istate_def)
 next
   case (step tr s a ou s')
 
   let ?trn = "Trans s a ou s'"
 
   show ?case proof (cases "pref s uid pid = Conflict")
     case False
     with step.prems \<open>step s a = (ou, s')\<close>
     have "irrev_conflict uid pid ?trn \<or> set_conflict uid pid ?trn"
       apply (cases a)
       subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
       subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
       subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
       by simp_all
     thus ?thesis
       unfolding conflict_trace_def by fastforce
   next
     case True with step.IH have CT: "conflict_trace uid pid tr" .
 
     from step.prems \<open>step s a = (ou, s')\<close> have "\<not>reset_conflict uid pid ?trn"
       apply (cases a)
       subgoal by simp
       subgoal for x2 by (cases x2, auto simp: u_defs)
       by simp_all
 
     thus ?thesis using CT
       unfolding conflict_trace_def
       apply clarsimp
       by (metis rotate1.simps(2) set_ConsD set_rotate1)
 
   qed
 qed
 
 theorem conflict_eq:
   assumes "trace_to tr s"
   shows "pref s uid pid = Conflict \<longleftrightarrow> conflict_trace uid pid tr"
   using assms conflict_justify justify_conflict by auto
 
 
 subsection \<open>Conference Phases\<close>
 
 fun is_uPhase where
   "is_uPhase cid (Trans _ (Uact (uConfA cid' _ _)) outOK _) \<longleftrightarrow> cid'=cid"
 | "is_uPhase cid (Trans _ (Uact (uPhase cid' _ _ _)) outOK _) \<longleftrightarrow> cid'=cid"
 | "is_uPhase _ _ \<longleftrightarrow> False"
 
 inductive phase' :: "(state,act,out) trans trace \<Rightarrow> confID \<Rightarrow> nat \<Rightarrow> bool" where
   initial: "phase' [] cid noPH"
 | approve: "\<lbrakk>phase' tr cid noPH; trn=Trans s (Uact (uConfA cid (voronkov s) _)) outOK _ \<rbrakk>
   \<Longrightarrow> phase' (tr@[trn]) cid setPH"
 | advance: "\<lbrakk>trn = (Trans _ (Uact (uPhase cid uid _ ph)) outOK _); isChair' tr cid uid\<rbrakk>
   \<Longrightarrow> phase' (tr@[trn]) cid ph"
 | irrelevant: "\<lbrakk>phase' tr cid ph; \<not>is_uPhase cid trn \<rbrakk> \<Longrightarrow> phase' (tr@[trn]) cid ph"
 
 lemma justify_phase:
   assumes "trace_to tr s"
   assumes "phase s cid = ph"
   shows "phase' tr cid ph"
   using assms
 proof (induction arbitrary: ph)
   case (empty s) thus ?case
     by (auto simp add: istate_def phase'.initial)
 next
   case (step tr s a ou s')
   thus ?case
     apply (cases a)
     subgoal for x1 apply (cases x1, auto simp: c_defs intro: phase'.advance phase'.irrelevant) [] .
     subgoal for x2 apply (cases x2,
       auto
         simp: u_defs isChair_eq
         intro: phase'.advance phase'.irrelevant phase'.approve,
       (fastforce intro: phase'.approve phase'.irrelevant phase'.advance)+
     ) [] .
 
     subgoal for x3 apply (cases x3, auto simp: uu_defs intro: phase'.irrelevant) [] .
     by (auto intro: phase'.advance phase'.irrelevant)
 qed
 
 lemma phase_justify:
   assumes "trace_to tr s"
   assumes "phase' tr cid ph"
   shows "phase s cid = ph"
   using assms
 proof (induction arbitrary: ph)
   case (empty s) thus ?case
     by (auto simp add: istate_def elim: phase'.cases)
 next
   case (step tr s a ou s')
   from step.prems
   show ?case
   proof (cases)
     case (approve _ _ _ pass _)
     hence [simp]: "a=Uact (uConfA cid (voronkov s) pass)" "ou=outOK" "ph=setPH" by simp_all
     from step.hyps show ?thesis
       by (auto simp add: u_defs)
   next
     case (advance _ _ uid pass _ _)
     hence [simp]: "a=Uact (uPhase cid uid pass ph)" "ou=outOK" by simp_all
     from step.hyps show ?thesis
       by (auto simp add: u_defs)
   next
     case (irrelevant) with step.IH have PH: "phase s cid = ph" "\<not> is_uPhase cid (Trans s a ou s')"
       by simp_all
 
     from PH \<open>step s a = (ou, s')\<close> show ?thesis
     apply (cases a)
     subgoal for x1 apply (cases x1, auto simp: c_defs) [] .
     subgoal for x2 apply (cases x2, auto simp: u_defs) [] .
     subgoal for x3 apply (cases x3, auto simp: uu_defs) [] .
     by simp_all
   qed auto
 qed
 
 theorem phase_eq:
   assumes "trace_to tr s"
   shows "phase s cid = ph \<longleftrightarrow> phase' tr cid ph"
   using assms phase_justify justify_phase by blast
 
 end
diff --git a/thys/CoSMeDis/Post_Confidentiality/Post_Observation_Setup_RECEIVER.thy b/thys/CoSMeDis/Post_Confidentiality/Post_Observation_Setup_RECEIVER.thy
--- a/thys/CoSMeDis/Post_Confidentiality/Post_Observation_Setup_RECEIVER.thy
+++ b/thys/CoSMeDis/Post_Confidentiality/Post_Observation_Setup_RECEIVER.thy
@@ -1,110 +1,110 @@
 theory Post_Observation_Setup_RECEIVER
   imports "../Safety_Properties"
 begin
 
 subsection \<open>Confidentiality for a secret receiver node\<close>
 
 text \<open>We verify that a group of users of a given node \<open>j\<close>
 can learn nothing about the updates to the content of a post
 \<open>PID\<close> located at a different node \<open>i\<close> beyond the
 existence of an update unless \<open>PID\<close> is being shared between
 the two nodes and one of the users is the admin at node \<open>j\<close> or becomes
-a remote friend of \<open>PID\<close>’s owner, or \<open>PID\<close> is marked as public.
+a remote friend of \<open>PID\<close>'s owner, or \<open>PID\<close> is marked as public.
 This is formulated as a BD Security
 property and is proved by unwinding.
 
 See \cite{cosmedis-SandP2017} for more details.
 \<close>
 
 subsubsection\<open>Observation setup\<close>
 
 (* *)
 type_synonym obs = "act * out"
 
 (* The observers are an arbitrary, but fixed set of users *)
 locale Fixed_UIDs = fixes UIDs :: "userID set"
 (* The secret is PID received from AID:  *)
 locale Fixed_PID = fixes PID :: "postID"
 locale Fixed_AID = fixes AID :: "apiID"
 
 locale ObservationSetup_RECEIVER = Fixed_UIDs + Fixed_PID + Fixed_AID
 begin
 
 (*  *)
 fun \<gamma> :: "(state,act,out) trans \<Rightarrow> bool" where
 "\<gamma> (Trans _ a _ _) \<longleftrightarrow>
    (\<exists> uid. userOfA a = Some uid \<and> uid \<in> UIDs)
    \<or>
    (\<exists>ca. a = COMact ca)
    \<or>
    (\<exists>uid p. a = Sact (sSys uid p))"
 
 (* Note: the passwords don't really have to be purged (since identity theft is not
 considered in the first place); however, purging passwords looks more sane. *)
 
 (* Purging the password in starting actions: *)
 fun sPurge :: "sActt \<Rightarrow> sActt" where
 "sPurge (sSys uid pwd) = sSys uid emptyPass"
 
 (* Purging communicating actions: user-password information is removed, and post content for PID
   is removed from the only kind of action that may contain such info: comReceivePost.
   Note: server-password info is not purged --todo: discuss this.  *)
 fun comPurge :: "comActt \<Rightarrow> comActt" where
  "comPurge (comSendServerReq uID p aID reqInfo) = comSendServerReq uID emptyPass aID reqInfo"
 |"comPurge (comConnectClient uID p aID sp) = comConnectClient uID emptyPass aID sp"
 (* *)
 |"comPurge (comReceivePost aID sp pID pst uID vs) =
   (let pst' = (if aID = AID \<and> pID = PID then emptyPost else pst)
    in comReceivePost aID sp pID pst' uID vs)"
 (* *)
 |"comPurge (comSendPost uID p aID pID) = comSendPost uID emptyPass aID pID"
 |"comPurge (comSendCreateOFriend uID p aID uID') = comSendCreateOFriend uID emptyPass aID uID'"
 |"comPurge (comSendDeleteOFriend uID p aID uID') = comSendDeleteOFriend uID emptyPass aID uID'"
 |"comPurge ca = ca"
 
 (* Note: No output purge here -- only for the issuer. *)
 
 fun g :: "(state,act,out)trans \<Rightarrow> obs" where
  "g (Trans _ (Sact sa) ou _) = (Sact (sPurge sa), ou)"
 |"g (Trans _ (COMact ca) ou _) = (COMact (comPurge ca), ou)"
 |"g (Trans _ a ou _) = (a,ou)"
 
 lemma comPurge_simps:
   "comPurge ca = comSendServerReq uID p aID reqInfo \<longleftrightarrow> (\<exists>p'. ca = comSendServerReq uID p' aID reqInfo \<and> p = emptyPass)"
   "comPurge ca = comReceiveClientReq aID reqInfo \<longleftrightarrow> ca = comReceiveClientReq aID reqInfo"
   "comPurge ca = comConnectClient uID p aID sp \<longleftrightarrow> (\<exists>p'. ca = comConnectClient uID p' aID sp \<and> p = emptyPass)"
   "comPurge ca = comConnectServer aID sp \<longleftrightarrow> ca = comConnectServer aID sp"
   "comPurge ca = comReceivePost aID sp pID pst' uID v \<longleftrightarrow> (\<exists>pst. ca = comReceivePost aID sp pID pst uID v \<and> pst' = (if pID = PID \<and> aID = AID then emptyPost else pst))"
   "comPurge ca = comSendPost uID p aID pID \<longleftrightarrow> (\<exists>p'. ca = comSendPost uID p' aID pID \<and> p = emptyPass)"
   "comPurge ca = comSendCreateOFriend uID p aID uID' \<longleftrightarrow> (\<exists>p'. ca = comSendCreateOFriend uID p' aID uID' \<and> p = emptyPass)"
   "comPurge ca = comReceiveCreateOFriend aID cp uID uID' \<longleftrightarrow> ca = comReceiveCreateOFriend aID cp uID uID'"
   "comPurge ca = comSendDeleteOFriend uID p aID uID' \<longleftrightarrow> (\<exists>p'. ca = comSendDeleteOFriend uID p' aID uID' \<and> p = emptyPass)"
   "comPurge ca = comReceiveDeleteOFriend aID cp uID uID' \<longleftrightarrow> ca = comReceiveDeleteOFriend aID cp uID uID'"
 by (cases ca; auto)+
 
 lemma g_simps:
   "g (Trans s a ou s') = (COMact (comSendServerReq uID p aID reqInfo), ou')
 \<longleftrightarrow> (\<exists>p'. a = COMact (comSendServerReq uID p' aID reqInfo) \<and> p = emptyPass \<and> ou = ou')"
   "g (Trans s a ou s') = (COMact (comReceiveClientReq aID reqInfo), ou')
 \<longleftrightarrow> a = COMact (comReceiveClientReq aID reqInfo) \<and> ou = ou'"
   "g (Trans s a ou s') = (COMact (comConnectClient uID p aID sp), ou')
 \<longleftrightarrow> (\<exists>p'. a = COMact (comConnectClient uID p' aID sp) \<and> p = emptyPass \<and> ou = ou')"
   "g (Trans s a ou s') = (COMact (comConnectServer aID sp), ou')
 \<longleftrightarrow> a = COMact (comConnectServer aID sp) \<and> ou = ou'"
   "g (Trans s a ou s') = (COMact (comReceivePost aID sp pID pst' uID v), ou')
 \<longleftrightarrow> (\<exists>pst. a = COMact (comReceivePost aID sp pID pst uID v) \<and> pst' = (if pID = PID \<and> aID = AID then emptyPost else pst) \<and> ou = ou')"
    "g (Trans s a ou s') = (COMact (comSendPost uID p aID nID), O_sendPost (aid, sp, pid, pst, own, v))
 \<longleftrightarrow> (\<exists>p'. a = COMact (comSendPost uID p' aID nID) \<and> p = emptyPass \<and> ou = O_sendPost (aid, sp, pid, pst, own, v))"
   "g (Trans s a ou s') = (COMact (comSendCreateOFriend uID p aID uID'), ou')
 \<longleftrightarrow> (\<exists>p'. a = (COMact (comSendCreateOFriend uID p' aID uID')) \<and> p = emptyPass \<and> ou = ou')"
   "g (Trans s a ou s') = (COMact (comReceiveCreateOFriend aID cp uID uID'), ou')
 \<longleftrightarrow> a = COMact (comReceiveCreateOFriend aID cp uID uID') \<and> ou = ou'"
   "g (Trans s a ou s') = (COMact (comSendDeleteOFriend uID p aID uID'), ou')
 \<longleftrightarrow> (\<exists>p'. a = COMact (comSendDeleteOFriend uID p' aID uID') \<and> p = emptyPass \<and> ou = ou')"
   "g (Trans s a ou s') = (COMact (comReceiveDeleteOFriend aID cp uID uID'), ou')
 \<longleftrightarrow> a = COMact (comReceiveDeleteOFriend aID cp uID uID') \<and> ou = ou'"
 by (cases a; auto simp: comPurge_simps ObservationSetup_RECEIVER.comPurge.simps)+
 
 end
 
 end
diff --git a/thys/CoSMed/Traceback_Properties/Post_Visibility_Traceback.thy b/thys/CoSMed/Traceback_Properties/Post_Visibility_Traceback.thy
--- a/thys/CoSMed/Traceback_Properties/Post_Visibility_Traceback.thy
+++ b/thys/CoSMed/Traceback_Properties/Post_Visibility_Traceback.thy
@@ -1,414 +1,414 @@
 theory Post_Visibility_Traceback
   imports Traceback_Intro
 begin
 
 consts PID :: postID
 consts VIS :: vis
 
 subsection \<open>Tracing Back Post Visibility Status\<close>
 
 text \<open>We prove the following traceback property:
 If, at some point \<open>t\<close> on a system trace, the visibility of a post \<open>PID\<close>
 has a value \<open>VIS\<close>, then one of the following holds:
 \begin{itemize}
 \item Either \<open>VIS\<close> is \<open>FriendV\<close> (i.e., friends-only) which is the default at post creation
-\item Or the post’s owner had issued a successful ``update visibility'' action setting the visibility to \<open>VIS\<close>,
+\item Or the post's owner had issued a successful ``update visibility'' action setting the visibility to \<open>VIS\<close>,
 and no other successful update actions to \<open>PID\<close>'s visibility occur
 between the time of that action and \<open>t\<close>.
 \end{itemize}
 
 This will be captured in the predicate \<open>proper\<close>, and the main theorem states that \<open>proper tr\<close>
 holds for any trace \<open>tr\<close> that leads to post \<open>PID\<close> acquiring visibility \<open>VIS\<close>.
 \<close>
 
 
 text \<open>\<open>SNC uidd trn\<close> means
 ``The transaction \<open>trn\<close> is a successful post creation by user \<open>uidd\<close>'' \<close>
 
 fun SNC :: "userID \<Rightarrow> (state,act,out) trans \<Rightarrow> bool" where
 "SNC uidd (Trans s (Cact (cPost uid p pid tit)) ou s') = (ou = outOK \<and> (uid,pid) = (uidd,PID))"
 |
 "SNC uidd _ = False"
 
 
 text \<open>\<open>SNVU uidd vvs trn\<close> means
 "The transaction \<open>trn\<close> is a successful post visibility update for \<open>PID\<close>, by user \<open>uidd\<close>, to value \<open>vvs\<close>'' \<close>
 
 fun SNVU :: "userID \<Rightarrow> vis \<Rightarrow> (state,act,out) trans \<Rightarrow> bool" where
 "SNVU uidd vvs (Trans s (Uact (uVisPost uid p pid vs)) ou s') =
    (ou = outOK \<and> (uid,pid) = (uidd,PID) \<and> vs = vvs)"
 |
 "SNVU uidd vvis _ = False"
 
 definition proper :: "(state,act,out) trans trace \<Rightarrow> bool" where
 "proper tr \<equiv>
  VIS = FriendV
  \<or>
  (\<exists> uid tr1 trn tr2 trnn tr3.
     tr = tr1 @ trn # tr2 @ trnn # tr3 \<and>
     SNC uid trn \<and> SNVU uid VIS trnn \<and> (\<forall> vis. never (SNVU uid vis) tr3))"
 
 (*  *)
 
 definition proper1 :: "(state,act,out) trans trace \<Rightarrow> bool" where
 "proper1 tr \<equiv>
  \<exists> tr2 trnn tr3.
     tr = tr2 @ trnn # tr3 \<and>
     SNVU (owner (srcOf trnn) PID) VIS trnn"
 
 lemma not_never_ex:
 assumes "\<not> never P xs"
 shows "\<exists> xs1 x xs2. xs = xs1 @ x # xs2 \<and> P x \<and> never P xs2"
 using assms proof(induct xs rule: rev_induct)
   case (Nil)
   thus ?case unfolding list_all_iff empty_iff by auto
 next
   case (snoc y ys)
   show ?case
   proof(cases "P y")
     case True thus ?thesis using snoc
     apply(intro exI[of _ ys]) apply(intro exI[of _ y] exI[of _ "[]"]) by auto
   next
     case False then obtain xs1 x xs2 where "ys = xs1 @ x # xs2 \<and> P x \<and> never P xs2"
     using snoc by auto
     thus ?thesis using snoc False
     apply(intro exI[of _ xs1]) apply(intro exI[of _ x] exI[of _ "xs2 ## y"]) by auto
   qed
 qed
 
 lemma SNVU_postIDs:
 assumes "validTrans trn" and "SNVU uid vs trn"
 shows "PID \<in>\<in> postIDs (srcOf trn)"
 proof(cases trn)
   case (Trans s a ou s')
   then show ?thesis
     using assms
     by (cases "a") (auto simp: all_defs elim: step_elims)
 qed
 
 lemma SNVU_visib:
 assumes "validTrans trn" and "SNVU uid vs trn"
 shows "vis (tgtOf trn) PID = vs"
 proof(cases trn)
   case (Trans s a ou s')
   then show ?thesis
     using assms
     by (cases "a") (auto simp: all_defs elim: step_elims)
 qed
 
 lemma owner_validTrans:
 assumes "validTrans trn" and "PID \<in>\<in> postIDs (srcOf trn)"
 shows "owner (srcOf trn) PID = owner (tgtOf trn) PID"
 proof(cases trn)
   case (Trans s a ou s')
   then show ?thesis
     using assms
     by (cases "a") (auto simp: all_defs elim: step_elims)
 qed
 
 lemma owner_valid:
 assumes "valid tr" and "PID \<in>\<in> postIDs (srcOf (hd tr))"
 shows "owner (srcOf (hd tr)) PID = owner (tgtOf (last tr)) PID"
 using assms using owner_validTrans IDs_mono validTrans by induct auto
 
 lemma SNVU_vis_validTrans:
 assumes "validTrans trn" and "PID \<in>\<in> postIDs (srcOf trn)"
 and "\<forall> vs. \<not> SNVU (owner (srcOf trn) PID) vs trn"
 shows "vis (srcOf trn) PID = vis (tgtOf trn) PID"
 proof(cases trn)
   case (Trans s a ou s')
   then show ?thesis
     using assms
     by (cases "a") (auto simp: all_defs elim: step_elims)
 qed
 
 lemma SNVU_vis_valid:
 assumes "valid tr" and "PID \<in>\<in> postIDs (srcOf (hd tr))"
 and "\<forall> vis. never (SNVU (owner (srcOf (hd tr)) PID) vis) tr"
 shows "vis (srcOf (hd tr)) PID = vis (tgtOf (last tr)) PID"
 using assms proof induct
   case (Singl)
   thus ?case using SNVU_vis_validTrans by auto
 next
   case (Cons trn tr)
   have n: "PID \<in>\<in> postIDs (srcOf (hd tr))"
   using Cons by (simp add: IDs_mono(2) validTrans)
   have v: "\<forall> vis. never (SNVU (owner (srcOf (hd tr)) PID) vis) tr"
   using Cons by (simp add: owner_validTrans)
   have "vis (srcOf trn) PID = vis (srcOf (hd tr)) PID"
   using Cons SNVU_vis_validTrans by auto
   also have "... = vis (tgtOf (last tr)) PID"
   using n v Cons(4) by auto
   finally show ?case using Cons by auto
 qed
 
 lemma proper1_never:
 assumes vtr: "valid tr" and PID: "PID \<in>\<in> postIDs (srcOf (hd tr))"
 and tr: "proper1 tr" and v: "vis (tgtOf (last tr)) PID = VIS"
 shows "\<exists> tr2 trnn tr3.
     tr = tr2 @ trnn # tr3 \<and>
     SNVU (owner (srcOf trnn) PID) VIS trnn \<and> (\<forall> vis. never (SNVU (owner (srcOf trnn) PID) vis) tr3)"
 proof-
   obtain tr2 trnn tr3 where
   tr: "tr = tr2 @ trnn # tr3" and SNVU: "SNVU (owner (srcOf trnn) PID) VIS trnn"
   using tr unfolding proper1_def by auto
   define uid where "uid \<equiv> owner (srcOf trnn) PID"
   show ?thesis
   proof(cases "never (\<lambda> trn. \<exists> vis. SNVU uid vis trn) tr3")
     case True thus ?thesis using tr SNVU unfolding uid_def list_all_iff by blast
   next
     case False
     from not_never_ex[OF this] obtain tr3a tr3n tr3b vs where tr3: "tr3 = tr3a @ tr3n # tr3b"
     and SNVUtr3n: "SNVU uid vs tr3n" and n: "\<forall> vs. never (SNVU uid vs) tr3b"
     unfolding list_all_iff by blast
     have trnn: "validTrans trnn" and
     tr3n: "validTrans tr3n" and vtr3: "valid tr3" using tr unfolding tr tr3
     by (metis Nil_is_append_conv append_self_conv2 list.distinct(1) tr tr3 valid_ConsE valid_append vtr)+
     hence PID_trnn: "PID \<in>\<in> postIDs (srcOf trnn)" and
     PID_tr3n: "PID \<in>\<in> postIDs (srcOf tr3n)" using SNVU_postIDs SNVU SNVUtr3n by auto
     have vvv: "valid (trnn # tr3a @ [tr3n])"
     using vtr unfolding tr tr3
     by (smt Nil_is_append_conv append_self_conv2 hd_append2 list.distinct(1) list.sel(1)
         valid_Cons_iff valid_append)
     hence PID_tr3n': "PID \<in>\<in> postIDs (tgtOf tr3n)" using tr3n SNVUtr3n
     by (simp add: IDs_mono(2) PID_tr3n validTrans)
     from owner_valid[OF vvv] PID_trnn
     have 000: "owner (tgtOf tr3n) PID = uid" unfolding uid_def by simp
     hence 0: "owner (srcOf tr3n) PID = uid" using PID_tr3n owner_validTrans tr3n by blast
     have 00: "vs = vis (tgtOf tr3n) PID" using SNVUtr3n tr3n SNVU_visib by auto
     have vis: "vs = VIS"
     proof(cases "tr3b = []")
       case True
       thus ?thesis using v 00 unfolding tr tr3 by simp
     next
       case False
       hence tgt: "tgtOf tr3n = srcOf (hd tr3b)" and tr3b: "valid tr3b" using vtr3 unfolding tr3
       apply (metis valid_append list.distinct(2) self_append_conv2 valid_ConsE)
       by (metis False append_self_conv2 list.distinct(1) tr3 valid_Cons_iff valid_append vtr3)
       show ?thesis unfolding 00 tgt
         using v False PID_tr3n'
         using SNVU_vis_valid[OF tr3b _ n[unfolded 000[symmetric] tgt]]
       unfolding tr tr3 tgt by simp
     qed
     show ?thesis apply(intro exI[of _ "tr2 @ trnn # tr3a"])
     apply(intro exI[of _ tr3n] exI[of _ tr3b])
     using SNVUtr3n n unfolding tr tr3 0 vis by simp
   qed
 qed
 
 
 (* *)
 
 lemma SNVU_validTrans:
 assumes "validTrans trn"
 and "PID \<in>\<in> postIDs (srcOf trn)"
 and "vis (srcOf trn) PID \<noteq> VIS"
 and "vis (tgtOf trn) PID = VIS"
 shows "SNVU (owner (srcOf trn) PID) VIS trn"
 proof(cases trn)
   case (Trans s a ou s')
   then show ?thesis
     using assms
     by (cases "a") (auto simp: all_defs elim: step_elims)
 qed
 
 lemma valid_mono_postID:
 assumes "valid tr"
 and "PID \<in>\<in> postIDs (srcOf (hd tr))"
 shows "PID \<in>\<in> postIDs (tgtOf (last tr))"
 using assms proof induct
   case (Singl trn)
   then show ?case using IDs_mono(2) by (cases trn) auto
 next
   case (Cons trn tr)
   then show ?case using IDs_mono(2) by (cases trn) auto
 qed
 
 lemma proper1_valid:
 assumes V: "VIS \<noteq> FriendV"
 and a: "valid tr"
 "PID \<in>\<in> postIDs (srcOf (hd tr))"
 "vis (srcOf (hd tr)) PID \<noteq> VIS"
 "vis (tgtOf (last tr)) PID = VIS"
 shows "proper1 tr"
 using a unfolding valid_valid2 proof induct
   case (Singl trn)
   then show ?case unfolding proper1_def using SNVU_validTrans
   by (intro exI[of _ "owner (srcOf trn) PID"] exI[of _ "[]"] exI[of _ trn]) auto
 next
   case (Rcons tr trn)
   hence "PID \<in>\<in> postIDs (srcOf (hd tr))" using Rcons by simp
   from valid_mono_postID[OF \<open>valid2 tr\<close>[unfolded valid2_valid] this]
   have "PID \<in>\<in> postIDs (tgtOf (last tr))" by simp
   hence 0: "PID \<in>\<in> postIDs (srcOf trn)" using Rcons by simp
   show ?case
   proof(cases "vis (srcOf trn) PID = VIS")
     case False
     hence "SNVU (owner (srcOf trn) PID) VIS trn"
     apply (intro SNVU_validTrans) using 0 Rcons by auto
     thus ?thesis unfolding proper1_def
     by (intro exI[of _ tr] exI[of _ trn] exI[of _ "[]"]) auto
   next
     case True
     hence "proper1 tr" using Rcons by auto
     then obtain trr trnn tr3 where
     tr: "tr = trr @ trnn # tr3" and SNVU: "SNVU (owner (srcOf trnn) PID) VIS trnn"
     unfolding proper1_def using V by auto
     have "vis (tgtOf trn) PID = VIS" using Rcons.prems by auto
     thus ?thesis
     using SNVU V unfolding proper1_def tr
     by(intro exI[of _ trr] exI[of _ trnn] exI[of _ "tr3 ## trn"]) auto
   qed
 qed
 
 lemma istate_postIDs:
 "\<not> PID \<in>\<in> postIDs istate"
 unfolding istate_def by simp
 
 
 (* *)
 
 definition proper2 :: "(state,act,out) trans trace \<Rightarrow> bool" where
 "proper2 tr \<equiv>
  \<exists> uid tr1 trn tr2.
     tr = tr1 @ trn # tr2 \<and> SNC uid trn"
 
 lemma SNC_validTrans:
 assumes "VIS \<noteq> FriendV" and "validTrans trn"
 and "\<not> PID \<in>\<in> postIDs (srcOf trn)"
 and "PID \<in>\<in> postIDs (tgtOf trn)"
 shows "\<exists> uid. SNC uid trn"
 proof(cases trn)
   case (Trans s a ou s')
   then show ?thesis
     using assms
     by (cases "a") (auto simp: all_defs elim: step_elims)
 qed
 
 lemma proper2_valid:
 assumes V: "VIS \<noteq> FriendV"
 and a: "valid tr"
 "\<not> PID \<in>\<in> postIDs (srcOf (hd tr))"
 "PID \<in>\<in> postIDs (tgtOf (last tr))"
 shows "proper2 tr"
 using a unfolding valid_valid2 proof induct
   case (Singl trn)
   then obtain uid where "SNC uid trn" using SNC_validTrans V by auto
   thus ?case unfolding proper2_def using SNC_validTrans
   by (intro exI[of _ uid] exI[of _ "[]"]  exI[of _ trn]) auto
 next
   case (Rcons tr trn)
   show ?case
   proof(cases "PID \<in>\<in> postIDs (srcOf trn)")
     case False
     then obtain uid where "SNC uid trn"
     using Rcons SNC_validTrans V by auto
     thus ?thesis unfolding proper2_def
     apply - apply (intro exI[of _ uid] exI[of _ tr]) by (intro exI[of _ trn] exI[of _ "[]"]) auto
   next
     case True
     hence "proper2 tr" using Rcons by auto
     then obtain uid tr1 trnn tr2 where
     tr: "tr = tr1 @ trnn # tr2" and SFRC: "SNC uid trnn"
     unfolding proper2_def by auto
     have "PID \<in>\<in> postIDs (tgtOf trn)" using V Rcons.prems by auto
     show ?thesis using SFRC unfolding proper2_def tr
     apply - apply (intro exI[of _ uid] exI[of _ tr1])
     by (intro exI[of _ trnn] exI[of _ "tr2 ## trn"]) simp
   qed
 qed
 
 lemma proper2_valid_istate:
 assumes V: "VIS \<noteq> FriendV"
 and a: "valid tr"
 "srcOf (hd tr) = istate"
 "PID \<in>\<in> postIDs (tgtOf (last tr))"
 shows "proper2 tr"
 using proper2_valid assms istate_postIDs by auto
 
 (* *)
 
 lemma SNC_visPost:
 assumes "VIS \<noteq> FriendV"
 and "validTrans trn" "SNC uid trn" and "reach (srcOf trn)"
 shows "vis (tgtOf trn) PID \<noteq> VIS"
 proof(cases trn)
   case (Trans s a ou s')
   then show ?thesis
     using assms
     apply (cases "a") apply (auto simp: all_defs elim: step_elims)
     subgoal for x2 apply(cases x2)
       using reach_not_postIDs_vis_FriendV
       by (auto simp: all_defs elim: step_elims) .
 qed
 
 lemma SNC_postIDs:
 assumes "validTrans trn" and "SNC uid trn"
 shows "PID \<in>\<in> postIDs (tgtOf trn)"
 proof(cases trn)
   case (Trans s a ou s')
   then show ?thesis
     using assms
     by (cases "a") (auto simp: all_defs elim: step_elims)
 qed
 
 lemma SNC_owner:
 assumes "validTrans trn" and "SNC uid trn"
 shows "uid = owner (tgtOf trn) PID"
 proof(cases trn)
   case (Trans s a ou s')
   then show ?thesis
     using assms
     by (cases "a") (auto simp: all_defs elim: step_elims)
 qed
 
 theorem post_accountability:
 assumes v: "valid tr" and i: "srcOf (hd tr) = istate"
 and PIDin: "PID \<in>\<in> postIDs (tgtOf (last tr))"
 and PID: "vis (tgtOf (last tr)) PID = VIS"
 shows "proper tr"
 proof(cases "VIS = FriendV")
   case True thus ?thesis unfolding proper_def by auto
 next
   case False
   have "proper2 tr" using proper2_valid_istate[OF False v i PIDin] .
   then obtain uid tr1 trn trr where
   tr: "tr = tr1 @ trn # trr" and SNC: "SNC uid trn" unfolding proper2_def by auto
   hence trn: "validTrans trn" and r: "reach (srcOf trn)" using v unfolding tr
     apply (metis list.distinct(2) self_append_conv2 valid_ConsE valid_append)
     by (metis (mono_tags, lifting) append_Cons hd_append i list.sel(1) reach.simps tr v valid_append valid_init_reach)
   hence N: "PID \<in>\<in> postIDs (tgtOf trn)" "vis (tgtOf trn) PID \<noteq> VIS"
   using SNC_postIDs SNC_visPost False SNC by auto
   hence trrNE: "trr \<noteq> []" and 1: "last tr = last trr" using PID unfolding tr by auto
   hence trr_v: "valid trr" using v unfolding tr
   by (metis valid_Cons_iff append_self_conv2 list.distinct(1) valid_append)
   have 0: "tgtOf trn = srcOf (hd trr)" using v trrNE unfolding tr
   by (metis valid_append list.distinct(2) self_append_conv2 valid_ConsE)
   have "proper1 trr" using proper1_valid[OF False trr_v N[unfolded 0] PID[unfolded 1]] .
   from proper1_never[OF trr_v N(1)[unfolded 0] this PID[unfolded 1]] obtain tr2 trnn tr3 where
   trr: "trr = tr2 @ trnn # tr3" and SNVU: "SNVU (owner (srcOf trnn) PID) VIS trnn"
   and vis: "\<forall> vis. never (SNVU (owner (srcOf trnn) PID) vis) tr3" by auto
   have 00: "srcOf (hd (tr2 @ [trnn])) = tgtOf trn" using v unfolding tr trr
   by (metis "0" append_self_conv2 hd_append2 list.sel(1) trr)
   have trnn: "validTrans trnn" using trr_v unfolding trr
   by (metis valid_Cons_iff append_self_conv2 list.distinct(1) valid_append)
   have vv: "valid (tr2 @ [trnn])"
   using v unfolding tr trr
   by (smt Nil_is_append_conv append_self_conv2 hd_append2 list.distinct(1) list.sel(1)
         valid_Cons_iff valid_append)
   have "uid = owner (tgtOf trn) PID" using SNC trn SNC_owner by auto
   also have "... = owner (tgtOf trnn) PID"
   using owner_valid[OF vv] N(1) unfolding 00 by simp
   also have "... = owner (srcOf trnn) PID"
   using SNVU trnn SNVU_postIDs owner_validTrans by auto
   finally have uid: "uid = owner (srcOf trnn) PID" .
   show ?thesis unfolding proper_def
   apply(rule disjI2)
   apply(intro exI[of _ uid] exI[of _ tr1])
   apply(rule exI[of _ trn], rule exI[of _ tr2])
   apply(intro exI[of _ trnn] exI[of _ tr3])
   using SNC SNVU vis unfolding tr trr uid by auto
 qed
 
 
 end
diff --git a/thys/Complete_Non_Orders/Fixed_Points.thy b/thys/Complete_Non_Orders/Fixed_Points.thy
--- a/thys/Complete_Non_Orders/Fixed_Points.thy
+++ b/thys/Complete_Non_Orders/Fixed_Points.thy
@@ -1,1236 +1,1236 @@
 (*
 Author:  Jérémy Dubut (2019-2021)
 Author:  Akihisa Yamada (2019-2021)
 License: LGPL (see file COPYING.LESSER)
 *)
 
 theory Fixed_Points
   imports Complete_Relations
 begin
 
 section \<open>Existence of Fixed Points in Complete Related Sets\<close>
 text \<open>\label{sec:qfp-exists}\<close>
 
 text \<open>The following proof is simplified and generalized from
   Stouti--Maaden \cite{SM13}. We construct some set whose extreme bounds 
   -- if they exist, typically when the underlying related set is complete -- 
   are fixed points of a monotone or inflationary function on any 
   related set. When the related set is attractive, those are actually the least fixed points.
   This generalizes \cite{SM13}, relaxing reflexivity and antisymmetry.\<close>
 
 locale fixed_point_proof = related_set +
   fixes f
   assumes f: "f ` A \<subseteq> A"
 begin
 
 sublocale less_eq_notations.
 
 definition AA where "AA \<equiv>
   {X. X \<subseteq> A \<and> f ` X \<subseteq> X \<and> (\<forall>Y s. Y \<subseteq> X \<longrightarrow> extreme_bound A (\<sqsubseteq>) Y s \<longrightarrow> s \<in> X)}"
 
 lemma AA_I:
   "X \<subseteq> A \<Longrightarrow> f ` X \<subseteq> X \<Longrightarrow> (\<And>Y s. Y \<subseteq> X \<Longrightarrow> extreme_bound A (\<sqsubseteq>) Y s \<Longrightarrow> s \<in> X) \<Longrightarrow> X \<in> AA"
   by (unfold AA_def, safe)
 
 lemma AA_E:
   "X \<in> AA \<Longrightarrow>
    (X \<subseteq> A \<Longrightarrow> f ` X \<subseteq> X \<Longrightarrow> (\<And>Y s. Y \<subseteq> X \<Longrightarrow> extreme_bound A (\<sqsubseteq>) Y s \<Longrightarrow> s \<in> X) \<Longrightarrow> thesis) \<Longrightarrow> thesis"
   by (auto simp: AA_def)
 
 definition C where "C \<equiv> \<Inter> AA"
 
 lemma A_AA: "A \<in> AA" by (auto intro!:AA_I f)
 
 lemma C_AA: "C \<in> AA"
 proof (intro AA_I)
   show "C \<subseteq> A" using C_def A_AA f by auto
   show "f ` C \<subseteq> C" unfolding C_def AA_def by auto
   fix B b assume B: "B \<subseteq> C" "extreme_bound A (\<sqsubseteq>) B b"
   { fix X assume X: "X \<in> AA"
     with B have "B \<subseteq> X" by (auto simp: C_def)
     with X B have "b\<in>X" by (auto elim!: AA_E)
   }
   then show "b \<in> C" by (auto simp: C_def AA_def)
 qed
 
 lemma CA: "C \<subseteq> A" using A_AA by (auto simp: C_def)
 
 lemma fC: "f ` C \<subseteq> C" using C_AA by (auto elim!: AA_E)
 
 context
   fixes c assumes Cc: "extreme_bound A (\<sqsubseteq>) C c"
 begin
 
 private lemma cA: "c \<in> A" using Cc by auto
 private lemma cC: "c \<in> C" using Cc C_AA by (blast elim!:AA_E) 
 private lemma fcC: "f c \<in> C" using cC AA_def C_AA by auto
 private lemma fcA: "f c \<in> A" using fcC CA by auto
 
 lemma qfp_as_extreme_bound:
   assumes infl_mono: "\<forall>x \<in> A. x \<sqsubseteq> f x \<or> (\<forall>y \<in> A. y \<sqsubseteq> x \<longrightarrow> f y \<sqsubseteq> f x)"
   shows "f c \<sim> c"
 proof (intro conjI bexI sympartpI)
   show "f c \<sqsubseteq> c" using fcC Cc by auto
   from infl_mono[rule_format, OF cA]
   show "c \<sqsubseteq> f c"
   proof (safe)
     text \<open>Monotone case:\<close>
     assume mono: "\<forall>b\<in>A. b \<sqsubseteq> c \<longrightarrow> f b \<sqsubseteq> f c"
     define D where "D \<equiv> {x \<in> C. x \<sqsubseteq> f c}"
     have "D \<in> AA"
     proof (intro AA_I)
       show "D \<subseteq> A" unfolding D_def C_def using A_AA f by auto
       have fxC: "x \<in> C \<Longrightarrow> x \<sqsubseteq> f c \<Longrightarrow> f x \<in> C" for x using C_AA by (auto simp: AA_def)
       show "f ` D \<subseteq> D"
       proof (unfold D_def, safe intro!: fxC)
         fix x assume xC: "x \<in> C"
         have "x \<sqsubseteq> c" "x \<in> A" using Cc xC CA by auto
         then show "f x \<sqsubseteq> f c" using mono by (auto dest:monotoneD)
       qed
       have DC: "D \<subseteq> C" unfolding D_def by auto
       fix B b assume BD: "B \<subseteq> D" and Bb: "extreme_bound A (\<sqsubseteq>) B b"
       have "B \<subseteq> C" using DC BD by auto
       then have bC: "b \<in> C" using C_AA Bb BD by (auto elim!: AA_E)
       have bfc: "\<forall>a\<in>B. a \<sqsubseteq> f c" using BD unfolding D_def by auto
       with f cA Bb
       have "b \<sqsubseteq> f c" by (auto simp: extreme_def image_subset_iff)
       with bC show "b \<in> D" unfolding D_def by auto
     qed
     then have "C \<subseteq> D" unfolding C_def by auto
     then show "c \<sqsubseteq> f c" using cC unfolding D_def by auto
   qed
 qed
 
 lemma extreme_qfp:
   assumes attract: "\<forall>q \<in> A. \<forall>x \<in> A. f q \<sim> q \<longrightarrow> x \<sqsubseteq> f q \<longrightarrow> x \<sqsubseteq> q"
     and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "extreme {q \<in> A. f q \<sim> q \<or> f q = q} (\<sqsupseteq>) c"
 proof-
   have fcc: "f c \<sim> c"
     apply (rule qfp_as_extreme_bound)
     using mono by (auto elim!: monotone_onE)
   define L where [simp]: "L \<equiv> {a \<in> A. \<forall>s \<in> A. (f s \<sim> s \<or> f s = s) \<longrightarrow> a \<sqsubseteq> s}"
   have "L \<in> AA"
   proof (unfold AA_def, intro CollectI conjI allI impI)
     show XA: "L \<subseteq> A" by auto  
     show "f ` L \<subseteq> L"
     proof safe
       fix x assume xL: "x \<in> L"
       show "f x \<in> L"
       proof (unfold L_def, safe)
         have xA: "x \<in> A" using xL by auto 
         then show fxA: "f x \<in> A" using f by auto
         { fix s assume sA: "s \<in> A" and sf: "f s \<sim> s \<or> f s = s"
           then have "x \<sqsubseteq> s" using xL sA sf by auto
           then have "f x \<sqsubseteq> f s" using mono fxA sA xA by (auto elim!:monotone_onE)}
         note fxfs = this
         { fix s assume sA: "s \<in> A" and sf: "f s \<sim> s"
           then show "f x \<sqsubseteq> s" using fxfs attract mono sf fxA sA xA by (auto elim!:monotone_onE)
         }
         { fix s assume sA: "s \<in> A" and sf: "f s = s"
           with fxfs[OF sA] show "f x \<sqsubseteq> s" by simp}
       qed 
     qed
     fix B b assume BL: "B \<subseteq> L" and b: "extreme_bound A (\<sqsubseteq>) B b"
     then have BA: "B \<subseteq> A" by auto
     with BL b have bA: "b \<in> A" by auto
     show "b \<in> L"
     proof (unfold L_def, safe intro!: bA)
       { fix s assume sA: "s \<in> A" and sf: "f s \<sim> s \<or> f s = s"
         have "bound B (\<sqsubseteq>) s" using sA BL b sf by auto
       }
       note Bs = this
       { fix s assume sA: "s \<in> A" and sf: "f s \<sim> s"
         with b sA Bs show "b \<sqsubseteq> s" by auto
       }
       { fix s assume sA: "s \<in> A" and sf: "f s = s"
         with b sA Bs show "b \<sqsubseteq> s" by auto
       }
     qed
   qed
   then have "C \<subseteq> L" by (simp add: C_def Inf_lower)
   with cC have "c \<in> L" by auto
   with L_def fcc
   show ?thesis by auto
 qed
 
 end
 
 lemma ex_qfp:
   assumes comp: "CC-complete A (\<sqsubseteq>)" and C: "C \<in> CC"
     and infl_mono: "\<forall>a \<in> A. a \<sqsubseteq> f a \<or> (\<forall>b \<in> A. b \<sqsubseteq> a \<longrightarrow> f b \<sqsubseteq> f a)"
   shows "\<exists>s \<in> A. f s \<sim> s"
   using qfp_as_extreme_bound[OF _  infl_mono] completeD[OF comp CA C] by auto
 
 lemma ex_extreme_qfp_fp:
   assumes comp: "CC-complete A (\<sqsubseteq>)" and C: "C \<in> CC"
     and attract: "\<forall>q \<in> A. \<forall>x \<in> A. f q \<sim> q \<longrightarrow> x \<sqsubseteq> f q \<longrightarrow> x \<sqsubseteq> q"
     and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "\<exists>c. extreme {q \<in> A. f q \<sim> q \<or> f q = q} (\<sqsupseteq>) c"
   using extreme_qfp[OF _ attract mono] completeD[OF comp CA C] by auto
 
 lemma ex_extreme_qfp:
   assumes comp: "CC-complete A (\<sqsubseteq>)" and C: "C \<in> CC"
     and attract: "\<forall>q \<in> A. \<forall>x \<in> A. f q \<sim> q \<longrightarrow> x \<sqsubseteq> f q \<longrightarrow> x \<sqsubseteq> q"
     and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "\<exists>c. extreme {q \<in> A. f q \<sim> q} (\<sqsupseteq>) c"
 proof-
   from completeD[OF comp CA C]
   obtain c where Cc: "extreme_bound A (\<sqsubseteq>) C c" by auto
   from extreme_qfp[OF Cc attract mono]
   have Qc: "bound {q \<in> A. f q \<sim> q} (\<sqsupseteq>) c" by auto
   have fcc: "f c \<sim> c"
     apply (rule qfp_as_extreme_bound[OF Cc])
     using mono by (auto simp: monotone_onD)
   from Cc CA have cA: "c \<in> A" by auto
   from Qc fcc cA show ?thesis by (auto intro!: exI[of _ c])
 qed
 
 end
 
 context
   fixes less_eq :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "\<sqsubseteq>" 50) and A :: "'a set" and f
   assumes f: "f ` A \<subseteq> A"
 begin
 
 interpretation less_eq_notations.
 interpretation fixed_point_proof A "(\<sqsubseteq>)" f using f by unfold_locales
 
 theorem complete_infl_mono_imp_ex_qfp:
   assumes comp: "UNIV-complete A (\<sqsubseteq>)" and infl_mono: "\<forall>a\<in>A. a \<sqsubseteq> f a \<or> (\<forall>b\<in>A. b \<sqsubseteq> a \<longrightarrow> f b \<sqsubseteq> f a)"
   shows "\<exists>s\<in>A. f s \<sim> s"
   apply (rule ex_qfp[OF comp _ infl_mono]) by auto
 
 end
 
 corollary (in antisymmetric) complete_infl_mono_imp_ex_fp:
   assumes comp: "UNIV-complete A (\<sqsubseteq>)" and f: "f ` A \<subseteq> A"
     and infl_mono: "\<forall>a\<in>A. a \<sqsubseteq> f a \<or> (\<forall>b\<in>A. b \<sqsubseteq> a \<longrightarrow> f b \<sqsubseteq> f a)"
   shows "\<exists>s \<in> A. f s = s"
 proof-
   interpret less_eq_notations.
   from complete_infl_mono_imp_ex_qfp[OF f comp infl_mono]
   obtain s where sA: "s \<in> A" and fss: "f s \<sim> s" by auto
   from f sA have fsA: "f s \<in> A" by auto
   have "f s = s" using antisym fsA sA fss by auto
   with sA show ?thesis by auto
 qed
 
 context semiattractive begin
 
 interpretation less_eq_notations.
 
 theorem complete_mono_imp_ex_extreme_qfp:
   assumes comp: "UNIV-complete A (\<sqsubseteq>)" and f: "f ` A \<subseteq> A"
     and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "\<exists>s. extreme {p \<in> A. f p \<sim> p} (\<sqsubseteq>) s"
 proof-
   interpret dual: fixed_point_proof A "(\<sqsupseteq>)" rewrites "dual.sym = (\<sim>)"
     using f by unfold_locales (auto intro!:ext)
   show ?thesis
     apply (rule dual.ex_extreme_qfp[OF complete_dual[OF comp] _ _ monotone_on_dual[OF mono]])
     apply simp
     using f sym_order_trans by blast
 qed
 
 end
 
 corollary (in antisymmetric) complete_mono_imp_ex_extreme_fp:
   assumes comp: "UNIV-complete A (\<sqsubseteq>)" and f: "f ` A \<subseteq> A"
     and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "\<exists>s. extreme {s \<in> A. f s = s} (\<sqsubseteq>)\<^sup>- s"
 proof-
   interpret less_eq_notations.
   interpret fixed_point_proof A "(\<sqsubseteq>)" f using f by unfold_locales
   have "\<exists>c. extreme {q \<in> A. f q \<sim> q \<or> f q = q} (\<sqsupseteq>) c"
     apply (rule ex_extreme_qfp_fp[OF comp _ _ mono])
     using antisym f by (auto dest: order_sym_trans)
   then obtain c where c: "extreme {q \<in> A. f q \<sim> q \<or> f q = q} (\<sqsupseteq>) c" by auto
   then have "f c = c" using antisym f by blast
   with c have "extreme {q \<in> A. f q = q} (\<sqsupseteq>) c" by auto
   then show ?thesis by auto
 qed
 
 section \<open>Fixed Points in Well-Complete Antisymmetric Sets\<close>
 text \<open>\label{sec:well-complete}\<close>
 
 text \<open>In this section, we prove that an
 inflationary or monotone map over a well-complete antisymmetric set
 has a fixed point.
 
 In order to formalize such a theorem in Isabelle,
 we followed Grall's~\cite{grall10} elementary proof for Bourbaki--Witt and Markowsky's theorems.
 His idea is to consider well-founded derivation trees over $A$,
 where from a set $C \subseteq A$ of premises
 one can derive $f\:(\bigsqcup C)$ if $C$ is a chain.
 The main observation is as follows:
 Let $D$ be the set of all the derivable elements; that is,
 for each $d \in D$ there exists a well-founded derivation
 whose root is $d$.
 It is shown that $D$ is a chain,
 and hence one can build a derivation yielding $f\:(\bigsqcup D)$,
 and $f\:(\bigsqcup D)$ is shown to be a fixed point.\<close>
 
 lemma bound_monotone_on:
   assumes mono: "monotone_on A r s f" and XA: "X \<subseteq> A" and aA: "a \<in> A" and rXa: "bound X r a"
   shows "bound (f`X) s (f a)"
 proof (safe)
   fix x assume xX: "x \<in> X" 
   from rXa xX have "r x a" by auto
   with xX XA mono aA show "s (f x) (f a)" by (auto elim!:monotone_onE)
 qed
 
 context fixed_point_proof begin
 
 text \<open>To avoid the usage of the axiom of choice, we carefully define derivations so that any derivable element
 determines its lower set. This led to the following definition:\<close>
 
 definition "derivation X \<equiv> X \<subseteq> A \<and> well_ordered_set X (\<sqsubseteq>) \<and>
   (\<forall>x \<in> X. let Y = {y \<in> X. y \<sqsubset> x} in
     (\<exists>y. extreme Y (\<sqsubseteq>) y \<and> x = f y) \<or>
     f ` Y \<subseteq> Y \<and> extreme_bound A (\<sqsubseteq>) Y x)"
 
 lemma assumes "derivation P"
   shows derivation_A: "P \<subseteq> A" and derivation_well_ordered: "well_ordered_set P (\<sqsubseteq>)"
   using assms by (auto simp: derivation_def)
 
 lemma derivation_cases[consumes 2, case_names suc lim]:
   assumes "derivation X" and "x \<in> X"
     and "\<And>Y y. Y = {y \<in> X. y \<sqsubset> x} \<Longrightarrow> extreme Y (\<sqsubseteq>) y \<Longrightarrow> x = f y \<Longrightarrow> thesis"
     and "\<And>Y. Y = {y \<in> X. y \<sqsubset> x} \<Longrightarrow> f ` Y \<subseteq> Y \<Longrightarrow> extreme_bound A (\<sqsubseteq>) Y x \<Longrightarrow> thesis"
   shows thesis
   using assms unfolding derivation_def Let_def by auto
 
 definition "derivable x \<equiv> \<exists>X. derivation X \<and> x \<in> X"
 
 lemma derivableI[intro?]: "derivation X \<Longrightarrow> x \<in> X \<Longrightarrow> derivable x" by (auto simp: derivable_def)
 lemma derivableE: "derivable x \<Longrightarrow> (\<And>P. derivation P \<Longrightarrow> x \<in> P \<Longrightarrow> thesis) \<Longrightarrow> thesis"
   by (auto simp: derivable_def)
 
 lemma derivable_A: "derivable x \<Longrightarrow> x \<in> A" by (auto elim: derivableE dest:derivation_A)
 
 lemma UN_derivations_eq_derivable: "(\<Union>{P. derivation P}) = {x. derivable x}"
   by (auto simp: derivable_def)
 
 context
   assumes ord: "antisymmetric A (\<sqsubseteq>)"
 begin
 
 interpretation antisymmetric using ord.
 
 lemma derivation_lim:
   assumes P: "derivation P" and fP: "f ` P \<subseteq> P" and Pp: "extreme_bound A (\<sqsubseteq>) P p"
   shows "derivation (P \<union> {p})"
 proof (cases "p \<in> P")
   case True
   with P show ?thesis by (auto simp: insert_absorb)
 next
   case pP: False
   interpret P: well_ordered_set P "(\<sqsubseteq>)" using derivation_well_ordered[OF P].
   have PA: "P \<subseteq> A" using derivation_A[OF P].
   from Pp have pA: "p \<in> A" by auto
   have bp: "bound P (\<sqsubseteq>) p" using Pp by auto
   then have pp: "p \<sqsubseteq> p" using Pp by auto
   have 1: "y \<in> P \<longrightarrow> {x. (x = p \<or> x \<in> P) \<and> x \<sqsubset> y} = {x \<in> P. x \<sqsubset> y}" for y
     using Pp by (auto dest:extreme_bound_bound)
   { fix x assume xP: "x \<in> P" and px: "p \<sqsubseteq> x"
     from xP Pp have "x \<sqsubseteq> p" by auto
     with px have "p = x" using xP PA pA by (auto intro!: antisym)
     with xP pP
     have "False" by auto
   }
   note 2 = this
   then have 3: "{x. (x = p \<or> x \<in> P) \<and> x \<sqsubset> p} = P" using Pp by (auto intro!: asympartpI)
   have wr: "well_ordered_set (P \<union> {p}) (\<sqsubseteq>)"
     apply (rule well_order_extend[OF P.well_ordered_set_axioms])
     using pp bp pP 2 by auto
   from P fP Pp
   show "derivation (P \<union> {p})" by (auto simp: derivation_def pA wr[simplified] 1 3)
 qed
 
 context
   assumes derivation_infl: "\<forall>X x y. derivation X \<longrightarrow> x \<in> X \<longrightarrow> y \<in> X \<longrightarrow> x \<sqsubseteq> y \<longrightarrow> x \<sqsubseteq> f y"
     and derivation_f_refl: "\<forall>X x. derivation X \<longrightarrow> x \<in> X \<longrightarrow> f x \<sqsubseteq> f x"
 begin
 
 lemma derivation_suc:
   assumes P: "derivation P" and Pp: "extreme P (\<sqsubseteq>) p" shows "derivation (P \<union> {f p})"
 proof (cases "f p \<in> P")
   case True
   with P show ?thesis by (auto simp: insert_absorb)
 next
   case fpP: False
   interpret P: well_ordered_set P "(\<sqsubseteq>)" using derivation_well_ordered[OF P].
   have PA: "P \<subseteq> A" using derivation_A[OF P].
   with Pp have pP: "p \<in> P" and pA: "p \<in> A" by auto
   with f have fpA: "f p \<in> A" by auto 
   from pP have pp: "p \<sqsubseteq> p" by auto
   from derivation_infl[rule_format, OF P pP pP pp] have "p \<sqsubseteq> f p".
   { fix x assume xP: "x \<in> P"
     then have xA: "x \<in> A" using PA by auto
     have xp: "x \<sqsubseteq> p" using xP Pp by auto
     from derivation_infl[rule_format, OF P xP pP this]
     have "x \<sqsubseteq> f p".
   }
   note Pfp = this
   then have bfp: "bound P (\<sqsubseteq>) (f p)" by auto
   { fix y assume yP: "y \<in> P"
     note yfp = Pfp[OF yP]
     { assume fpy: "f p \<sqsubseteq> y"
       with yfp have "f p = y" using yP PA pA fpA antisym by auto
       with yP fpP have "False" by auto
     }
     with Pfp yP have "y \<sqsubset> f p" by auto
   }
   note Pfp = this
   have 1: "\<And>y. y \<in> P \<longrightarrow> {x. (x = f p \<or> x \<in> P) \<and> x \<sqsubset> y} = {x \<in> P. x \<sqsubset> y}"
    and 2: "{x. (x = f p \<or> x \<in> P) \<and> x \<sqsubset> f p} = P" using Pfp by auto
   have wr: "well_ordered_set (P \<union> {f p}) (\<sqsubseteq>)"
     apply (rule well_order_extend[OF P.well_ordered_set_axioms singleton_well_ordered])
     using Pfp derivation_f_refl[rule_format, OF P pP] by auto
   from P Pp
   show "derivation (P \<union> {f p})" by (auto simp: derivation_def wr[simplified] 1 2 fpA)
 qed
 
 lemma derivable_closed:
   assumes x: "derivable x" shows "derivable (f x)"
 proof (insert x, elim derivableE)
   fix P
   assume P: "derivation P" and xP: "x \<in> P"
   note PA = derivation_A[OF P]
   then have xA: "x \<in> A" using xP by auto
   interpret P: well_ordered_set P "(\<sqsubseteq>)" using derivation_well_ordered[OF P].
   interpret P.asympartp: transitive P "(\<sqsubset>)" using P.asympartp_transitive.
   define Px where "Px \<equiv> {y. y \<in> P \<and> y \<sqsubset> x} \<union> {x}"
   then have PxP: "Px \<subseteq> P" using xP by auto
   have "x \<sqsubseteq> x" using xP by auto
   then have Pxx: "extreme Px (\<sqsubseteq>) x" using xP PA by (auto simp: Px_def)
   have wr: "well_ordered_set Px (\<sqsubseteq>)" using P.well_ordered_subset[OF PxP].
   { fix z y assume zPx: "z \<in> Px" and yP: "y \<in> P" and yz: "y \<sqsubset> z"
     then have zP: "z \<in> P" using PxP by auto
     have "y \<sqsubset> x"
     proof (cases "z = x")
       case True
       then show ?thesis using yz by auto
     next
       case False
       then have zx: "z \<sqsubset> x" using zPx by (auto simp: Px_def)
       from P.asympartp.trans[OF yz zx yP zP xP] show ?thesis.
     qed
   }
   then have 1: "\<And>z. z \<in> Px \<longrightarrow> {y \<in> Px. y \<sqsubset> z} = {y \<in> P. y \<sqsubset> z}" using Px_def by blast
   have Px: "derivation Px" using PxP PA P by (auto simp: wr derivation_def 1)
   from derivation_suc[OF Px Pxx]
   show ?thesis by (auto intro!: derivableI)
 qed
 
-text \<open>The following lemma is derived from Grall’s proof. We simplify the claim so that we
+text \<open>The following lemma is derived from Grall's proof. We simplify the claim so that we
 consider two elements from one derivation, instead of two derivations.\<close>
 
 lemma derivation_useful:
   assumes X: "derivation X" and xX: "x \<in> X" and yX: "y \<in> X" and xy: "x \<sqsubset> y"
   shows "f x \<sqsubseteq> y"
 proof-
   interpret X: well_ordered_set X "(\<sqsubseteq>)" using derivation_well_ordered[OF X].
   note XA = derivation_A[OF X]
   { fix x y assume xX: "x \<in> X" and yX: "y \<in> X"
     from xX yX have "(x \<sqsubset> y \<longrightarrow> f x \<sqsubseteq> y \<and> f x \<in> X) \<and> (y \<sqsubset> x \<longrightarrow> f y \<sqsubseteq> x \<and> f y \<in> X)"
     proof (induct x arbitrary: y)
       case (less x)
       note xX = \<open>x \<in> X\<close> and IHx = this(2)
       with XA have xA: "x \<in> A" by auto
       from \<open>y \<in> X\<close> show ?case
       proof (induct y)
         case (less y)
         note yX = \<open>y \<in> X\<close> and IHy = this(2)
         with XA have yA: "y \<in> A" by auto
         show ?case
         proof (rule conjI; intro impI)
           assume xy: "x \<sqsubset> y"
           from X yX
           show "f x \<sqsubseteq> y \<and> f x \<in> X"
           proof (cases rule:derivation_cases)
             case (suc Z z)
             with XA have zX: "z \<in> X" and zA: "z \<in> A" and zy: "z \<sqsubset> y" and yfz: "y = f z" by auto
             from xX zX show ?thesis
             proof (cases rule: X.comparable_three_cases)
               case xz: less
               with IHy[OF zX zy] have fxz: "f x \<sqsubseteq> z" and fxX: "f x \<in> X" by auto
               from derivation_infl[rule_format, OF X fxX zX fxz] have "f x \<sqsubseteq> y" by (auto simp: yfz)
               with fxX show ?thesis by auto
             next
               case eq
               with xX zX have "x = z" by auto
               with yX yfz show ?thesis by auto
             next
               case zx: greater
               with IHy[OF zX zy] yfz xy have False by auto
               then show ?thesis by auto
             qed
           next
             case (lim Z)
             note Z = \<open>Z = {z \<in> X. z \<sqsubset> y}\<close> and fZ = \<open>f ` Z \<subseteq> Z\<close>
             from xX xy have "x \<in> Z" by (auto simp: Z)
             with fZ have "f x \<in> Z" by auto
             then have "f x \<sqsubset> y" and "f x \<in> X" by (auto simp: Z)
             then show ?thesis by auto
           qed
         next
           assume yx: "y \<sqsubset> x"
           from X xX
           show "f y \<sqsubseteq> x \<and> f y \<in> X"
           proof (cases rule:derivation_cases)
             case (suc Z z)
             with XA have zX: "z \<in> X" and zA: "z \<in> A" and zx: "z \<sqsubset> x" and xfz: "x = f z" by auto
             from yX zX show ?thesis
             proof (cases rule: X.comparable_three_cases)
               case yz: less
               with IHx[OF zX zx yX] have fyz: "f y \<sqsubseteq> z" and fyX: "f y \<in> X" by auto
               from derivation_infl[rule_format, OF X fyX zX fyz] have "f y \<sqsubseteq> x" by (auto simp: xfz)
               with fyX show ?thesis by auto
             next
               case eq
               with yX zX have "y = z" by auto
               with xX xfz show ?thesis by auto
             next
               case greater
               with IHx[OF zX zx yX] xfz yx have False by auto
               then show ?thesis by auto
             qed
           next
             case (lim Z)
             note Z = \<open>Z = {z \<in> X. z \<sqsubset> x}\<close> and fZ = \<open>f ` Z \<subseteq> Z\<close>
             from yX yx have "y \<in> Z" by (auto simp: Z)
             with fZ have "f y \<in> Z" by auto
             then have "f y \<sqsubset> x" and "f y \<in> X" by (auto simp: Z)
             then show ?thesis by auto
           qed
         qed
       qed
     qed
   }
   with assms show "f x \<sqsubseteq> y" by auto
 qed
 
 text \<open>Next one is the main lemma of this section, stating that elements from two possibly different 
 derivations are comparable, and moreover the lower one is in the derivation of the upper one. 
-The latter claim, not found in Grall’s proof, is crucial in proving that the union of all 
+The latter claim, not found in Grall's proof, is crucial in proving that the union of all 
 derivations is well-related.\<close>
 
 lemma derivations_cross_compare:
   assumes X: "derivation X" and Y: "derivation Y" and xX: "x \<in> X" and yY: "y \<in> Y"
   shows "(x \<sqsubset> y \<and> x \<in> Y) \<or> x = y \<or> (y \<sqsubset> x \<and> y \<in> X)" 
 proof-
   { fix X Y x y
     assume X: "derivation X" and Y: "derivation Y" and xX: "x \<in> X" and yY: "y \<in> Y"
     interpret X: well_ordered_set X "(\<sqsubseteq>)" using derivation_well_ordered[OF X].
     interpret X.asympartp: transitive X "(\<sqsubset>)" using X.asympartp_transitive.
     interpret Y: well_ordered_set Y "(\<sqsubseteq>)" using derivation_well_ordered[OF Y].
     have XA: "X \<subseteq> A" using derivation_A[OF X].
     then have xA: "x \<in> A" using xX by auto
     with f have fxA: "f x \<in> A" by auto
     have YA: "Y \<subseteq> A" using derivation_A[OF Y].
     then have yA: "y \<in> A" using yY by auto
     with f have fyA: "f y \<in> A" by auto
     { fix Z
       assume Z: "Z = {z \<in> X. z \<sqsubset> x}"
         and fZ: "f ` Z \<subseteq> Z"
         and Zx: "extreme_bound A (\<sqsubseteq>) Z x"
         and IHx: "\<forall>z \<in> X. z \<sqsubset> x \<longrightarrow> (z \<sqsubset> y \<and> z \<in> Y) \<or> z = y \<or> (y \<sqsubset> z \<and> y \<in> X)"
       have "(y \<sqsubset> x \<and> y \<in> X) \<or> x \<sqsubseteq> y"
       proof (cases "\<exists>z \<in> Z. y \<sqsubset> z")
         case True
         then obtain z where zZ: "z \<in> Z" and yz: "y \<sqsubset> z" by auto
         from zZ Z have zX: "z \<in> X" and zx: "z \<sqsubset> x" by auto
         from IHx[rule_format, OF zX zx] yz have yX: "y \<in> X" by auto
         from X.asympartp.trans[OF yz zx yX zX xX] have "y \<sqsubset> x".
         with yX show ?thesis by auto
       next
         case False
         have "bound Z (\<sqsubseteq>) y"
         proof
           fix z assume "z \<in> Z"
           then have zX: "z \<in> X" and zx: "z \<sqsubset> x" and nyz: "\<not> y \<sqsubset> z" using Z False by auto
           with IHx[rule_format, OF zX zx] X show "z \<sqsubseteq> y" by auto
         qed
         with yA Zx have xy: "x \<sqsubseteq> y" by auto
         then show ?thesis by auto
       qed
     }
     note lim_any = this
     { fix z Z
       assume Z: "Z = {z \<in> X. z \<sqsubset> x}"
         and Zz: "extreme Z (\<sqsubseteq>) z"
         and xfz: "x = f z"
         and IHx: "(z \<sqsubset> y \<and> z \<in> Y) \<or> z = y \<or> (y \<sqsubset> z \<and> y \<in> X)"
       have zX: "z \<in> X" and zx: "z \<sqsubset> x" using Zz Z by (auto simp: extreme_def)
       then have zA: "z \<in> A" using XA by auto
       from IHx have "(y \<sqsubset> x \<and> y \<in> X) \<or> x \<sqsubseteq> y"
       proof (elim disjE conjE)
         assume zy: "z \<sqsubset> y" and zY: "z \<in> Y"
         from derivation_useful[OF Y zY yY zy] xfz have xy: "x \<sqsubseteq> y" by auto
         then show ?thesis by auto
       next
         assume zy: "z = y"
         then have "y \<sqsubset> x" using zx by auto
         with zy zX show ?thesis by auto
       next
         assume yz: "y \<sqsubset> z" and yX: "y \<in> X"
         from X.asympartp.trans[OF yz zx yX zX xX] have "y \<sqsubset> x".
         with yX show ?thesis by auto
       qed
     }
     note lim_any this
   }
   note lim_any = this(1) and suc_any = this(2)
   interpret X: well_ordered_set X "(\<sqsubseteq>)" using derivation_well_ordered[OF X].
   interpret Y: well_ordered_set Y "(\<sqsubseteq>)" using derivation_well_ordered[OF Y].
   have XA: "X \<subseteq> A" using derivation_A[OF X].
   have YA: "Y \<subseteq> A" using derivation_A[OF Y].
   from xX yY show ?thesis
   proof (induct x arbitrary: y)
     case (less x)
     note xX = \<open>x \<in> X\<close> and IHx = this(2)
     from xX XA f have xA: "x \<in> A" and fxA: "f x \<in> A" by auto
     from \<open>y \<in> Y\<close>
     show ?case
     proof (induct y)
       case (less y)
       note yY = \<open>y \<in> Y\<close> and IHy = less(2)
       from yY YA f have yA: "y \<in> A" and fyA: "f y \<in> A" by auto
       from X xX show ?case
       proof (cases rule: derivation_cases)
         case (suc Z z)
         note Z = \<open>Z = {z \<in> X. z \<sqsubset> x}\<close> and Zz = \<open>extreme Z (\<sqsubseteq>) z\<close> and xfz = \<open>x = f z\<close>
         then have zx: "z \<sqsubset> x" and zX: "z \<in> X" by auto
         note IHz = IHx[OF zX zx yY]
         have 1: "y \<sqsubset> x \<and> y \<in> X \<or> x \<sqsubseteq> y" using suc_any[OF X Y xX yY Z Zz xfz IHz] IHy by auto
         from Y yY show ?thesis
         proof (cases rule: derivation_cases)
           case (suc W w)
           note W = \<open>W = {w \<in> Y. w \<sqsubset> y}\<close> and Ww = \<open>extreme W (\<sqsubseteq>) w\<close> and yfw = \<open>y = f w\<close> 
           then have wY: "w \<in> Y" and wy: "w \<sqsubset> y" by auto
           have IHw: "w \<sqsubset> x \<and> w \<in> X \<or> w = x  \<or> x \<sqsubset> w \<and> x \<in> Y" using IHy[OF wY wy] by auto
           have "x \<sqsubset> y \<and> x \<in> Y \<or> y \<sqsubseteq> x" using suc_any[OF Y X yY xX W Ww yfw IHw] by auto
           with 1 show ?thesis using antisym xA yA by auto
         next
           case (lim W)
           note W = \<open>W = {w \<in> Y. w \<sqsubset> y}\<close> and fW = \<open>f ` W \<subseteq> W\<close> and Wy = \<open>extreme_bound A (\<sqsubseteq>) W y\<close>
           have "x \<sqsubset> y \<and> x \<in> Y \<or> y \<sqsubseteq> x" using lim_any[OF Y X yY xX W fW Wy] IHy by auto
           with 1 show ?thesis using antisym xA yA by auto
         qed
       next
         case (lim Z)
         note Z = \<open>Z = {z \<in> X. z \<sqsubset> x}\<close> and fZ = \<open>f ` Z \<subseteq> Z\<close> and Zx = \<open>extreme_bound A (\<sqsubseteq>) Z x\<close>
         have 1: "y \<sqsubset> x \<and> y \<in> X \<or> x \<sqsubseteq> y" using lim_any[OF X Y xX yY Z fZ Zx] IHx[OF _ _ yY] by auto
         from Y yY show ?thesis
         proof (cases rule: derivation_cases)
           case (suc W w)
           note W = \<open>W = {w \<in> Y. w \<sqsubset> y}\<close> and Ww = \<open>extreme W (\<sqsubseteq>) w\<close> and yfw = \<open>y = f w\<close>
           then have wY: "w \<in> Y" and wy: "w \<sqsubset> y" by auto
           have IHw: "w \<sqsubset> x \<and> w \<in> X \<or>  w = x  \<or>  x \<sqsubset> w \<and> x \<in> Y" using IHy[OF wY wy] by auto
           have "x \<sqsubset> y \<and> x \<in> Y \<or> y \<sqsubseteq> x" using suc_any[OF Y X yY xX W Ww yfw IHw] by auto
           with 1 show ?thesis using antisym xA yA by auto
         next
           case (lim W)
           note W = \<open>W = {w \<in> Y. w \<sqsubset> y}\<close> and fW = \<open>f ` W \<subseteq> W\<close> and Wy = \<open>extreme_bound A (\<sqsubseteq>) W y\<close>
           have "x \<sqsubset> y \<and> x \<in> Y \<or> y \<sqsubseteq> x" using lim_any[OF Y X yY xX W fW Wy] IHy by auto
           with 1 show ?thesis using antisym xA yA by auto
         qed
       qed
     qed
   qed
 qed
 
 interpretation derivable: well_ordered_set "{x. derivable x}" "(\<sqsubseteq>)"
 proof (rule well_ordered_set.intro)
   show "antisymmetric {x. derivable x} (\<sqsubseteq>)"
     apply unfold_locales by (auto dest: derivable_A antisym)
   show "well_related_set {x. derivable x} (\<sqsubseteq>)"
   apply (fold UN_derivations_eq_derivable)
   apply (rule closed_UN_well_related)
   by (auto dest: derivation_well_ordered derivations_cross_compare well_ordered_set.axioms)
 qed
 
 lemmas derivable_well_ordered = derivable.well_ordered_set_axioms
 lemmas derivable_total_ordered = derivable.total_ordered_set_axioms
 lemmas derivable_well_related = derivable.well_related_set_axioms
 
 lemma pred_unique:
   assumes X: "derivation X" and xX: "x \<in> X"
   shows "{z \<in> X. z \<sqsubset> x} = {z. derivable z \<and> z \<sqsubset> x}"
 proof
   { fix z assume "z \<in> X" and "z \<sqsubset> x"
     then have "derivable z \<and> z \<sqsubset> x" using X by (auto simp: derivable_def)
   }
   then show "{z \<in> X. z \<sqsubset> x} \<subseteq> {z. derivable z \<and> z \<sqsubset> x}" by auto
   { fix z assume "derivable z" and zx: "z \<sqsubset> x"
     then obtain Y where Y: "derivation Y" and zY: "z \<in> Y" by (auto simp: derivable_def)
     then have "z \<in> X" using derivations_cross_compare[OF X Y xX zY] zx by auto
   }
   then show "{z \<in> X. z \<sqsubset> x} \<supseteq> {z. derivable z \<and> z \<sqsubset> x}" by auto
 qed
 
 text \<open>The set of all derivable elements is itself a derivation.\<close>
 
 lemma derivation_derivable: "derivation {x. derivable x}"
   apply (unfold derivation_def)
   apply (safe intro!: derivable_A derivable.well_ordered_set_axioms elim!: derivableE)
   apply (unfold mem_Collect_eq pred_unique[symmetric])
   by (auto simp: derivation_def)
 
 text \<open>Finally, if the set of all derivable elements admits a supremum, then it is a fixed point.\<close>
 
 lemma
   assumes p: "extreme_bound A (\<sqsubseteq>) {x. derivable x} p"
   shows sup_derivable_qfp: "f p \<sim> p" and sup_derivable_fp: "f p = p"
 proof (intro antisym sympartpI)
   define P where "P \<equiv> {x. derivable x}"
   have pA: "p \<in> A" using p by auto
   have P: "derivation P" using derivation_derivable by (simp add: P_def)
   from derivable_closed have fP: "f ` P \<subseteq> P" by (auto simp: P_def)
   from derivation_lim[OF P fP] p
   have pP: "p \<in> P" by (auto simp: P_def intro:derivableI)
   with fP have "f p \<in> P" by auto
   with p show fpp: "f p \<sqsubseteq> p" by (auto simp: P_def)
   show pfp: "p \<sqsubseteq> f p" apply (rule derivation_infl[rule_format, OF P]) using pP by (auto simp: P_def)
   from fpp pfp p f show "f p = p" by (auto intro!: antisym)
 qed
 
 end
 
 text "The assumptions are satisfied by monotone functions."
 
 context
   assumes mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
 begin
 
 lemma mono_imp_derivation_infl:
   "\<forall>X x y. derivation X \<longrightarrow> x \<in> X \<longrightarrow> y \<in> X \<longrightarrow> x \<sqsubseteq> y \<longrightarrow> x \<sqsubseteq> f y"
 proof (intro allI impI)
   fix X x y
   assume X: "derivation X" and xX: "x \<in> X" and yX: "y \<in> X" and xy: "x \<sqsubseteq> y"
   interpret X: well_ordered_set X "(\<sqsubseteq>)" using derivation_well_ordered[OF X].
   note XA = derivation_A[OF X]
   from xX yX xy show "x \<sqsubseteq> f y"
   proof (induct x)
     case (less x)
     note IH = this(2) and xX = \<open>x \<in> X\<close> and yX = \<open>y \<in> X\<close> and xy = \<open>x \<sqsubseteq> y\<close>
     from xX yX XA have xA: "x \<in> A" and yA: "y \<in> A" by auto
     from X xX show ?case
     proof (cases rule: derivation_cases)
       case (suc Z z)
       then have zX: "z \<in> X" and zsx: "z \<sqsubset> x" and xfz: "x = f z" by auto
       then have zx: "z \<sqsubseteq> x" by auto
       from X.trans[OF zx xy zX xX yX] have zy: "z \<sqsubseteq> y".
       from zX XA have zA: "z \<in> A" by auto
       from zy monotone_onD[OF mono] zA yA xfz show "x \<sqsubseteq> f y" by auto
     next
       case (lim Z)
       note Z = \<open>Z = {z \<in> X. z \<sqsubset> x}\<close> and Zx = \<open>extreme_bound A (\<sqsubseteq>) Z x\<close>
       from f yA have fyA: "f y \<in> A" by auto
       have "bound Z (\<sqsubseteq>) (f y)"
       proof
         fix z assume zZ: "z \<in> Z"
         with Z xX have zsx: "z \<sqsubset> x" and zX: "z \<in> X" by auto
         then have zx: "z \<sqsubseteq> x" by auto
         from X.trans[OF zx xy zX xX yX] have zy: "z \<sqsubseteq> y".
         from IH[OF zX zsx yX] zy show "z \<sqsubseteq> f y" by auto
       qed
       with Zx fyA show ?thesis by auto
     qed
   qed
 qed
 
 lemma mono_imp_derivation_f_refl:
   "\<forall>X x. derivation X \<longrightarrow> x \<in> X \<longrightarrow> f x \<sqsubseteq> f x"
 proof (intro allI impI)
   fix X x
   assume X: "derivation X" and xX: "x \<in> X"
   interpret X: well_ordered_set X "(\<sqsubseteq>)" using derivation_well_ordered[OF X].
   note XA = derivation_A[OF X]
   from xX have "x \<sqsubseteq> x" by auto
   from monotone_onD[OF mono this] xX XA show "f x \<sqsubseteq> f x" by auto
 qed
 
 corollary mono_imp_sup_derivable_fp:
   assumes p: "extreme_bound A (\<sqsubseteq>) {x. derivable x} p"
   shows "f p = p"
   by (simp add: sup_derivable_fp[OF mono_imp_derivation_infl mono_imp_derivation_f_refl p])
 
 lemma mono_imp_sup_derivable_lfp:
   assumes p: "extreme_bound A (\<sqsubseteq>) {x. derivable x} p"
   shows "extreme {q \<in> A. f q = q} (\<sqsupseteq>) p"
 proof (safe intro!: extremeI)
   from p show "p \<in> A" by auto
   from sup_derivable_fp[OF mono_imp_derivation_infl mono_imp_derivation_f_refl p]
   show "f p = p".
   fix q assume qA: "q \<in> A" and fqq: "f q = q"
   have "bound {x. derivable x} (\<sqsubseteq>) q"
   proof (safe intro!: boundI elim!:derivableE)
     fix x X
     assume X: "derivation X" and xX: "x \<in> X"
     from X interpret well_ordered_set X "(\<sqsubseteq>)" by (rule derivation_well_ordered)
     from xX show "x \<sqsubseteq> q"
     proof (induct x)
       case (less x)
       note xP = this(1) and IH = this(2)
       with X show ?case
       proof (cases rule: derivation_cases)
         case (suc Z z)
         with IH[of z] have zq: "z \<sqsubseteq> q" and zX: "z \<in> X" by auto
         from monotone_onD[OF mono zq] zX qA derivation_A[OF X]
         show ?thesis by (auto simp: fqq suc)
       next
         case lim
         with IH have "bound {z \<in> X. z \<sqsubset> x} (\<sqsubseteq>) q" by auto
         with lim qA show ?thesis by auto
       qed
     qed
   qed
   with p qA show "p \<sqsubseteq> q" by auto
 qed
 
 lemma mono_imp_ex_least_fp:
   assumes comp: "well_complete A (\<sqsubseteq>)"
   shows "\<exists>p. extreme {q \<in> A. f q = q} (\<sqsupseteq>) p"
 proof-
   interpret fixed_point_proof using f by unfold_locales
   note as = antisymmetric_axioms
   note infl = mono_imp_derivation_infl
   note refl = mono_imp_derivation_f_refl
   have wr: "well_related_set {x. derivable x} (\<sqsubseteq>)"
     using derivable_well_related[OF infl refl].
   have "\<exists>p. extreme_bound A (\<sqsubseteq>) {x. derivable x} p"
     apply (rule completeD[OF comp])
     using derivable_A wr by auto
   then obtain p where p: "extreme_bound A (\<sqsubseteq>) {x. derivable x} p" by auto
   from p mono_imp_sup_derivable_lfp[OF p] sup_derivable_qfp[OF infl refl p]
   show ?thesis by auto
 qed
 
 end
 
 end
 
 end
 
 text \<open>Bourbaki-Witt Theorem on well-complete pseudo-ordered set:\<close>
 theorem (in pseudo_ordered_set) well_complete_infl_imp_ex_fp:
   assumes comp: "well_complete A (\<sqsubseteq>)"
     and f: "f ` A \<subseteq> A" and infl: "\<forall>x \<in> A. \<forall>y \<in> A. x \<sqsubseteq> y \<longrightarrow> x \<sqsubseteq> f y"
   shows "\<exists>p \<in> A. f p = p"
 proof-
   note as = antisymmetric_axioms
   interpret fixed_point_proof using f by unfold_locales
   have dinfl: "\<forall>X x y. derivation X \<longrightarrow> x \<in> X \<longrightarrow> y \<in> X \<longrightarrow> x \<sqsubseteq> y \<longrightarrow> x \<sqsubseteq> f y"
     using infl by (auto dest!:derivation_A)
   have drefl: "\<forall>X x. derivation X \<longrightarrow> x \<in> X \<longrightarrow> f x \<sqsubseteq> f x" using f by (auto dest!: derivation_A)
   have "\<exists>p. extreme_bound A (\<sqsubseteq>) {x. derivable x} p"
     apply (rule completeD[OF comp])
     using derivable_well_related[OF as dinfl drefl] derivable_A by auto
   with sup_derivable_fp[OF as dinfl drefl]
   show ?thesis by auto
 qed
 
 
 section \<open>Completeness of (Quasi-)Fixed Points\<close>
 
 text \<open>We now prove that, under attractivity, the set of quasi-fixed points is complete.\<close>
 
 definition setwise where "setwise r X Y \<equiv> \<forall>x\<in>X. \<forall>y\<in>Y. r x y"
 
 lemmas setwiseI[intro] = setwise_def[unfolded atomize_eq, THEN iffD2, rule_format]
 lemmas setwiseE[elim] = setwise_def[unfolded atomize_eq, THEN iffD1, elim_format, rule_format]
 
 context fixed_point_proof begin
 
 abbreviation setwise_less_eq (infix "\<sqsubseteq>\<^sup>s" 50) where "(\<sqsubseteq>\<^sup>s) \<equiv> setwise (\<sqsubseteq>)"
 
 subsection \<open>Least Quasi-Fixed Points for Attractive Relations.\<close>
 
 lemma attract_mono_imp_least_qfp:
   assumes attract: "attractive A (\<sqsubseteq>)"
     and comp: "well_complete A (\<sqsubseteq>)"
     and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "\<exists>c. extreme {p \<in> A. f p \<sim> p \<or> f p = p} (\<sqsupseteq>) c \<and> f c \<sim> c"
 proof-
   interpret attractive using attract by auto
   interpret sym: transitive A "(\<sim>)" using sym_transitive.
   define ecl ("[_]\<^sub>\<sim>") where "[x]\<^sub>\<sim> \<equiv> {y \<in> A. x \<sim> y} \<union> {x}" for x
   define Q where "Q \<equiv> {[x]\<^sub>\<sim> |. x \<in> A}"
   { fix X x assume XQ: "X \<in> Q" and xX: "x \<in> X"
     then have XA: "X \<subseteq> A" by (auto simp: Q_def ecl_def)
     then have xA: "x \<in> A" using xX by auto
     obtain q where qA: "q \<in> A" and X: "X = [q]\<^sub>\<sim>" using XQ by (auto simp: Q_def)
     have xqqx: "x \<sim> q \<or> x = q" using X xX by (auto simp: ecl_def)
     {fix y assume yX: "y \<in> X"
       then have yA: "y \<in> A" using XA by auto
       have "y \<sim> q \<or> y = q" using yX X by (auto simp: ecl_def)
       then have "x \<sim> y \<or> y = x" using sym_order_trans xqqx xA qA yA by blast
     }
     then have 1: "X \<subseteq> [x]\<^sub>\<sim>" using X qA by (auto simp: ecl_def)
     { fix y assume "y \<in> A" and "x \<sim> y \<or> y = x"
       then have "q \<sim> y \<or> y = q" using sym_order_trans xqqx xA qA by blast
     }
     then have 2: "X \<supseteq> [x]\<^sub>\<sim>" using X xX by (auto simp: ecl_def)
     from 1 2 have "X = [x]\<^sub>\<sim>" by auto
   }
   then have XQx: "\<forall>X \<in> Q. \<forall>x \<in> X. X = [x]\<^sub>\<sim>" by auto
   have RSLE_eq: "X \<in> Q \<Longrightarrow> Y \<in> Q \<Longrightarrow> x \<in> X \<Longrightarrow> y \<in> Y \<Longrightarrow> x \<sqsubseteq> y \<Longrightarrow> X \<sqsubseteq>\<^sup>s Y" for X Y x y
   proof-
     assume XQ: "X \<in> Q" and YQ: "Y \<in> Q" and xX: "x \<in> X" and yY: "y \<in> Y" and xy: "x \<sqsubseteq> y"
     then have XA: "X \<subseteq> A" and YA: "Y \<subseteq> A" by (auto simp: Q_def ecl_def)
     then have xA: "x \<in> A" and yA: "y \<in> A" using xX yY by auto
     { fix xp yp assume xpX: "xp \<in> X" and ypY: "yp \<in> Y"
       then have xpA: "xp \<in> A" and ypA: "yp \<in> A" using XA YA by auto
       then have "xp \<sim> x \<or> xp = x" using xpX XQx xX XQ by (auto simp: ecl_def)
       then have xpy: "xp \<sqsubseteq> y" using attract[OF _ _ xy xpA xA yA] xy by blast
       have "yp \<sim> y \<or> yp = y" using ypY XQx yY YQ by (auto simp: ecl_def)
       then have "xp \<sqsubseteq> yp" using dual.attract[OF _ _ xpy ypA yA xpA] xpy by blast
     }
     then show "X \<sqsubseteq>\<^sup>s Y" using XQ YQ XA YA by auto
   qed
   have compQ: "well_complete Q (\<sqsubseteq>\<^sup>s)"
   proof (intro completeI, safe)
     fix XX assume XXQ: "XX \<subseteq> Q" and XX: "well_related_set XX (\<sqsubseteq>\<^sup>s)"
     have BA: "\<Union>XX \<subseteq> A" using XXQ by (auto simp: Q_def ecl_def)
     from XX interpret XX: well_related_set XX "(\<sqsubseteq>\<^sup>s)".
     interpret UXX: semiattractive "\<Union>XX" "(\<sqsubseteq>)" by (rule semiattractive_subset[OF BA])
     have "well_related_set (\<Union>XX) (\<sqsubseteq>)"
     proof(unfold_locales)
       fix Y assume YXX: "Y \<subseteq> \<Union>XX" and Y0: "Y \<noteq> {}"
       have "{X \<in> XX. X \<inter> Y \<noteq> {}} \<noteq> {}" using YXX Y0 by auto
       from XX.nonempty_imp_ex_extreme[OF _ this]
       obtain E where E: "extreme {X \<in> XX. X \<inter> Y \<noteq> {}} (\<sqsubseteq>\<^sup>s)\<^sup>- E" by auto
       then have "E \<inter> Y \<noteq> {}" by auto
       then obtain e where eE: "e \<in> E" and eX: "e \<in> Y" by auto
       have "extreme Y (\<sqsupseteq>) e"
       proof (intro extremeI eX)
         fix x assume xY: "x \<in> Y"
         with YXX obtain X where XXX: "X \<in> XX" and xX: "x \<in> X" by auto
         with xY E XXX have "E \<sqsubseteq>\<^sup>s X" by auto
         with eE xX show "e \<sqsubseteq> x" by auto
       qed
       then show "\<exists>e. extreme Y (\<sqsupseteq>) e" by auto
     qed
     with completeD[OF comp BA]
     obtain b where extb: "extreme_bound A (\<sqsubseteq>) (\<Union>XX) b" by auto
     then have bb: "b \<sqsubseteq> b" using extreme_def bound_def by auto
     have bA: "b \<in> A" using extb extreme_def by auto
     then have XQ: "[b]\<^sub>\<sim> \<in> Q" using Q_def bA by auto
     have bX: "b \<in> [b]\<^sub>\<sim>" by (auto simp: ecl_def)
     have "extreme_bound Q (\<sqsubseteq>\<^sup>s) XX [b]\<^sub>\<sim>"
     proof(intro extreme_boundI)
       show "[b]\<^sub>\<sim> \<in> Q" using XQ.
     next
       fix Y assume YXX: "Y \<in> XX"
       then have YQ: "Y \<in> Q" using XXQ by auto
       then obtain y where yA: "y \<in> A" and Yy: "Y = [y]\<^sub>\<sim>" by (auto simp: Q_def)
       then have yY: "y \<in> Y" by (auto simp: ecl_def)
       then have "y \<in> \<Union>XX" using yY YXX by auto
       then have "y \<sqsubseteq> b" using extb by auto
       then show "Y \<sqsubseteq>\<^sup>s [b]\<^sub>\<sim>" using RSLE_eq[OF YQ XQ yY bX] by auto
     next
       fix Z assume boundZ: "bound XX (\<sqsubseteq>\<^sup>s) Z" and ZQ: "Z \<in> Q"
       then obtain z where zA: "z \<in> A" and Zz: "Z = [z]\<^sub>\<sim>" by (auto simp: Q_def)
       then have zZ: "z \<in> Z" by (auto simp: ecl_def)
       { fix y assume "y \<in> \<Union>XX"
         then obtain Y where yY: "y \<in> Y" and YXX: "Y \<in> XX" by auto
         then have YA: "Y \<subseteq> A" using XXQ Q_def by (auto simp: ecl_def)
         then have "Y \<sqsubseteq>\<^sup>s Z" using YXX boundZ bound_def by auto
         then have "y \<sqsubseteq> z" using yY zZ by auto
       }
       then have "bound (\<Union>XX) (\<sqsubseteq>) z" by auto
       then have "b \<sqsubseteq> z" using extb zA by auto
       then show "[b]\<^sub>\<sim> \<sqsubseteq>\<^sup>s Z" using RSLE_eq[OF XQ ZQ bX zZ] by auto
     qed
     then show "Ex (extreme_bound Q (\<sqsubseteq>\<^sup>s) XX)" by auto
   qed
   interpret Q: antisymmetric Q "(\<sqsubseteq>\<^sup>s)"
   proof
     fix X Y assume XY: "X \<sqsubseteq>\<^sup>s Y" and YX: "Y \<sqsubseteq>\<^sup>s X" and XQ: "X \<in> Q" and YQ: "Y \<in> Q"
     then obtain q where qA: "q \<in> A" and X: "X = [q]\<^sub>\<sim>" using Q_def by auto
     then have qX: "q \<in> X" using X by (auto simp: ecl_def)
     then obtain p where pA: "p \<in> A" and Y: "Y = [p]\<^sub>\<sim>" using YQ Q_def by auto
     then have pY: "p \<in> Y" using X by (auto simp: ecl_def)
     have pq: "p \<sqsubseteq> q" using  XQ YQ YX qX pY by auto
     have "q \<sqsubseteq> p" using XQ YQ XY qX pY by auto
     then have "p \<in> X" using pq X pA by (auto simp: ecl_def)
     then have "X = [p]\<^sub>\<sim>" using XQ XQx by auto
     then show "X = Y" using Y by (auto simp: ecl_def)
   qed
   define F where "F X \<equiv> {y \<in> A. \<exists>x \<in> X. y \<sim> f x} \<union> f ` X" for X
   have XQFXQ: "\<And>X. X \<in> Q \<Longrightarrow> F X \<in> Q"
   proof-
     fix X assume XQ: "X \<in> Q"
     then obtain x where xA: "x \<in> A" and X: "X = [x]\<^sub>\<sim>" using Q_def by auto
     then have xX: "x \<in> X" by (auto simp: ecl_def)
     have fxA: "f x \<in> A" using xA f by auto
     have FXA: "F X \<subseteq> A" using f fxA X by (auto simp: F_def ecl_def)
     have "F X = [f x]\<^sub>\<sim>"
     proof (unfold X, intro equalityI subsetI)
       fix z assume zFX: "z \<in> F [x]\<^sub>\<sim>"
       then obtain y where yX: "y \<in> [x]\<^sub>\<sim>" and zfy: "z \<sim> f y \<or> z = f y" by (auto simp: F_def)
       have yA: "y \<in> A" using yX xA by (auto simp: ecl_def)
       with f have fyA: "f y \<in> A" by auto
       have zA: "z \<in> A" using zFX FXA by (auto simp: X)
       have "y \<sim> x \<or> y = x" using X yX by (auto simp: ecl_def)
       then have "f y \<sim> f x \<or> f y = f x" using mono xA yA by (auto simp: monotone_on_def)
       then have "z \<sim> f x \<or> z = f x" using zfy sym.trans[OF _ _ zA fyA fxA] by (auto simp:)
       with zA show "z \<in> [f x]\<^sub>\<sim>" by (auto simp: ecl_def)
     qed (auto simp: xX F_def ecl_def)
     with FXA show "F X \<in> Q" by (auto simp: Q_def ecl_def)
   qed
   then have F: "F ` Q \<subseteq> Q" by auto
   then interpret Q: fixed_point_proof Q "(\<sqsubseteq>\<^sup>s)" F by unfold_locales
   have monoQ: "monotone_on Q (\<sqsubseteq>\<^sup>s) (\<sqsubseteq>\<^sup>s) F" 
   proof (intro monotone_onI)
     fix X Y assume XQ: "X \<in> Q" and YQ: "Y \<in> Q" and XY: "X \<sqsubseteq>\<^sup>s Y"
     then obtain x y where xX: "x \<in> X" and yY: "y \<in> Y" using Q_def by (auto simp: ecl_def)
     then have xA: "x \<in> A" and yA: "y \<in> A" using XQ YQ by (auto simp: Q_def ecl_def)
     have "x \<sqsubseteq> y" using XY xX yY by auto
     then have fxfy: "f x \<sqsubseteq> f y" using monotone_on_def[of A "(\<sqsubseteq>)" "(\<sqsubseteq>)" f] xA yA mono by auto
     have fxgX: "f x \<in> F X" using xX F_def by blast
     have fygY: "f y \<in> F Y" using yY F_def by blast
     show "F X \<sqsubseteq>\<^sup>s F Y" using RSLE_eq[OF XQFXQ[OF XQ] XQFXQ[OF YQ] fxgX fygY fxfy].
   qed
   have QdA: "{x. Q.derivable x} \<subseteq> Q" using Q.derivable_A by auto
   note asQ = Q.antisymmetric_axioms
   note infl = Q.mono_imp_derivation_infl[OF asQ monoQ]
   note f_refl = Q.mono_imp_derivation_f_refl[OF asQ monoQ]
   from Q.mono_imp_ex_least_fp[OF asQ monoQ compQ]
   obtain P where P: "extreme {q \<in> Q. F q = q} (\<sqsubseteq>\<^sup>s)\<^sup>- P" by auto
   then have PQ: "P \<in> Q" by (auto simp: extreme_def)
   from P have FPP: "F P = P" using PQ by auto
   with P have PP: "P \<sqsubseteq>\<^sup>s P" by auto
   from P obtain p where pA: "p \<in> A" and Pp: "P = [p]\<^sub>\<sim>" using Q_def by auto
   then have pP: "p \<in> P" by (auto simp: ecl_def)
   then have fpA: "f p \<in> A" using pA f by auto
   have "f p \<in> F P" using pP F_def fpA by auto
   then have "F P = [f p]\<^sub>\<sim>" using XQx XQFXQ[OF PQ] by auto
   then have fp: "f p \<sim> p \<or> f p = p" using pP FPP by (auto simp: ecl_def)
   have "p \<sqsubseteq> p" using PP pP by auto
   with fp have fpp: "f p \<sim> p" by auto
   have e: "extreme {p \<in> A. f p \<sim> p \<or> f p = p} (\<sqsupseteq>) p"
   proof (intro extremeI CollectI conjI pA fp, elim CollectE conjE)
     fix q assume qA: "q \<in> A" and fq: "f q \<sim> q \<or> f q = q"
     define Z where "Z \<equiv> {z \<in> A. q \<sim> z}\<union>{q}"
     then have qZ: "q \<in> Z" using qA by auto
     then have ZQ: "Z \<in> Q" using qA by (auto simp: Z_def Q_def ecl_def)
     have fqA: "f q \<in> A" using qA f by auto
     then have "f q \<in> Z" using fq by (auto simp: Z_def)
     then have 1: "Z = [f q]\<^sub>\<sim>" using XQx ZQ by auto
     then have "f q \<in> F Z" using qZ fqA by (auto simp: F_def)
     then have "F Z = [f q]\<^sub>\<sim>" using XQx XQFXQ[OF ZQ] by auto
     with 1 have "Z = F Z" by auto
     then have "P \<sqsubseteq>\<^sup>s Z" using P ZQ by auto
     then show "p \<sqsubseteq> q" using pP qZ by auto
   qed
   with fpp show ?thesis using e by auto
 qed
 
 subsection \<open>General Completeness\<close>
 
 lemma attract_mono_imp_fp_qfp_complete:
   assumes attract: "attractive A (\<sqsubseteq>)"
     and comp: "CC-complete A (\<sqsubseteq>)"
     and wr_CC: "\<forall>C \<subseteq> A. well_related_set C (\<sqsubseteq>) \<longrightarrow> C \<in> CC"
     and extend: "\<forall>X \<in> CC. \<forall>Y \<in> CC. X \<sqsubseteq>\<^sup>s Y \<longrightarrow> X \<union> Y \<in> CC"
     and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
     and P: "P \<subseteq> {x \<in> A. f x = x}"
   shows "CC-complete ({q \<in> A. f q \<sim> q} \<union> P) (\<sqsubseteq>)"
 proof (intro completeI)
   interpret attractive using attract.
   fix X assume Xfix: "X \<subseteq> {q \<in> A. f q \<sim> q} \<union> P" and XCC: "X \<in> CC"
   with P have XA: "X \<subseteq> A" by auto
   define B where "B \<equiv> {b \<in> A. \<forall>a \<in> X. a \<sqsubseteq> b}"
   { fix s a assume sA: "s \<in> A" and as: "\<forall>a \<in> X. a \<sqsubseteq> s" and aX: "a \<in> X"
     then have aA: "a \<in> A" using XA by auto
     then have fafs: "f a \<sqsubseteq> f s" using mono f aX sA as by (auto elim!: monotone_onE)
     have "a \<sqsubseteq> f s"
     proof (cases "f a = a")
       case True
       then show ?thesis using fafs by auto
     next
       case False
       then have "a \<sim> f a" using P aX Xfix by auto
       also from fafs have "f a \<sqsubseteq> f s" by auto
       finally show ?thesis using f aA sA by auto
     qed
   }
   with f have fBB: "f ` B \<subseteq> B" unfolding B_def by auto
   have BA: "B \<subseteq> A" by (auto simp: B_def)
   have compB: "CC-complete B (\<sqsubseteq>)"
   proof (unfold complete_def, intro allI impI)
     fix Y assume YS: "Y \<subseteq> B" and YCC: "Y \<in> CC"
     with BA have YA: "Y \<subseteq> A" by auto
     define C where "C \<equiv> X\<union>Y"
     then have CA: "C \<subseteq> A" using XA YA C_def by auto
     have XY: "X \<sqsubseteq>\<^sup>s Y" using B_def YS by auto
     then have CCC: "C \<in> CC" using extend XA YA XCC YCC C_def by auto
     then obtain s where s: "extreme_bound A (\<sqsubseteq>) C s"
       using completeD[OF comp CA CCC] by auto
     then have sA: "s \<in> A" by auto
     show "Ex (extreme_bound B (\<sqsubseteq>) Y)"
     proof (intro exI extreme_boundI)
       { fix x assume "x \<in> X"
         then have "x \<sqsubseteq> s" using s C_def by auto
       }
       then show "s \<in> B" using sA B_def by auto
     next
       fix y assume "y \<in> Y"
       then show "y \<sqsubseteq> s" using s C_def using extremeD by auto
     next
       fix c assume cS: "c \<in> B" and "bound Y (\<sqsubseteq>) c"
       then have "bound C (\<sqsubseteq>) c" using C_def B_def by auto
       then show "s \<sqsubseteq> c" using s BA cS by auto
     qed
   qed
   from fBB interpret B: fixed_point_proof B "(\<sqsubseteq>)" f by unfold_locales
   from BA have *: "{x \<in> A. f x \<sim> x} \<inter> B = {x \<in> B. f x \<sim> x}" by auto
   have asB: "attractive B (\<sqsubseteq>)" using attractive_subset[OF BA] by auto
   have monoB: "monotone_on B (\<sqsubseteq>) (\<sqsubseteq>) f" using monotone_on_cmono[OF BA] mono by (auto dest!: le_funD)
   have compB: "well_complete B (\<sqsubseteq>)"
     using wr_CC compB BA by (simp add: complete_def) 
   from B.attract_mono_imp_least_qfp[OF asB compB monoB]
   obtain l where "extreme {p \<in> B. f p \<sim> p \<or> f p = p} (\<sqsupseteq>) l" and fll: "f l \<sim> l" by auto
   with P have l: "extreme ({p \<in> B. f p \<sim> p} \<union> P \<inter> B) (\<sqsupseteq>) l" by auto
   show "Ex (extreme_bound ({q \<in> A. f q \<sim> q} \<union> P) (\<sqsubseteq>) X)"
   proof (intro exI extreme_boundI)
     show "l \<in> {q \<in> A. f q \<sim> q} \<union> P" using l BA by auto
     fix a assume "a \<in> X"
     with l show "a \<sqsubseteq> l" by (auto simp: B_def)
   next
     fix c assume c: "bound X (\<sqsubseteq>) c" and cfix: "c \<in> {q \<in> A. f q \<sim> q} \<union> P"
     with P have cA: "c \<in> A" by auto
     with c have "c \<in> B" by (auto simp: B_def)
     with cfix l show "l \<sqsubseteq> c" by auto
   qed
 qed
 
 lemma attract_mono_imp_qfp_complete:
   assumes "attractive A (\<sqsubseteq>)"
     and "CC-complete A (\<sqsubseteq>)"
     and "\<forall>C \<subseteq> A. well_related_set C (\<sqsubseteq>) \<longrightarrow> C \<in> CC"
     and "\<forall>X \<in> CC. \<forall>Y \<in> CC. X \<sqsubseteq>\<^sup>s Y \<longrightarrow> X \<union> Y \<in> CC"
     and "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "CC-complete {p \<in> A. f p \<sim> p} (\<sqsubseteq>)"
   using attract_mono_imp_fp_qfp_complete[OF assms, of "{}"] by simp
 
 lemma antisym_mono_imp_fp_complete:
   assumes anti: "antisymmetric A (\<sqsubseteq>)"
     and comp: "CC-complete A (\<sqsubseteq>)"
     and wr_CC: "\<forall>C \<subseteq> A. well_related_set C (\<sqsubseteq>) \<longrightarrow> C \<in> CC"
     and extend: "\<forall>X \<in> CC. \<forall>Y \<in> CC. X \<sqsubseteq>\<^sup>s Y \<longrightarrow> X \<union> Y \<in> CC"
     and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "CC-complete {p \<in> A. f p = p} (\<sqsubseteq>)"
 proof-
   interpret antisymmetric using anti.
   have *: "{q \<in> A. f q \<sim> q} \<subseteq> {p \<in> A. f p = p}" using f by (auto intro!: antisym)
   from * attract_mono_imp_fp_qfp_complete[OF attractive_axioms comp wr_CC extend mono, of "{p\<in>A. f p = p}"]
   show ?thesis by (auto simp: subset_Un_eq)
 qed
 
 end
 
 subsection \<open>Instances\<close>
 
 subsubsection \<open>Instances under attractivity\<close>
 
 context attractive begin
 
 interpretation less_eq_notations.
 
 text \<open>Full completeness\<close>
 theorem mono_imp_qfp_UNIV_complete:
   assumes comp: "UNIV-complete A (\<sqsubseteq>)" and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "UNIV-complete {p \<in> A. f p \<sim> p} (\<sqsubseteq>)"
   apply (intro fixed_point_proof.attract_mono_imp_qfp_complete comp mono)
     apply unfold_locales
   by (auto simp: f)
 
 text \<open>Connex completeness\<close>
 theorem mono_imp_qfp_connex_complete:
   assumes comp: "{X. connex X (\<sqsubseteq>)}-complete A (\<sqsubseteq>)"
     and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "{X. connex X (\<sqsubseteq>)}-complete {p \<in> A. f p \<sim> p} (\<sqsubseteq>)"
   apply (intro fixed_point_proof.attract_mono_imp_qfp_complete mono comp)
     apply unfold_locales
   by (auto simp: f intro: connex_union well_related_set.connex_axioms)
 
 text \<open>Directed completeness\<close>
 theorem mono_imp_qfp_directed_complete:
   assumes comp: "{X. directed X (\<sqsubseteq>)}-complete A (\<sqsubseteq>)"
     and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "{X. directed X (\<sqsubseteq>)}-complete {p \<in> A. f p \<sim> p} (\<sqsubseteq>)"
   apply (intro fixed_point_proof.attract_mono_imp_qfp_complete mono comp)
     apply unfold_locales
   by (auto simp: f intro!: directed_extend intro: well_related_set.connex_axioms connex.directed)
 
 text \<open>Well Completeness\<close>
 theorem mono_imp_qfp_well_complete:
   assumes comp: "well_complete A (\<sqsubseteq>)"
     and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "well_complete {p \<in> A. f p \<sim> p} (\<sqsubseteq>)"
   apply (intro fixed_point_proof.attract_mono_imp_qfp_complete mono comp)
     apply unfold_locales
   by (auto simp: f well_related_extend)
 
 end
 
 subsubsection \<open>Usual instances under antisymmetry \<close>
 
 context antisymmetric begin
 
 text \<open>Knaster--Tarski\<close>
 theorem mono_imp_fp_complete:
   assumes comp: "UNIV-complete A (\<sqsubseteq>)"
     and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "UNIV-complete {p \<in> A. f p = p} (\<sqsubseteq>)"
 proof-
   interpret fixed_point_proof using f by unfold_locales
   show ?thesis
     apply (intro antisym_mono_imp_fp_complete mono antisymmetric_axioms comp)
     by auto
 qed
 
 text \<open>Markowsky 1976\<close>
 theorem mono_imp_fp_connex_complete:
   assumes comp: "{X. connex X (\<sqsubseteq>)}-complete A (\<sqsubseteq>)"
     and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "{X. connex X (\<sqsubseteq>)}-complete {p \<in> A. f p = p} (\<sqsubseteq>)"
 proof-
   interpret fixed_point_proof using f by unfold_locales
   show ?thesis
     apply (intro antisym_mono_imp_fp_complete antisymmetric_axioms mono comp)
     by (auto intro: connex_union well_related_set.connex_axioms)
 qed
 
 text \<open>Pataraia\<close>
 theorem mono_imp_fp_directed_complete:
   assumes comp: "{X. directed X (\<sqsubseteq>)}-complete A (\<sqsubseteq>)"
     and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "{X. directed X (\<sqsubseteq>)}-complete {p \<in> A. f p = p} (\<sqsubseteq>)"
 proof-
   interpret fixed_point_proof using f by unfold_locales
   show ?thesis
     apply (intro antisym_mono_imp_fp_complete mono antisymmetric_axioms comp)
      by (auto intro: directed_extend connex.directed well_related_set.connex_axioms)
 qed
 
 text \<open>Bhatta \& George 2011\<close>
 theorem mono_imp_fp_well_complete:
   assumes comp: "well_complete A (\<sqsubseteq>)"
     and f: "f ` A \<subseteq> A" and mono: "monotone_on A (\<sqsubseteq>) (\<sqsubseteq>) f"
   shows "well_complete {p \<in> A. f p = p} (\<sqsubseteq>)"
 proof-
   interpret fixed_point_proof using f by unfold_locales
   show ?thesis
     apply (intro antisym_mono_imp_fp_complete mono antisymmetric_axioms comp)
     by (auto intro!: antisym well_related_extend)
 qed
 
 end
 
 end
diff --git a/thys/Complex_Geometry/More_Transcendental.thy b/thys/Complex_Geometry/More_Transcendental.thy
--- a/thys/Complex_Geometry/More_Transcendental.thy
+++ b/thys/Complex_Geometry/More_Transcendental.thy
@@ -1,224 +1,224 @@
 (* ---------------------------------------------------------------------------- *)
 section \<open>Introduction\<close>
 (* ---------------------------------------------------------------------------- *)
 
 text \<open>The complex plane or some of its parts (e.g., the unit disc or the upper half plane) are often
 taken as the domain in which models of various geometries (both Euclidean and non-Euclidean ones)
 are formalized. The complex plane gives simpler and more compact formulas than the Cartesian plane.
 Within complex plane is easier to describe geometric objects and perform the calculations (usually
 shedding some new light on the subject). We give a formalization of the extended complex
 plane (given both as a complex projective space and as the Riemann sphere), its objects (points,
 circles and lines), and its transformations (Möbius transformations).\<close>
 
 (* ---------------------------------------------------------------------------- *)
 section \<open>Related work\<close>
 (* ---------------------------------------------------------------------------- *)
 
 text\<open>During the last decade, there have been many results in formalizing
-geometry in proof-assistants. Parts of Hilbert’s seminal book
+geometry in proof-assistants. Parts of Hilbert's seminal book
 ,,Foundations of Geometry'' \cite{hilbert} have been formalized both
 in Coq and Isabelle/Isar.  Formalization of first two groups of axioms
 in Coq, in an intuitionistic setting was done by Dehlinger et
 al. \cite{hilbert-coq}. First formalization in Isabelle/HOL was done
 by Fleuriot and Meikele \cite{hilbert-isabelle}, and some further
 developments were made in master thesis of Scott \cite{hilbert-scott}.
 Large fragments of Tarski's geometry \cite{tarski} have been
 formalized in Coq by Narboux et al. \cite{narboux-tarski}. Within Coq,
-there are also formalizations of von Plato’s constructive geometry by
+there are also formalizations of von Plato's constructive geometry by
 Kahn \cite{vonPlato,von-plato-formalization}, French high school
 geometry by Guilhot \cite{guilhot} and ruler and compass geometry by
 Duprat \cite{duprat2008}, etc.
 
 In our previous work \cite{petrovic2012formalizing}, we have already
 formally investigated a Cartesian model of Euclidean geometry. 
 \<close>
 
 (* ---------------------------------------------------------------------------- *)
 section \<open>Background theories\<close> 
 (* ---------------------------------------------------------------------------- *)
 
 text \<open>In this section we introduce some basic mathematical notions and prove some lemmas needed in the rest of our
 formalization. We describe:
 
     \<^item> trigonometric functions,
 
     \<^item> complex numbers, 
 
     \<^item> systems of two and three linear equations with two unknowns (over arbitrary fields), 
 
     \<^item> quadratic equations (over real and complex numbers), systems of quadratic and real
       equations, and systems of two quadratic equations,
 
     \<^item> two-dimensional vectors and matrices over complex numbers.
 \<close>
 
 (* -------------------------------------------------------------------------- *)
 subsection \<open>Library Additions for Trigonometric Functions\<close>
 (* -------------------------------------------------------------------------- *)
 
 theory More_Transcendental
   imports Complex_Main "HOL-Library.Periodic_Fun"
 begin
 
 text \<open>Additional properties of @{term sin} and @{term cos} functions that are later used in proving
 conjectures for argument of complex number.\<close>
 
 text \<open>Sign of trigonometric functions on some characteristic intervals.\<close>
 
 lemma cos_lt_zero_on_pi2_pi [simp]:
   assumes "x > pi/2" and "x \<le> pi"
   shows "cos x < 0"
   using cos_gt_zero_pi[of "pi - x"] assms
   by simp
 
 text \<open>Value of trigonometric functions in points $k\pi$ and $\frac{\pi}{2} + k\pi$.\<close>
 
 lemma sin_kpi [simp]:
   fixes k::int
   shows "sin (k * pi) = 0"
   by (simp add: sin_zero_iff_int2)
 
 lemma cos_odd_kpi [simp]:
   fixes k::int
   assumes "odd k"
   shows "cos (k * pi) = -1"
   by (simp add: assms mult.commute)
 
 lemma cos_even_kpi [simp]:
   fixes k::int
   assumes "even k"
   shows "cos (k * pi) = 1"
   by (simp add: assms mult.commute)
 
 lemma sin_pi2_plus_odd_kpi [simp]:
   fixes k::int
   assumes "odd k"
   shows "sin (pi / 2 + k * pi) = -1"
   using assms
   by (simp add: sin_add)
 
 lemma sin_pi2_plus_even_kpi [simp]:
   fixes k::int
   assumes "even k"
   shows "sin (pi / 2 + k * pi) = 1"
   using assms
   by (simp add: sin_add)
 
 text \<open>Solving trigonometric equations and systems with special values (0, 1, or -1) of sine and cosine functions\<close>
 
 lemma cos_0_iff_canon:
   assumes "cos \<phi> = 0" and "-pi < \<phi>" and "\<phi> \<le> pi"
   shows "\<phi> = pi/2 \<or> \<phi> = -pi/2"
   by (smt (verit, best) arccos_0 arccos_cos assms cos_minus divide_minus_left)
 
 lemma sin_0_iff_canon:
   assumes "sin \<phi> = 0" and "-pi < \<phi>" and "\<phi> \<le> pi"
   shows "\<phi> = 0 \<or> \<phi> = pi"
   using assms sin_eq_0_pi by force
 
 lemma cos0_sin1:
   assumes "sin \<phi> = 1"
   shows "\<exists> k::int. \<phi> = pi/2 + 2*k*pi"
   by (smt (verit, ccfv_threshold) assms cos_diff cos_one_2pi_int cos_pi_half mult_cancel_right1 sin_pi_half sin_plus_pi)
 
 (* TODO: add lemmas for cos = -1, sin = 0 and cos = 0, sin = -1 *)
 
 
 text \<open>Sine is injective on $[-\frac{\pi}{2}, \frac{\pi}{2}]$\<close>
 
 lemma sin_inj:
   assumes "-pi/2 \<le> \<alpha> \<and> \<alpha> \<le> pi/2" and "-pi/2 \<le> \<alpha>' \<and> \<alpha>' \<le> pi/2"
   assumes "\<alpha> \<noteq> \<alpha>'"
   shows "sin \<alpha> \<noteq> sin \<alpha>'"
   by (metis assms divide_minus_left sin_inj_pi)
 
 text \<open>Periodicity of trigonometric functions\<close>
 
 text \<open>The following are available in HOL-Decision\_Procs.Approximation\_Bounds, but we want to avoid
 that dependency\<close>
 
 lemma sin_periodic_nat [simp]: 
   fixes n :: nat
   shows "sin (x + n * (2 * pi)) = sin x"
   by (metis (no_types, opaque_lifting) add.commute add.left_neutral cos_2npi cos_one_2pi_int mult.assoc mult.commute mult.left_neutral mult_zero_left sin_add sin_int_2pin)
 
 lemma sin_periodic_int [simp]:
   fixes i :: int
   shows "sin (x + i * (2 * pi)) = sin x"
   by (metis add.right_neutral cos_int_2pin mult.commute mult.right_neutral mult_zero_right sin_add sin_int_2pin)
 
 lemma cos_periodic_nat [simp]: 
   fixes n :: nat
   shows "cos (x + n * (2 * pi)) = cos x"
   by (metis add.left_neutral cos_2npi cos_add cos_periodic mult.assoc mult_2 mult_2_right of_nat_numeral sin_periodic sin_periodic_nat)
 
 lemma cos_periodic_int [simp]:
   fixes i :: int
   shows "cos (x + i * (2 * pi)) = cos x"
   by (metis cos_add cos_int_2pin diff_zero mult.commute mult.right_neutral mult_zero_right sin_int_2pin)
 
 text \<open>Values of both sine and cosine are repeated only after multiples of $2\cdot \pi$\<close>
 
 lemma sin_cos_eq:
   fixes a b :: real
   assumes "cos a = cos b" and "sin a = sin b"
   shows "\<exists> k::int. a - b = 2*k*pi"
   by (metis assms cos_diff cos_one_2pi_int mult.commute sin_cos_squared_add3)
 
 text \<open>The following two lemmas are consequences of surjectivity of cosine for the range $[-1, 1]$.\<close>
 
 lemma ex_cos_eq:
   assumes "-pi/2 \<le> \<alpha> \<and> \<alpha> \<le> pi/2"
   assumes "a \<ge> 0" and "a < 1"
   shows "\<exists> \<alpha>'. -pi/2 \<le> \<alpha>' \<and> \<alpha>' \<le> pi/2 \<and> \<alpha>' \<noteq> \<alpha> \<and> cos (\<alpha> - \<alpha>') = a"
 proof-
   have "arccos a > 0" "arccos a \<le> pi/2"
     using \<open>a \<ge> 0\<close> \<open>a < 1\<close>
     using arccos_lt_bounded arccos_le_pi2
     by auto
 
   show ?thesis
   proof (cases "\<alpha> - arccos a \<ge> - pi/2")
     case True
     thus ?thesis
       using assms \<open>arccos a > 0\<close> \<open>arccos a \<le> pi/2\<close>
       by (rule_tac x = "\<alpha> - arccos a" in exI) auto
   next
     case False
     thus ?thesis
       using assms \<open>arccos a > 0\<close> \<open>arccos a \<le> pi/2\<close>
       by (rule_tac x = "\<alpha> + arccos a" in exI) auto
   qed
 qed
 
 lemma ex_cos_gt:
   assumes "-pi/2 \<le> \<alpha> \<and> \<alpha> \<le> pi/2"
   assumes "a < 1"
   shows "\<exists> \<alpha>'. -pi/2 \<le> \<alpha>' \<and> \<alpha>' \<le> pi/2 \<and> \<alpha>' \<noteq> \<alpha> \<and> cos (\<alpha> - \<alpha>') > a"
 proof-
   obtain a' where "a' \<ge> 0" "a' > a" "a' < 1"
     by (metis assms(2) dense_le_bounded linear not_one_le_zero)
   thus ?thesis
     using ex_cos_eq[of \<alpha> a'] assms
     by auto
 qed
 
 text \<open>The function @{term atan2} is a generalization of @{term arctan} that takes a pair of coordinates
 of non-zero points returns its angle in the range $[-\pi, \pi)$.\<close>
 
 definition atan2 where
   "atan2 y x =
     (if x > 0 then arctan (y/x)
      else if x < 0 then
           if y > 0 then arctan (y/x) + pi else arctan (y/x) - pi
      else
           if y > 0 then pi/2 else if y < 0 then -pi/2 else 0)"
 
 lemma atan2_bounded: 
   shows "-pi \<le> atan2 y x \<and> atan2 y x < pi"
   using arctan_bounded[of "y/x"] zero_le_arctan_iff[of "y/x"] arctan_le_zero_iff[of "y/x"] zero_less_arctan_iff[of "y/x"] arctan_less_zero_iff[of "y/x"]
   using divide_neg_neg[of y x] divide_neg_pos[of y x] divide_pos_pos[of y x]  divide_pos_neg[of y x]
   unfolding atan2_def
   by (simp (no_asm_simp)) auto
 
 end
diff --git a/thys/Delta_System_Lemma/Cardinal_Library.thy b/thys/Delta_System_Lemma/Cardinal_Library.thy
--- a/thys/Delta_System_Lemma/Cardinal_Library.thy
+++ b/thys/Delta_System_Lemma/Cardinal_Library.thy
@@ -1,708 +1,708 @@
 section\<open>Cardinal Arithmetic under Choice\label{sec:cardinal-lib}\<close>
 
 theory Cardinal_Library
   imports
     ZF_Library
     ZF.Cardinal_AC
 
 begin
 
 text\<open>This theory includes results on cardinalities that depend on $\AC$\<close>
 
 
 subsection\<open>Results on cardinal exponentiation\<close>
 
 text\<open>Non trivial instances of cardinal exponentiation require that
      the relevant function spaces are well-ordered, hence this 
      implies a strong use of choice.\<close>
 
 lemma cexp_eqpoll_cong:
   assumes
     "A \<approx> A'" "B \<approx> B'"
   shows
     "A\<^bsup>\<up>B\<^esup> = A'\<^bsup>\<up>B'\<^esup>"
   unfolding cexp_def using cardinal_eqpoll_iff
     function_space_eqpoll_cong assms
   by simp
 
 lemma cexp_cexp_cmult: "(\<kappa>\<^bsup>\<up>\<nu>1\<^esup>)\<^bsup>\<up>\<nu>2\<^esup> = \<kappa>\<^bsup>\<up>\<nu>2 \<otimes> \<nu>1\<^esup>"
 proof -
   have "(\<kappa>\<^bsup>\<up>\<nu>1\<^esup>)\<^bsup>\<up>\<nu>2\<^esup> = (\<nu>1 \<rightarrow> \<kappa>)\<^bsup>\<up>\<nu>2\<^esup>"
     using cardinal_eqpoll
     by (intro cexp_eqpoll_cong) (simp_all add:cexp_def)
   also
   have " \<dots> = \<kappa>\<^bsup>\<up>\<nu>2 \<times> \<nu>1\<^esup>"
     unfolding cexp_def using curry_eqpoll cardinal_cong by blast
   also
   have " \<dots> = \<kappa>\<^bsup>\<up>\<nu>2 \<otimes> \<nu>1\<^esup>"
     using cardinal_eqpoll[THEN eqpoll_sym]
     unfolding cmult_def by (intro cexp_eqpoll_cong) (simp)
   finally
   show ?thesis  .
 qed
 
 lemma cardinal_Pow: "|Pow(X)| = 2\<^bsup>\<up>X\<^esup>" \<comment> \<open>Perhaps it's better with |X|\<close>
   using cardinal_eqpoll_iff[THEN iffD2, OF Pow_eqpoll_function_space]
   unfolding cexp_def by simp
 
 lemma cantor_cexp:
   assumes "Card(\<nu>)"
   shows "\<nu> < 2\<^bsup>\<up>\<nu>\<^esup>"
   using assms Card_is_Ord Card_cexp
 proof (intro not_le_iff_lt[THEN iffD1] notI)
   assume "2\<^bsup>\<up>\<nu>\<^esup> \<le> \<nu>"
   then
   have "|Pow(\<nu>)| \<le> \<nu>"
     using cardinal_Pow by simp
   with assms
   have "Pow(\<nu>) \<lesssim> \<nu>"
     using cardinal_eqpoll_iff Card_le_imp_lepoll Card_cardinal_eq
     by auto
   then
   obtain g where "g \<in> inj(Pow(\<nu>), \<nu>)"
     by blast
   then
   show "False"
     using cantor_inj by simp
 qed simp
 
 lemma cexp_left_mono:
   assumes "\<kappa>1 \<le> \<kappa>2"
   shows "\<kappa>1\<^bsup>\<up>\<nu>\<^esup> \<le> \<kappa>2\<^bsup>\<up>\<nu>\<^esup>"
     (* \<comment> \<open>short, unreadable proof: \<close>
   unfolding cexp_def
   using subset_imp_lepoll[THEN lepoll_imp_cardinal_le]
     assms le_subset_iff[THEN iffD1, OF assms]
     Pi_weaken_type[of _ _ "\<lambda>_. \<kappa>1" "\<lambda>_. \<kappa>2"] by auto *)
 proof -
   from assms
   have "\<kappa>1 \<subseteq> \<kappa>2"
     using le_subset_iff by simp
   then
   have "\<nu> \<rightarrow> \<kappa>1  \<subseteq> \<nu> \<rightarrow> \<kappa>2"
     using Pi_weaken_type by auto
   then
   show ?thesis unfolding cexp_def
     using lepoll_imp_cardinal_le subset_imp_lepoll by simp
 qed
 
 lemma cantor_cexp':
   assumes "2 \<le> \<kappa>" "Card(\<nu>)"
   shows "\<nu> < \<kappa>\<^bsup>\<up>\<nu>\<^esup>"
   using cexp_left_mono assms cantor_cexp lt_trans2 by blast
 
 lemma InfCard_cexp:
   assumes "2 \<le> \<kappa>" "InfCard(\<nu>)"
   shows "InfCard(\<kappa>\<^bsup>\<up>\<nu>\<^esup>)"
   using assms cantor_cexp'[THEN leI] le_trans Card_cexp
   unfolding InfCard_def by auto
 
 lemmas InfCard_cexp' = InfCard_cexp[OF nats_le_InfCard, simplified]
   \<comment> \<open>\<^term>\<open>InfCard(\<kappa>) \<Longrightarrow> InfCard(\<nu>) \<Longrightarrow> InfCard(\<kappa>\<^bsup>\<up>\<nu>\<^esup>)\<close>\<close>
 
 
 subsection\<open>Miscellaneous\<close>
 
 lemma cardinal_RepFun_le: "|{f(a) . a\<in>A}| \<le> |A|"
 proof -
   have "(\<lambda>x\<in>A. f(x)) \<in> surj(A, {f(a) . a\<in>A})"
     unfolding surj_def using lam_funtype by auto
   then
   show ?thesis
     using  surj_implies_cardinal_le by blast
 qed
 
 lemma subset_imp_le_cardinal: "A \<subseteq> B \<Longrightarrow> |A| \<le> |B|"
   using subset_imp_lepoll[THEN lepoll_imp_cardinal_le] .
 
 lemma lt_cardinal_imp_not_subset: "|A| < |B| \<Longrightarrow> \<not> B \<subseteq> A"
   using subset_imp_le_cardinal le_imp_not_lt by blast
 
 lemma cardinal_lt_csucc_iff: "Card(K) \<Longrightarrow> |K'| < K\<^sup>+ \<longleftrightarrow> |K'| \<le> K"
   by (simp add: Card_lt_csucc_iff)
 
 lemma cardinal_UN_le_nat:
   "(\<And>i. i\<in>\<omega> \<Longrightarrow> |X(i)| \<le> \<omega>) \<Longrightarrow> |\<Union>i\<in>\<omega>. X(i)| \<le> \<omega>"
   by (simp add: cardinal_UN_le InfCard_nat)
 
 lemma leqpoll_imp_cardinal_UN_le:
   notes [dest] = InfCard_is_Card Card_is_Ord
   assumes "InfCard(K)" "J \<lesssim> K" "\<And>i. i\<in>J \<Longrightarrow> |X(i)| \<le> K"
   shows "|\<Union>i\<in>J. X(i)| \<le> K"
 proof -
   from \<open>J \<lesssim> K\<close>
   obtain f where "f \<in> inj(J,K)" by blast
   define Y where "Y(k) \<equiv> if k\<in>range(f) then X(converse(f)`k) else 0" for k
   have "i\<in>J \<Longrightarrow> f`i \<in> K" for i
     using inj_is_fun[OF \<open>f \<in> inj(J,K)\<close>] by auto
   have "(\<Union>i\<in>J. X(i)) \<subseteq> (\<Union>i\<in>K. Y(i))"
   proof (standard, elim UN_E)
     fix x i
     assume "i\<in>J" "x\<in>X(i)"
     with \<open>f \<in> inj(J,K)\<close> \<open>i\<in>J \<Longrightarrow> f`i \<in> K\<close>
     have "x \<in> Y(f`i)" "f`i \<in> K"
       unfolding Y_def
       using inj_is_fun[OF \<open>f \<in> inj(J,K)\<close>]
         right_inverse apply_rangeI by auto
     then
     show "x \<in> (\<Union>i\<in>K. Y(i))" by auto
   qed
   then
   have "|\<Union>i\<in>J. X(i)| \<le> |\<Union>i\<in>K. Y(i)|"
     unfolding Y_def using subset_imp_le_cardinal by simp
   with assms \<open>\<And>i. i\<in>J \<Longrightarrow> f`i \<in> K\<close>
   show "|\<Union>i\<in>J. X(i)| \<le> K"
     using inj_converse_fun[OF \<open>f \<in> inj(J,K)\<close>] unfolding Y_def
     by (rule_tac le_trans[OF _ cardinal_UN_le]) (auto intro:Ord_0_le)+
 qed
 
 lemma cardinal_lt_csucc_iff':
   includes Ord_dests
   assumes "Card(\<kappa>)"
   shows "\<kappa> < |X| \<longleftrightarrow> \<kappa>\<^sup>+ \<le> |X|"
   using assms cardinal_lt_csucc_iff[of \<kappa> X] Card_csucc[of \<kappa>]
     not_le_iff_lt[of "\<kappa>\<^sup>+" "|X|"] not_le_iff_lt[of "|X|" \<kappa>]
   by blast
 
 lemma lepoll_imp_subset_bij: "X \<lesssim> Y \<longleftrightarrow> (\<exists>Z. Z \<subseteq> Y \<and> Z \<approx> X)"
 proof
   assume "X \<lesssim> Y"
   then
   obtain j where  "j \<in> inj(X,Y)"
     by blast
   then
   have "range(j) \<subseteq> Y" "j \<in> bij(X,range(j))"
     using inj_bij_range inj_is_fun range_fun_subset_codomain
     by blast+
   then
   show "\<exists>Z. Z \<subseteq> Y \<and> Z \<approx> X"
     using eqpoll_sym unfolding eqpoll_def
     by force
 next
   assume "\<exists>Z. Z \<subseteq> Y \<and> Z \<approx> X"
   then
   obtain Z f where "f \<in> bij(Z,X)" "Z \<subseteq> Y"
     unfolding eqpoll_def by force
   then
   have "converse(f) \<in> inj(X,Y)"
     using bij_is_inj inj_weaken_type bij_converse_bij by blast
   then
   show "X \<lesssim> Y" by blast
 qed
 
 text\<open>The following result proves to be very useful when combining
      \<^term>\<open>cardinal\<close> and \<^term>\<open>eqpoll\<close> in a calculation.\<close>
 
 lemma cardinal_Card_eqpoll_iff: "Card(\<kappa>) \<Longrightarrow> |X| = \<kappa> \<longleftrightarrow> X \<approx> \<kappa>"
   using Card_cardinal_eq[of \<kappa>] cardinal_eqpoll_iff[of X \<kappa>] by auto
     \<comment> \<open>Compare @{thm "le_Card_iff"}\<close>
 
 lemma lepoll_imp_lepoll_cardinal: assumes "X \<lesssim> Y" shows "X \<lesssim> |Y|"
   using assms cardinal_Card_eqpoll_iff[of "|Y|" Y]
     lepoll_eq_trans[of _ _ "|Y|"] by simp
 
 lemma lepoll_Un:
   assumes "InfCard(\<kappa>)" "A \<lesssim> \<kappa>" "B \<lesssim> \<kappa>"
   shows "A \<union> B \<lesssim> \<kappa>"
 proof -
   have "A \<union> B \<lesssim> sum(A,B)"
     using Un_lepoll_sum .
   moreover
   note assms
   moreover from this
   have "|sum(A,B)| \<le> \<kappa> \<oplus> \<kappa>"
     using sum_lepoll_mono[of A \<kappa> B \<kappa>] lepoll_imp_cardinal_le
     unfolding cadd_def by auto
   ultimately
   show ?thesis
     using InfCard_cdouble_eq Card_cardinal_eq
       InfCard_is_Card Card_le_imp_lepoll[of "sum(A,B)" \<kappa>]
       lepoll_trans[of "A\<union>B"]
     by auto
 qed
 
 lemma cardinal_Un_le:
   assumes "InfCard(\<kappa>)" "|A| \<le> \<kappa>" "|B| \<le> \<kappa>"
   shows "|A \<union> B| \<le> \<kappa>"
   using assms lepoll_Un le_Card_iff InfCard_is_Card by auto
 
 text\<open>This is the unconditional version under choice of 
      @{thm Cardinal.Finite_cardinal_iff}.\<close>
 lemma Finite_cardinal_iff': "Finite(|i|) \<longleftrightarrow> Finite(i)"
   using cardinal_eqpoll_iff eqpoll_imp_Finite_iff by fastforce
 
 lemma cardinal_subset_of_Card:
   assumes "Card(\<gamma>)" "a \<subseteq> \<gamma>"
   shows "|a| < \<gamma> \<or> |a| = \<gamma>"
 proof -
   from assms
   have "|a| < |\<gamma>| \<or> |a| = |\<gamma>|"
     using subset_imp_le_cardinal le_iff by simp
   with assms
   show ?thesis
     using Card_cardinal_eq by simp
 qed
 
 lemma cardinal_cases:
   includes Ord_dests
   shows "Card(\<gamma>) \<Longrightarrow> |X| < \<gamma> \<longleftrightarrow> \<not> |X| \<ge> \<gamma>"
   using not_le_iff_lt
   by auto
 
 
 subsection\<open>Countable and uncountable sets\<close>
 
 \<comment> \<open>Kunen's Definition I.10.5\<close>
 definition
   countable :: "i\<Rightarrow>o" where
   "countable(X) \<equiv> X \<lesssim> \<omega>"
 
 lemma countableI[intro]: "X \<lesssim> \<omega> \<Longrightarrow> countable(X)"
   unfolding countable_def by simp
 
 lemma countableD[dest]: "countable(X) \<Longrightarrow> X \<lesssim> \<omega>"
   unfolding countable_def by simp
 
 lemma countable_iff_cardinal_le_nat: "countable(X) \<longleftrightarrow> |X| \<le> \<omega>"
   using le_Card_iff[of \<omega> X] Card_nat
   unfolding countable_def by simp
 
 lemma lepoll_countable: "X \<lesssim> Y \<Longrightarrow> countable(Y) \<Longrightarrow> countable(X)"
   using lepoll_trans[of X Y] by blast
 
 \<comment> \<open>Next lemma can be proved without using AC\<close>
 lemma surj_countable: "countable(X) \<Longrightarrow> f \<in> surj(X,Y) \<Longrightarrow> countable(Y)"
   using surj_implies_cardinal_le[of f X Y, THEN le_trans]
     countable_iff_cardinal_le_nat by simp
 
 lemma Finite_imp_countable: "Finite(X) \<Longrightarrow> countable(X)"
   unfolding Finite_def
   by (auto intro:InfCard_nat nats_le_InfCard[of _ \<omega>,
         THEN le_imp_lepoll] dest!:eq_lepoll_trans[of X _ \<omega>])
 
 lemma countable_imp_countable_UN:
   assumes "countable(J)" "\<And>i. i\<in>J \<Longrightarrow> countable(X(i))"
   shows "countable(\<Union>i\<in>J. X(i))"
   using assms leqpoll_imp_cardinal_UN_le[of \<omega> J X] InfCard_nat
     countable_iff_cardinal_le_nat
   by auto
 
 lemma countable_union_countable:
   assumes "\<And>x. x \<in> C \<Longrightarrow> countable(x)" "countable(C)"
   shows "countable(\<Union>C)"
   using assms countable_imp_countable_UN[of C "\<lambda>x. x"] by simp
 
 abbreviation
   uncountable :: "i\<Rightarrow>o" where
   "uncountable(X) \<equiv> \<not> countable(X)"
 
 lemma uncountable_iff_nat_lt_cardinal:
   "uncountable(X) \<longleftrightarrow> \<omega> < |X|"
   using countable_iff_cardinal_le_nat not_le_iff_lt by simp
 
 lemma uncountable_not_empty: "uncountable(X) \<Longrightarrow> X \<noteq> 0"
   using empty_lepollI by auto
 
 lemma uncountable_imp_Infinite: "uncountable(X) \<Longrightarrow> Infinite(X)"
   using uncountable_iff_nat_lt_cardinal[of X] lepoll_nat_imp_Infinite[of X]
     cardinal_le_imp_lepoll[of \<omega> X] leI
   by simp
 
 lemma uncountable_not_subset_countable:
   assumes "countable(X)" "uncountable(Y)"
   shows "\<not> (Y \<subseteq> X)"
   using assms lepoll_trans subset_imp_lepoll[of Y X]
   by blast
 
 
 subsection\<open>Results on Alephs\<close>
 
 lemma nat_lt_Aleph1: "\<omega> < \<aleph>\<^bsub>1\<^esub>"
   by (simp add: Aleph_def lt_csucc)
 
 lemma zero_lt_Aleph1: "0 < \<aleph>\<^bsub>1\<^esub>"
   by (rule lt_trans[of _ "\<omega>"], auto simp add: ltI nat_lt_Aleph1)
 
 lemma le_aleph1_nat: "Card(k) \<Longrightarrow> k<\<aleph>\<^bsub>1\<^esub> \<Longrightarrow> k \<le> \<omega>"
   by (simp add: Aleph_def Card_lt_csucc_iff Card_nat)
 
 lemma Aleph_succ: "\<aleph>\<^bsub>succ(\<alpha>)\<^esub> = \<aleph>\<^bsub>\<alpha>\<^esub>\<^sup>+"
   unfolding Aleph_def by simp
 
 lemma lesspoll_aleph_plus_one:
   assumes "Ord(\<alpha>)"
   shows "d \<prec> \<aleph>\<^bsub>succ(\<alpha>)\<^esub> \<longleftrightarrow> d \<lesssim> \<aleph>\<^bsub>\<alpha>\<^esub>"
   using assms lesspoll_csucc Aleph_succ Card_is_Ord by simp
 
 lemma cardinal_Aleph [simp]: "Ord(\<alpha>) \<Longrightarrow> |\<aleph>\<^bsub>\<alpha>\<^esub>| = \<aleph>\<^bsub>\<alpha>\<^esub>"
   using Card_cardinal_eq by simp
 
 \<comment> \<open>Could be proved without using AC\<close>
 lemma Aleph_lesspoll_increasing:
   includes Aleph_intros
   shows "a < b \<Longrightarrow> \<aleph>\<^bsub>a\<^esub> \<prec> \<aleph>\<^bsub>b\<^esub>"
   using cardinal_lt_iff_lesspoll[of "\<aleph>\<^bsub>a\<^esub>" "\<aleph>\<^bsub>b\<^esub>"] Card_cardinal_eq[of "\<aleph>\<^bsub>b\<^esub>"]
     lt_Ord lt_Ord2 Card_Aleph[THEN Card_is_Ord] by auto
 
 lemma uncountable_iff_subset_eqpoll_Aleph1:
   includes Ord_dests
   notes Aleph_zero_eq_nat[simp] Card_nat[simp] Aleph_succ[simp]
   shows "uncountable(X) \<longleftrightarrow> (\<exists>S. S \<subseteq> X \<and> S \<approx> \<aleph>\<^bsub>1\<^esub>)"
 proof
   assume "uncountable(X)"
   then
   have "\<aleph>\<^bsub>1\<^esub> \<lesssim> X"
     using uncountable_iff_nat_lt_cardinal cardinal_lt_csucc_iff'
       cardinal_le_imp_lepoll by force
   then
   obtain S where "S \<subseteq> X" "S \<approx> \<aleph>\<^bsub>1\<^esub>"
     using lepoll_imp_subset_bij by auto
   then
   show "\<exists>S. S \<subseteq> X \<and> S \<approx> \<aleph>\<^bsub>1\<^esub>"
     using cardinal_cong Card_csucc[of \<omega>] Card_cardinal_eq by auto
 next
   assume "\<exists>S. S \<subseteq> X \<and> S \<approx> \<aleph>\<^bsub>1\<^esub>"
   then
   have "\<aleph>\<^bsub>1\<^esub> \<lesssim> X"
     using subset_imp_lepoll[THEN [2] eq_lepoll_trans, of "\<aleph>\<^bsub>1\<^esub>" _ X,
         OF eqpoll_sym] by auto
   then
   show "uncountable(X)"
     using Aleph_lesspoll_increasing[of 0 1, THEN [2] lesspoll_trans1,
         of "\<aleph>\<^bsub>1\<^esub>"] lepoll_trans[of "\<aleph>\<^bsub>1\<^esub>" X \<omega>]
     by auto
 qed
 
 lemma lt_Aleph_imp_cardinal_UN_le_nat: "function(G) \<Longrightarrow> domain(G) \<lesssim> \<omega> \<Longrightarrow>
    \<forall>n\<in>domain(G). |G`n|<\<aleph>\<^bsub>1\<^esub> \<Longrightarrow> |\<Union>n\<in>domain(G). G`n|\<le>\<omega>"
 proof -
   assume "function(G)"
   let ?N="domain(G)" and ?R="\<Union>n\<in>domain(G). G`n"
   assume "?N \<lesssim> \<omega>"
   assume Eq1: "\<forall>n\<in>?N. |G`n|<\<aleph>\<^bsub>1\<^esub>"
   {
     fix n
     assume "n\<in>?N"
     with Eq1 have "|G`n| \<le> \<omega>"
       using le_aleph1_nat by simp
   }
   then
   have "n\<in>?N \<Longrightarrow> |G`n| \<le> \<omega>" for n .
   with \<open>?N \<lesssim> \<omega>\<close>
   show ?thesis
     using InfCard_nat leqpoll_imp_cardinal_UN_le by simp
 qed
 
 lemma Aleph1_eq_cardinal_vimage: "f:\<aleph>\<^bsub>1\<^esub>\<rightarrow>\<omega> \<Longrightarrow> \<exists>n\<in>\<omega>. |f-``{n}| = \<aleph>\<^bsub>1\<^esub>"
 proof -
   assume "f:\<aleph>\<^bsub>1\<^esub>\<rightarrow>\<omega>"
   then
   have "function(f)" "domain(f) = \<aleph>\<^bsub>1\<^esub>" "range(f)\<subseteq>\<omega>"
     by (simp_all add: domain_of_fun fun_is_function range_fun_subset_codomain)
   let ?G="\<lambda>n\<in>range(f). f-``{n}"
   from \<open>f:\<aleph>\<^bsub>1\<^esub>\<rightarrow>\<omega>\<close>
   have "range(f) \<subseteq> \<omega>" by (simp add: range_fun_subset_codomain)
   then
   have "domain(?G) \<lesssim> \<omega>"
     using subset_imp_lepoll by simp
   have "function(?G)" by (simp add:function_lam)
   from \<open>f:\<aleph>\<^bsub>1\<^esub>\<rightarrow>\<omega>\<close>
   have "n\<in>\<omega> \<Longrightarrow> f-``{n} \<subseteq> \<aleph>\<^bsub>1\<^esub>" for n
     using Pi_vimage_subset by simp
   with \<open>range(f) \<subseteq> \<omega>\<close>
   have "\<aleph>\<^bsub>1\<^esub> = (\<Union>n\<in>range(f). f-``{n})"
   proof (intro equalityI, intro subsetI)
     fix x
     assume "x \<in> \<aleph>\<^bsub>1\<^esub>"
     with \<open>f:\<aleph>\<^bsub>1\<^esub>\<rightarrow>\<omega>\<close> \<open>function(f)\<close> \<open>domain(f) = \<aleph>\<^bsub>1\<^esub>\<close>
     have "x \<in> f-``{f`x}" "f`x \<in> range(f)"
       using function_apply_Pair vimage_iff apply_rangeI by simp_all
     then
     show "x \<in> (\<Union>n\<in>range(f). f-``{n})" by auto
   qed auto
   {
     assume "\<forall>n\<in>range(f). |f-``{n}| < \<aleph>\<^bsub>1\<^esub>"
     then
     have "\<forall>n\<in>domain(?G). |?G`n| < \<aleph>\<^bsub>1\<^esub>"
       using zero_lt_Aleph1 by (auto)
     with \<open>function(?G)\<close> \<open>domain(?G) \<lesssim> \<omega>\<close>
     have "|\<Union>n\<in>domain(?G). ?G`n|\<le>\<omega>"
       using lt_Aleph_imp_cardinal_UN_le_nat by blast
     then
     have "|\<Union>n\<in>range(f). f-``{n}|\<le>\<omega>" by simp
     with \<open>\<aleph>\<^bsub>1\<^esub> = _\<close>
     have "|\<aleph>\<^bsub>1\<^esub>| \<le> \<omega>" by simp
     then
     have "\<aleph>\<^bsub>1\<^esub> \<le> \<omega>"
       using Card_Aleph Card_cardinal_eq
       by simp
     then
     have "False"
       using nat_lt_Aleph1 by (blast dest:lt_trans2)
   }
   with \<open>range(f)\<subseteq>\<omega>\<close>
   obtain n where "n\<in>\<omega>" "\<not>(|f -`` {n}| < \<aleph>\<^bsub>1\<^esub>)"
     by blast
   moreover from this
   have "\<aleph>\<^bsub>1\<^esub> \<le> |f-``{n}|"
     using not_lt_iff_le Card_is_Ord by auto
   moreover
   note \<open>n\<in>\<omega> \<Longrightarrow> f-``{n} \<subseteq> \<aleph>\<^bsub>1\<^esub>\<close>
   ultimately
   show ?thesis
     using subset_imp_le_cardinal[THEN le_anti_sym, of _ "\<aleph>\<^bsub>1\<^esub>"]
       Card_Aleph Card_cardinal_eq by auto
 qed
 
 \<comment> \<open>There is some asymmetry between assumptions and conclusion
     (\<^term>\<open>(\<approx>)\<close> versus \<^term>\<open>cardinal\<close>)\<close>
 lemma eqpoll_Aleph1_cardinal_vimage:
   assumes "X \<approx> \<aleph>\<^bsub>1\<^esub>" "f : X \<rightarrow> \<omega>"
   shows "\<exists>n\<in>\<omega>. |f-``{n}| = \<aleph>\<^bsub>1\<^esub>"
 proof -
   from assms
   obtain g where "g\<in>bij(\<aleph>\<^bsub>1\<^esub>,X)"
     using eqpoll_sym by blast
   with \<open>f : X \<rightarrow> \<omega>\<close>
   have "f O g : \<aleph>\<^bsub>1\<^esub> \<rightarrow> \<omega>" "converse(g) \<in> bij(X, \<aleph>\<^bsub>1\<^esub>)"
     using bij_is_fun comp_fun bij_converse_bij by blast+
   then
   obtain n where "n\<in>\<omega>" "|(f O g)-``{n}| = \<aleph>\<^bsub>1\<^esub>"
     using Aleph1_eq_cardinal_vimage by auto
   then
   have "\<aleph>\<^bsub>1\<^esub> = |converse(g) `` (f -``{n})|"
     using image_comp converse_comp
     unfolding vimage_def by simp
   also from \<open>converse(g) \<in> bij(X, \<aleph>\<^bsub>1\<^esub>)\<close> \<open>f: X\<rightarrow> \<omega>\<close>
   have "\<dots> = |f -``{n}|"
     using range_of_subset_eqpoll[of "converse(g)" X  _ "f -``{n}"]
       bij_is_inj cardinal_cong bij_is_fun eqpoll_sym Pi_vimage_subset
     by fastforce
   finally
   show ?thesis using \<open>n\<in>\<omega>\<close> by auto
 qed
 
 
 subsection\<open>Applications of transfinite recursive constructions\<close>
 
 definition
   rec_constr :: "[i,i] \<Rightarrow> i" where
   "rec_constr(f,\<alpha>) \<equiv> transrec(\<alpha>,\<lambda>a g. f`(g``a))"
 
 text\<open>The function \<^term>\<open>rec_constr\<close> allows to perform \<^emph>\<open>recursive
      constructions\<close>: given a choice function on the powerset of some
      set, a transfinite sequence is created by successively choosing
      some new element.
 
      The next result explains its use.\<close>
 
 lemma rec_constr_unfold: "rec_constr(f,\<alpha>) = f`({rec_constr(f,\<beta>). \<beta>\<in>\<alpha>})"
   using def_transrec[OF rec_constr_def, of f \<alpha>] image_lam by simp
 
 lemma rec_constr_type: assumes "f:Pow(G)\<rightarrow> G" "Ord(\<alpha>)"
   shows "rec_constr(f,\<alpha>) \<in> G"
   using assms(2,1)
   by (induct rule:trans_induct)
     (subst rec_constr_unfold, rule apply_type[of f "Pow(G)" "\<lambda>_. G"], auto)
 
 text\<open>The next lemma is an application of recursive constructions.
      It works under the assumption that whenever the already constructed
      subsequence is small enough, another element can be added.\<close>
 
 lemma bounded_cardinal_selection:
   includes Ord_dests
   assumes
     "\<And>X. |X| < \<gamma> \<Longrightarrow> X \<subseteq> G \<Longrightarrow> \<exists>a\<in>G. \<forall>s\<in>X. Q(s,a)" "b\<in>G" "Card(\<gamma>)"
   shows
     "\<exists>S. S : \<gamma> \<rightarrow> G \<and> (\<forall>\<alpha> \<in> \<gamma>. \<forall>\<beta> \<in> \<gamma>.  \<alpha><\<beta> \<longrightarrow> Q(S`\<alpha>,S`\<beta>))"
 proof -
-  let ?cdlt\<gamma>="{X\<in>Pow(G) . |X|<\<gamma>}" \<comment> \<open>“cardinal less than \<^term>\<open>\<gamma>\<close>”\<close>
+  let ?cdlt\<gamma>="{X\<in>Pow(G) . |X|<\<gamma>}" \<comment> \<open>``cardinal less than \<^term>\<open>\<gamma>\<close>''\<close>
     and ?inQ="\<lambda>Y.{a\<in>G. \<forall>s\<in>Y. Q(s,a)}"
   from assms
   have "\<forall>Y \<in> ?cdlt\<gamma>. \<exists>a. a \<in> ?inQ(Y)"
     by blast
   then
   have "\<exists>f. f \<in> Pi(?cdlt\<gamma>,?inQ)"
     using AC_ball_Pi[of ?cdlt\<gamma> ?inQ] by simp
   then
   obtain f where f_type:"f \<in> Pi(?cdlt\<gamma>,?inQ)"
     by auto
   moreover
   define Cb where "Cb \<equiv> \<lambda>_\<in>Pow(G)-?cdlt\<gamma>. b"
   moreover from \<open>b\<in>G\<close>
   have "Cb \<in> Pow(G)-?cdlt\<gamma> \<rightarrow> G"
     unfolding Cb_def by simp
   moreover
   note \<open>Card(\<gamma>)\<close>
   ultimately
   have "f \<union> Cb : (\<Prod>x\<in>Pow(G). ?inQ(x) \<union> G)" using
       fun_Pi_disjoint_Un[ of f ?cdlt\<gamma>  ?inQ Cb "Pow(G)-?cdlt\<gamma>" "\<lambda>_.G"]
       Diff_partition[of "{X\<in>Pow(G). |X|<\<gamma>}" "Pow(G)", OF Collect_subset]
     by auto
   moreover
   have "?inQ(x) \<union> G = G" for x by auto
   ultimately
   have "f \<union> Cb : Pow(G) \<rightarrow> G" by simp
   define S where "S\<equiv>\<lambda>\<alpha>\<in>\<gamma>. rec_constr(f \<union> Cb, \<alpha>)"
   from \<open>f \<union> Cb: Pow(G) \<rightarrow> G\<close> \<open>Card(\<gamma>)\<close>
   have "S : \<gamma> \<rightarrow> G"
     using Ord_in_Ord unfolding S_def
     by (intro lam_type rec_constr_type) auto
   moreover
   have "\<forall>\<alpha>\<in>\<gamma>. \<forall>\<beta>\<in>\<gamma>. \<alpha> < \<beta> \<longrightarrow> Q(S ` \<alpha>, S ` \<beta>)"
   proof (intro ballI impI)
     fix \<alpha> \<beta>
     assume "\<beta>\<in>\<gamma>"
     with \<open>Card(\<gamma>)\<close>
     have "{rec_constr(f \<union> Cb, x) . x\<in>\<beta>} = {S`x . x \<in> \<beta>}"
       using Ord_trans[OF _ _ Card_is_Ord, of _ \<beta> \<gamma>]
       unfolding S_def
       by auto
     moreover from \<open>\<beta>\<in>\<gamma>\<close> \<open>S : \<gamma> \<rightarrow> G\<close> \<open>Card(\<gamma>)\<close>
     have "{S`x . x \<in> \<beta>} \<subseteq> G"
       using Ord_trans[OF _ _ Card_is_Ord, of _ \<beta> \<gamma>]
         apply_type[of S \<gamma> "\<lambda>_. G"] by auto
     moreover from \<open>Card(\<gamma>)\<close> \<open>\<beta>\<in>\<gamma>\<close>
     have "|{S`x . x \<in> \<beta>}| < \<gamma>"
       using cardinal_RepFun_le[of \<beta>]  Ord_in_Ord
         lt_trans1[of "|{S`x . x \<in> \<beta>}|" "|\<beta>|" \<gamma>]
         Card_lt_iff[THEN iffD2, of \<beta> \<gamma>, OF _ _ ltI]
       by force
     moreover
     have "\<forall>x\<in>\<beta>. Q(S`x, f ` {S`x . x \<in> \<beta>})"
     proof -
       from calculation and f_type
       have "f ` {S`x . x \<in> \<beta>} \<in> {a\<in>G. \<forall>x\<in>\<beta>. Q(S`x,a)}"
         using apply_type[of f ?cdlt\<gamma> ?inQ "{S`x . x \<in> \<beta>}"]
         by blast
       then
       show ?thesis by simp
     qed
     moreover
     assume "\<alpha>\<in>\<gamma>" "\<alpha> < \<beta>"
     moreover
     note \<open>\<beta>\<in>\<gamma>\<close> \<open>Cb \<in> Pow(G)-?cdlt\<gamma> \<rightarrow> G\<close>
     ultimately
     show "Q(S ` \<alpha>, S ` \<beta>)"
       using fun_disjoint_apply1[of "{S`x . x \<in> \<beta>}" Cb f]
         domain_of_fun[of Cb] ltD[of \<alpha> \<beta>]
       by (subst (2) S_def, auto) (subst rec_constr_unfold, auto)
   qed
   ultimately
   show ?thesis by blast
 qed
 
 text\<open>The following basic result can, in turn, be proved by a
      bounded-cardinal selection.\<close>
 lemma Infinite_iff_lepoll_nat: "Infinite(X) \<longleftrightarrow> \<omega> \<lesssim> X"
 proof
   assume "Infinite(X)"
   then
   obtain b where "b\<in>X"
     using Infinite_not_empty by auto
   {
     fix Y
     assume "|Y| < \<omega>"
     then
     have "Finite(Y)"
       using Finite_cardinal_iff' ltD nat_into_Finite by blast
     with \<open>Infinite(X)\<close>
     have "X \<noteq> Y" by auto
   }
   with \<open>b\<in>X\<close>
   obtain S where "S : \<omega> \<rightarrow> X"  "\<forall>\<alpha>\<in>\<omega>. \<forall>\<beta>\<in>\<omega>. \<alpha> < \<beta> \<longrightarrow> S`\<alpha> \<noteq> S`\<beta>"
     using bounded_cardinal_selection[of \<omega> X "\<lambda>x y. x\<noteq>y"]
       Card_nat by blast
   moreover from this
   have "\<alpha> \<in> \<omega> \<Longrightarrow> \<beta> \<in> \<omega> \<Longrightarrow> \<alpha>\<noteq>\<beta> \<Longrightarrow> S`\<alpha> \<noteq> S`\<beta>" for \<alpha> \<beta>
     by (rule_tac lt_neq_symmetry[of "\<omega>" "\<lambda>\<alpha> \<beta>. S`\<alpha> \<noteq> S`\<beta>"])
       auto
   ultimately
   show "\<omega> \<lesssim> X"
     unfolding lepoll_def inj_def by blast
 qed (intro lepoll_nat_imp_Infinite)
 
 lemma Infinite_InfCard_cardinal: "Infinite(X) \<Longrightarrow> InfCard(|X|)"
   using lepoll_eq_trans eqpoll_sym lepoll_nat_imp_Infinite
     Infinite_iff_lepoll_nat Inf_Card_is_InfCard cardinal_eqpoll
   by simp
 
 lemma Finite_to_one_surj_imp_cardinal_eq:
   assumes "F \<in> Finite_to_one(X,Y) \<inter> surj(X,Y)" "Infinite(X)"
   shows "|Y| = |X|"
 proof -
   from \<open>F \<in> Finite_to_one(X,Y) \<inter> surj(X,Y)\<close>
   have "X = (\<Union>y\<in>Y. {x\<in>X . F`x = y})"
     using apply_type by fastforce
   show ?thesis
   proof (cases "Finite(Y)")
     case True
     with \<open>X = (\<Union>y\<in>Y. {x\<in>X . F`x = y})\<close> and assms
     show ?thesis
       using Finite_RepFun[THEN [2] Finite_Union, of Y "\<lambda>y. {x\<in>X . F`x = y}"]
       by auto
   next
     case False
     moreover from this
     have "Y \<lesssim> |Y|"
       using cardinal_eqpoll eqpoll_sym eqpoll_imp_lepoll by simp
     moreover
     note assms
     moreover from calculation
     have "y \<in> Y \<Longrightarrow> |{x\<in>X . F`x = y}| \<le> |Y|" for y
       using Infinite_imp_nats_lepoll[THEN lepoll_imp_cardinal_le, of Y
           "|{x\<in>X . F`x = y}|"] cardinal_idem by auto
     ultimately
     have "|\<Union>y\<in>Y. {x\<in>X . F`x = y}| \<le> |Y|"
       using leqpoll_imp_cardinal_UN_le[of "|Y|" Y]
         Infinite_InfCard_cardinal[of Y] by simp
     moreover from \<open>F \<in> Finite_to_one(X,Y) \<inter> surj(X,Y)\<close>
     have "|Y| \<le> |X|"
       using surj_implies_cardinal_le by auto
     moreover
     note \<open>X = (\<Union>y\<in>Y. {x\<in>X . F`x = y})\<close>
     ultimately
     show ?thesis
       using le_anti_sym by auto
   qed
 qed
 
 lemma cardinal_map_Un:
   assumes "Infinite(X)" "Finite(b)"
   shows "|{a \<union> b . a \<in> X}| = |X|"
 proof -
   have "(\<lambda>a\<in>X. a \<union> b) \<in> Finite_to_one(X,{a \<union> b . a \<in> X})"
     "(\<lambda>a\<in>X. a \<union> b) \<in>  surj(X,{a \<union> b . a \<in> X})"
     unfolding surj_def
   proof
     fix d
     have "Finite({a \<in> X . a \<union> b = d})" (is "Finite(?Y(b,d))")
       using \<open>Finite(b)\<close>
     proof (induct arbitrary:d)
       case 0
       have "{a \<in> X . a \<union> 0 = d} = (if d\<in>X then {d} else 0)"
         by auto
       then
       show ?case by simp
     next
       case (cons c b)
       from \<open>c \<notin> b\<close>
       have "?Y(cons(c,b),d) \<subseteq> (if c\<in>d then ?Y(b,d) \<union> ?Y(b,d-{c}) else 0)"
         by auto
       with cons
       show ?case
         using subset_Finite
         by simp
     qed
     moreover
     assume "d \<in> {x \<union> b . x \<in> X}"
     ultimately
     show "Finite({a \<in> X . (\<lambda>x\<in>X. x \<union> b) ` a = d})"
       by simp
   qed (auto intro:lam_funtype)
   with assms
   show ?thesis
     using Finite_to_one_surj_imp_cardinal_eq by fast
 qed
 
 end
\ No newline at end of file
diff --git a/thys/Delta_System_Lemma/Cofinality.thy b/thys/Delta_System_Lemma/Cofinality.thy
--- a/thys/Delta_System_Lemma/Cofinality.thy
+++ b/thys/Delta_System_Lemma/Cofinality.thy
@@ -1,1205 +1,1205 @@
 section\<open>Cofinality\label{sec:cofinality}\<close>
 
 theory Cofinality
   imports
     ZF_Library
 begin
 
 
 subsection\<open>Basic results and definitions\<close>
 
 text\<open>A set \<^term>\<open>X\<close> is \<^emph>\<open>cofinal\<close> in \<^term>\<open>A\<close> (with respect to the relation
-    \<^term>\<open>r\<close>) if every element of \<^term>\<open>A\<close> is “bounded
-    above” by some element of \<^term>\<open>X\<close>. Note that \<^term>\<open>X\<close> does not need 
+    \<^term>\<open>r\<close>) if every element of \<^term>\<open>A\<close> is ``bounded
+    above'' by some element of \<^term>\<open>X\<close>. Note that \<^term>\<open>X\<close> does not need 
     to be a subset of \<^term>\<open>A\<close>.\<close>
 definition
   cofinal :: "[i,i,i] \<Rightarrow> o" where
   "cofinal(X,A,r) \<equiv> \<forall>a\<in>A. \<exists>x\<in>X. \<langle>a,x\<rangle>\<in>r \<or> a = x"
 
 (*
 (* Alternative definitions *)
 definition
   cofinal_predic :: "[i,i,[i,i]\<Rightarrow>o] \<Rightarrow> o" where
   "cofinal_predic(X,A,r) \<equiv> \<forall>a\<in>A. \<exists>x\<in>X. r(a,x) \<or> a = x"
 
 definition
   f_cofinal :: "[i\<Rightarrow>i,i,i,i] \<Rightarrow> o" where
   "f_cofinal(f,C,A,r) \<equiv> \<forall>a\<in>A. \<exists>x\<in>C. \<langle>a,f(x)\<rangle>\<in>r \<or> a = f(x)"
 
 (* The next definition doesn't work if 0 is the top element of A.
    But it works for limit ordinals. *)
 definition
   cofinal_fun' :: "[i,i,i] \<Rightarrow> o" where
   "cofinal_fun'(f,A,r) == f_cofinal(\<lambda>x. f`x,domain(f),A, r)"
 *)
 
 text\<open>A function is cofinal if it range is.\<close>
 definition
   cofinal_fun :: "[i,i,i] \<Rightarrow> o" where
   "cofinal_fun(f,A,r) \<equiv> \<forall>a\<in>A. \<exists>x\<in>domain(f). \<langle>a,f`x\<rangle>\<in>r \<or> a = f`x"
 
 lemma cofinal_funI:
   assumes "\<And>a. a\<in>A \<Longrightarrow> \<exists>x\<in>domain(f). \<langle>a,f`x\<rangle>\<in>r \<or> a = f`x"
   shows "cofinal_fun(f,A,r)"
   using assms unfolding cofinal_fun_def by simp
 
 lemma cofinal_funD:
   assumes "cofinal_fun(f,A,r)" "a\<in>A"
   shows "\<exists>x\<in>domain(f). \<langle>a,f`x\<rangle>\<in>r \<or> a = f`x"
   using assms unfolding cofinal_fun_def by simp
 
 lemma cofinal_in_cofinal:
   assumes
     "trans(r)" "cofinal(Y,X,r)" "cofinal(X,A,r)"
   shows
     "cofinal(Y,A,r)"
   unfolding cofinal_def
 proof
   fix a
   assume "a\<in>A"
   moreover from \<open>cofinal(X,A,r)\<close>
   have "b\<in>A\<Longrightarrow>\<exists>x\<in>X. \<langle>b,x\<rangle>\<in>r \<or> b=x" for b
     unfolding cofinal_def by simp
   ultimately
   obtain y where "y\<in>X" "\<langle>a,y\<rangle>\<in>r \<or> a=y" by auto
   moreover from \<open>cofinal(Y,X,r)\<close>
   have "c\<in>X\<Longrightarrow>\<exists>y\<in>Y. \<langle>c,y\<rangle>\<in>r \<or> c=y" for c
     unfolding cofinal_def by simp
   ultimately
   obtain x where "x\<in>Y" "\<langle>y,x\<rangle>\<in>r \<or> y=x" by auto
   with \<open>a\<in>A\<close> \<open>y\<in>X\<close> \<open>\<langle>a,y\<rangle>\<in>r \<or> a=y\<close> \<open>trans(r)\<close>
   show "\<exists>x\<in>Y. \<langle>a,x\<rangle>\<in>r \<or> a=x" unfolding trans_def by auto
 qed
 
 lemma codomain_is_cofinal:
   assumes "cofinal_fun(f,A,r)" "f:C \<rightarrow> D"
   shows "cofinal(D,A,r)"
   unfolding cofinal_def
 proof
   fix b
   assume "b \<in> A"
   moreover from assms
   have "a\<in>A \<Longrightarrow> \<exists>x\<in>domain(f). \<langle>a, f ` x\<rangle> \<in> r \<or> a = f`x" for a
     unfolding cofinal_fun_def by simp
   ultimately
   obtain x where "x\<in>domain(f)" "\<langle>b, f ` x\<rangle> \<in> r \<or> b = f`x"
     by blast
   moreover from \<open>f:C \<rightarrow> D\<close>  \<open>x\<in>domain(f)\<close>
   have "f`x\<in>D"
     using domain_of_fun apply_rangeI by simp
   ultimately
   show  "\<exists>y\<in>D. \<langle>b, y\<rangle> \<in> r \<or> b = y" by auto
 qed
 
 lemma cofinal_range_iff_cofinal_fun:
   assumes "function(f)"
   shows "cofinal(range(f),A,r) \<longleftrightarrow> cofinal_fun(f,A,r)"
   unfolding cofinal_fun_def
 proof (intro iffI ballI)
   fix a
   assume "a\<in>A" \<open>cofinal(range(f),A,r)\<close>
   then
   obtain y where "y\<in>range(f)" "\<langle>a,y\<rangle> \<in> r \<or> a = y"
     unfolding cofinal_def by blast
   moreover from this
   obtain x where "\<langle>x,y\<rangle>\<in>f"
     unfolding range_def domain_def converse_def by blast
   moreover
   note \<open>function(f)\<close>
   ultimately
   have "\<langle>a, f ` x\<rangle> \<in> r \<or> a = f ` x"
     using function_apply_equality by blast
   with \<open>\<langle>x,y\<rangle>\<in>f\<close>
   show "\<exists>x\<in>domain(f). \<langle>a, f ` x\<rangle> \<in> r \<or> a = f ` x"  by blast
 next
   assume "\<forall>a\<in>A. \<exists>x\<in>domain(f). \<langle>a, f ` x\<rangle> \<in> r \<or> a = f ` x"
   with assms
   show "cofinal(range(f), A, r)"
     using function_apply_Pair[of f] unfolding cofinal_def by fast
 qed
 
 lemma cofinal_comp:
   assumes
     "f\<in> mono_map(C,s,D,r)" "cofinal_fun(f,D,r)" "h:B \<rightarrow> C"  "cofinal_fun(h,C,s)"
     "trans(r)"
   shows "cofinal_fun(f O h,D,r)"
   unfolding cofinal_fun_def
 proof
   fix a
   from \<open>f\<in> mono_map(C,s,D,r)\<close>
   have "f:C \<rightarrow> D"
     using mono_map_is_fun by simp
   with \<open>h:B \<rightarrow> C\<close>
   have "domain(f) = C" "domain(h) = B"
     using domain_of_fun by simp_all
   moreover
   assume "a \<in> D"
   moreover
   note \<open>cofinal_fun(f,D,r)\<close>
   ultimately
   obtain c where "c\<in>C"  "\<langle>a, f ` c\<rangle> \<in> r \<or> a = f ` c"
     unfolding cofinal_fun_def by blast
   with \<open>cofinal_fun(h,C,s)\<close> \<open>domain(h) = B\<close>
   obtain b where "b \<in> B"  "\<langle>c, h ` b\<rangle> \<in> s \<or> c = h ` b"
     unfolding cofinal_fun_def by blast
   moreover from this and \<open>h:B \<rightarrow> C\<close>
   have "h`b \<in> C" by simp
   moreover
   note \<open>f \<in> mono_map(C,s,D,r)\<close>  \<open>c\<in>C\<close>
   ultimately
   have "\<langle>f`c, f` (h ` b)\<rangle> \<in> r \<or> f`c = f` (h ` b)"
     unfolding mono_map_def by blast
   with \<open>\<langle>a, f ` c\<rangle> \<in> r \<or> a = f ` c\<close> \<open>trans(r)\<close> \<open>h:B \<rightarrow> C\<close> \<open>b\<in>B\<close>
   have "\<langle>a, (f O h) ` b\<rangle> \<in> r \<or> a = (f O h) ` b"
     using transD by auto
   moreover from \<open>h:B \<rightarrow> C\<close> \<open>domain(f) = C\<close> \<open>domain(h) = B\<close>
   have "domain(f O h) = B"
     using range_fun_subset_codomain by blast
   moreover
   note \<open>b\<in>B\<close>
   ultimately
   show "\<exists>x\<in>domain(f O h). \<langle>a, (f O h) ` x\<rangle> \<in> r \<or> a = (f O h) ` x"  by blast
 qed
 
 definition
   cf_fun :: "[i,i] \<Rightarrow> o" where
   "cf_fun(f,\<alpha>) \<equiv> cofinal_fun(f,\<alpha>,Memrel(\<alpha>))"
 
 lemma cf_funI[intro!]: "cofinal_fun(f,\<alpha>,Memrel(\<alpha>)) \<Longrightarrow> cf_fun(f,\<alpha>)"
   unfolding cf_fun_def by simp
 
 lemma cf_funD[dest!]: "cf_fun(f,\<alpha>) \<Longrightarrow> cofinal_fun(f,\<alpha>,Memrel(\<alpha>))"
   unfolding cf_fun_def by simp
 
 lemma cf_fun_comp:
   assumes
     "Ord(\<alpha>)" "f\<in> mono_map(C,s,\<alpha>,Memrel(\<alpha>))" "cf_fun(f,\<alpha>)"
     "h:B \<rightarrow> C" "cofinal_fun(h,C,s)"
   shows "cf_fun(f O h,\<alpha>)"
   using assms cofinal_comp[OF _ _ _ _ trans_Memrel] by auto
 
 definition
   cf :: "i\<Rightarrow>i" where
   "cf(\<gamma>) \<equiv> \<mu> \<beta>.  \<exists>A. A\<subseteq>\<gamma> \<and> cofinal(A,\<gamma>,Memrel(\<gamma>)) \<and> \<beta> = ordertype(A,Memrel(\<gamma>))"
 
 lemma Ord_cf [TC]: "Ord(cf(\<beta>))"
   unfolding cf_def using Ord_Least by simp
 
 lemma gamma_cofinal_gamma:
   assumes "Ord(\<gamma>)"
   shows "cofinal(\<gamma>,\<gamma>,Memrel(\<gamma>))"
   unfolding cofinal_def by auto
 
 lemma cf_is_ordertype:
   assumes "Ord(\<gamma>)"
   shows "\<exists>A. A\<subseteq>\<gamma> \<and> cofinal(A,\<gamma>,Memrel(\<gamma>)) \<and> cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))"
     (is "?P(cf(\<gamma>))")
   using gamma_cofinal_gamma LeastI[of ?P \<gamma>] ordertype_Memrel[symmetric] assms
   unfolding cf_def by blast
 
 lemma cf_fun_succ':
   assumes "Ord(\<beta>)" "Ord(\<alpha>)" "f:\<alpha>\<rightarrow>succ(\<beta>)"
   shows "(\<exists>x\<in>\<alpha>. f`x=\<beta>) \<longleftrightarrow> cf_fun(f,succ(\<beta>))"
 proof (intro iffI)
   assume "(\<exists>x\<in>\<alpha>. f`x=\<beta>)"
   with assms
   show "cf_fun(f,succ(\<beta>))"
     using domain_of_fun[OF \<open>f:\<alpha>\<rightarrow>succ(\<beta>)\<close>]
     unfolding cf_fun_def cofinal_fun_def by auto
 next
   assume "cf_fun(f,succ(\<beta>))"
   with assms
   obtain x where "x\<in>\<alpha>" "\<langle>\<beta>,f`x\<rangle> \<in> Memrel(succ(\<beta>)) \<or> \<beta> = f ` x"
     using domain_of_fun[OF \<open>f:\<alpha>\<rightarrow>succ(\<beta>)\<close>]
     unfolding cf_fun_def cofinal_fun_def by auto
   moreover from \<open>Ord(\<beta>)\<close>
   have "\<langle>\<beta>,y\<rangle> \<notin> Memrel(succ(\<beta>))" for y
     using foundation unfolding Memrel_def by blast
   ultimately
   show "\<exists>x\<in>\<alpha>. f ` x = \<beta>" by blast
 qed
 
 lemma cf_fun_succ:
   "Ord(\<beta>) \<Longrightarrow> f:1\<rightarrow>succ(\<beta>) \<Longrightarrow> f`0=\<beta> \<Longrightarrow> cf_fun(f,succ(\<beta>))"
   using cf_fun_succ' by blast
 
 lemma ordertype_0_not_cofinal_succ:
   assumes "ordertype(A,Memrel(succ(i))) = 0"  "A\<subseteq>succ(i)" "Ord(i)"
   shows "\<not>cofinal(A,succ(i),Memrel(succ(i)))"
 proof
   have 1:"ordertype(A,Memrel(succ(i))) = ordertype(0,Memrel(0))"
     using \<open>ordertype(A,Memrel(succ(i))) = 0\<close> ordertype_0 by simp
   from  \<open>A\<subseteq>succ(i)\<close> \<open>Ord(i)\<close>
   have "\<exists>f. f \<in> \<langle>A, Memrel(succ(i))\<rangle> \<cong> \<langle>0, Memrel(0)\<rangle>"
     using   well_ord_Memrel well_ord_subset
       ordertype_eq_imp_ord_iso[OF 1] Ord_0  by blast
   then
   have "A=0"
     using  ord_iso_is_bij bij_imp_eqpoll eqpoll_0_is_0 by blast
   moreover
   assume "cofinal(A, succ(i), Memrel(succ(i)))"
   moreover
   note \<open>Ord(i)\<close>
   ultimately
   show "False"
     using not_mem_empty unfolding cofinal_def by auto
 qed
 
 text\<open>I thank Edwin Pacheco Rodríguez for the following lemma.\<close>
 lemma cf_succ:
   assumes "Ord(\<alpha>)"
   shows "cf(succ(\<alpha>)) = 1"
 proof -
   define f where "f \<equiv> {\<langle>0,\<alpha>\<rangle>}"
   then
   have  "f : 1\<rightarrow>succ(\<alpha>)" "f`0 = \<alpha>"
     using fun_extend3[of 0 0 "succ(\<alpha>)" 0 \<alpha>] singleton_0 by auto
   with assms
   have "cf_fun(f,succ(\<alpha>))"
     using cf_fun_succ unfolding cofinal_fun_def by simp
   from \<open>f:1\<rightarrow>succ(\<alpha>)\<close>
   have "0\<in>domain(f)" using domain_of_fun by simp
   define A where "A={f`0}"
   with \<open>cf_fun(f,succ(\<alpha>))\<close> \<open>0\<in>domain(f)\<close> \<open>f`0=\<alpha>\<close>
   have "cofinal(A,succ(\<alpha>),Memrel(succ(\<alpha>)))"
     unfolding cofinal_def cofinal_fun_def by simp
   moreover from  \<open>f`0=\<alpha>\<close> \<open>A={f`0}\<close>
   have "A \<subseteq> succ(\<alpha>)" unfolding succ_def  by auto
   moreover from \<open>Ord(\<alpha>)\<close> \<open>A\<subseteq> succ(\<alpha>)\<close>
   have "well_ord(A,Memrel(succ(\<alpha>)))"
     using Ord_succ well_ord_Memrel  well_ord_subset relation_Memrel by blast
   moreover from \<open>Ord(\<alpha>)\<close>
   have "\<not>(\<exists>A. A \<subseteq> succ(\<alpha>) \<and> cofinal(A, succ(\<alpha>), Memrel(succ(\<alpha>))) \<and> 0 = ordertype(A, Memrel(succ(\<alpha>))))"
     (is "\<not>?P(0)")
     using ordertype_0_not_cofinal_succ  unfolding cf_def  by auto
   moreover
   have "1 = ordertype(A,Memrel(succ(\<alpha>)))"
   proof -
     from \<open>A={f`0}\<close>
     have "A\<approx>1" using singleton_eqpoll_1 by simp
     with \<open>well_ord(A,Memrel(succ(\<alpha>)))\<close>
     show ?thesis using nat_1I ordertype_eq_n by simp
   qed
   ultimately
   show "cf(succ(\<alpha>)) = 1" using Ord_1  Least_equality[of ?P 1]
     unfolding cf_def by blast
 qed
 
 lemma cf_zero [simp]:
   "cf(0) = 0"
   unfolding cf_def cofinal_def using
     ordertype_0 subset_empty_iff Least_le[of _ 0] by auto
 
 lemma surj_is_cofinal: "f \<in> surj(\<delta>,\<gamma>) \<Longrightarrow> cf_fun(f,\<gamma>)"
   unfolding surj_def cofinal_fun_def cf_fun_def
   using domain_of_fun by force
 
 lemma cf_zero_iff: "Ord(\<alpha>) \<Longrightarrow> cf(\<alpha>) = 0 \<longleftrightarrow> \<alpha> = 0"
 proof (intro iffI)
   assume "\<alpha> = 0" "Ord(\<alpha>)"
   then
   show "cf(\<alpha>) = 0" using cf_zero by simp
 next
   assume "cf(\<alpha>) = 0" "Ord(\<alpha>)"
   moreover from this
   obtain A where "A\<subseteq>\<alpha>" "cf(\<alpha>) = ordertype(A,Memrel(\<alpha>))"
     "cofinal(A,\<alpha>,Memrel(\<alpha>))"
     using cf_is_ordertype by blast
   ultimately
   have "cofinal(0,\<alpha>,Memrel(\<alpha>))"
     using ordertype_zero_imp_zero[of A "Memrel(\<alpha>)"] by simp
   then
   show "\<alpha>=0"
     unfolding cofinal_def by blast
 qed
 
 \<comment> \<open>TODO: define Succ (predicate for successor ordinals)\<close>
 lemma cf_eq_one_iff:
   assumes "Ord(\<gamma>)"
   shows "cf(\<gamma>) = 1 \<longleftrightarrow> (\<exists>\<alpha>. Ord(\<alpha>) \<and> \<gamma>  = succ(\<alpha>))"
 proof (intro iffI)
   assume "\<exists>\<alpha>. Ord(\<alpha>) \<and> \<gamma>  = succ(\<alpha>)"
   then
   show "cf(\<gamma>) = 1" using cf_succ by auto
 next
   assume "cf(\<gamma>) = 1"
   moreover from assms
   obtain A where "A \<subseteq> \<gamma>" "cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))"
     "cofinal(A,\<gamma>,Memrel(\<gamma>))"
     using cf_is_ordertype by blast
   ultimately
   have "ordertype(A,Memrel(\<gamma>)) = 1" by simp
   moreover
   define f where "f\<equiv>converse(ordermap(A,Memrel(\<gamma>)))"
   moreover from this \<open>ordertype(A,Memrel(\<gamma>)) = 1\<close> \<open>A \<subseteq> \<gamma>\<close> assms
   have "f \<in> surj(1,A)"
     using well_ord_subset[OF well_ord_Memrel, THEN ordermap_bij,
         THEN bij_converse_bij, of \<gamma> A] bij_is_surj
     by simp
   with \<open>cofinal(A,\<gamma>,Memrel(\<gamma>))\<close>
   have "\<forall>a\<in>\<gamma>. \<langle>a, f`0\<rangle> \<in> Memrel(\<gamma>) \<or> a = f`0"
     unfolding cofinal_def surj_def
     by auto
   with assms \<open>A \<subseteq> \<gamma>\<close> \<open>f \<in> surj(1,A)\<close>
   show "\<exists>\<alpha>. Ord(\<alpha>) \<and> \<gamma>  = succ(\<alpha>)"
     using Ord_has_max_imp_succ[of \<gamma> "f`0"]
       surj_is_fun[of f 1 A] apply_type[of f 1 "\<lambda>_.A" 0]
     unfolding lt_def
     by (auto intro:Ord_in_Ord)
 qed
 
 lemma ordertype_in_cf_imp_not_cofinal:
   assumes
     "ordertype(A,Memrel(\<gamma>)) \<in> cf(\<gamma>)"
     "A \<subseteq> \<gamma>"
   shows
     "\<not> cofinal(A,\<gamma>,Memrel(\<gamma>))"
 proof
   note \<open>A \<subseteq> \<gamma>\<close>
   moreover
   assume "cofinal(A,\<gamma>,Memrel(\<gamma>))"
   ultimately
   have "\<exists>B. B \<subseteq> \<gamma> \<and> cofinal(B, \<gamma>, Memrel(\<gamma>)) \<and>  ordertype(A,Memrel(\<gamma>)) = ordertype(B, Memrel(\<gamma>))"
     (is "?P(ordertype(A,_))")
     by blast
   moreover from assms
   have "ordertype(A,Memrel(\<gamma>)) < cf(\<gamma>)"
     using Ord_cf ltI by blast
   ultimately
   show "False"
     unfolding cf_def using less_LeastE[of ?P  "ordertype(A,Memrel(\<gamma>))"]
     by auto
 qed
 
 lemma cofinal_mono_map_cf:
   assumes "Ord(\<gamma>)"
   shows "\<exists>j \<in> mono_map(cf(\<gamma>), Memrel(cf(\<gamma>)), \<gamma>, Memrel(\<gamma>)) . cf_fun(j,\<gamma>)"
 proof -
   note assms
   moreover from this
   obtain A where "A \<subseteq> \<gamma>" "cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))"
     "cofinal(A,\<gamma>,Memrel(\<gamma>))"
     using cf_is_ordertype by blast
   moreover
   define j where "j \<equiv> converse(ordermap(A,Memrel(\<gamma>)))"
   moreover from calculation
   have "j :cf(\<gamma>) \<rightarrow>\<^sub>< \<gamma>"
     using ordertype_ord_iso[THEN ord_iso_sym,
         THEN ord_iso_is_mono_map, THEN mono_map_mono,
         of A "Memrel(\<gamma>)" \<gamma>] well_ord_Memrel[THEN well_ord_subset]
     by simp
   moreover from calculation
   have "j \<in> surj(cf(\<gamma>),A)"
     using well_ord_Memrel[THEN well_ord_subset, THEN ordertype_ord_iso,
         THEN ord_iso_sym, of \<gamma> A, THEN ord_iso_is_bij,
         THEN bij_is_surj]
     by simp
   with \<open>cofinal(A,\<gamma>,Memrel(\<gamma>))\<close>
   have "cf_fun(j,\<gamma>)"
     using cofinal_range_iff_cofinal_fun[of j \<gamma> "Memrel(\<gamma>)"]
       surj_range[of j "cf(\<gamma>)" A] surj_is_fun fun_is_function
     by fastforce
   with \<open>j \<in> mono_map(_,_,_,_)\<close>
   show ?thesis by auto
 qed
 
 
 subsection\<open>The factorization lemma\<close>
 
 text\<open>In this subsection we prove a factorization lemma for cofinal functions
 into ordinals, which shows that any cofinal function between ordinals can be
-“decomposed” in such a way that a commutative triangle of strictly increasing
+``decomposed'' in such a way that a commutative triangle of strictly increasing
 maps arises.
 
 The factorization lemma has a kind of
 fundamental character, in that the rest of the basic results on cofinality
 (for, instance, idempotence) follow easily from it, in a more algebraic way.
 
 This is a consequence that the proof encapsulates uses of transfinite
 recursion in the basic theory of cofinality; indeed, only one use is needed.
 In the setting of Isabelle/ZF, this is convenient since the machinery of
 recursion is pretty clumsy. On the downside, this way of presenting things 
 results in a longer proof of the factorization lemma. This approach was
 taken by the author in the notes \cite{apunte_st} for an introductory course
 in Set Theory.
 
 To organize the use of the hypotheses of the factorization lemma,
 we set up a locale containing all the relevant ingredients.
 \<close>
 locale cofinal_factor =
   fixes j \<delta> \<xi> \<gamma> f
   assumes j_mono: "j :\<xi> \<rightarrow>\<^sub>< \<gamma>"
     and     ords: "Ord(\<delta>)" "Ord(\<xi>)" "Limit(\<gamma>)"
     and   f_type: "f: \<delta> \<rightarrow> \<gamma>"
 begin
 
 text\<open>Here, \<^term>\<open>f\<close> is cofinal function from \<^term>\<open>\<delta>\<close> to \<^term>\<open>\<gamma>\<close>, and the
 ordinal \<^term>\<open>\<xi>\<close> is meant to be the cofinality of \<^term>\<open>\<gamma>\<close>. Hence, there exists
 an increasing map \<^term>\<open>j\<close> from  \<^term>\<open>\<xi>\<close> to  \<^term>\<open>\<gamma>\<close> by the last lemma.
 
 The main goal is to construct an increasing function \<^term>\<open>g:\<xi>\<rightarrow>\<delta>\<close> such that
 the composition \<^term>\<open>f O g\<close> is still cofinal but also increasing.\<close>
 
 definition
   factor_body :: "[i,i,i] \<Rightarrow> o" where
   "factor_body(\<beta>,h,x) \<equiv> (x\<in>\<delta> \<and> j`\<beta> \<le> f`x \<and> (\<forall>\<alpha><\<beta> . f`(h`\<alpha>) < f`x)) \<or> x=\<delta>"
 
 definition
   factor_rec :: "[i,i] \<Rightarrow> i" where
   "factor_rec(\<beta>,h) \<equiv>  \<mu> x. factor_body(\<beta>,h,x)"
 
 txt\<open>\<^term>\<open>factor_rec\<close> is the inductive step for the definition by transfinite
 recursion of the \<^emph>\<open>factor\<close> function (called \<^term>\<open>g\<close> above), which in
 turn is obtained by minimizing the predicate \<^term>\<open>factor_body\<close>. Next we show
 that this predicate is monotonous.\<close>
 
 lemma factor_body_mono:
   assumes
     "\<beta>\<in>\<xi>" "\<alpha><\<beta>"
     "factor_body(\<beta>,\<lambda>x\<in>\<beta>. G(x),x)"
   shows
     "factor_body(\<alpha>,\<lambda>x\<in>\<alpha>. G(x),x)"
 proof -
   from \<open>\<alpha><\<beta>\<close>
   have "\<alpha>\<in>\<beta>" using ltD by simp
   moreover
   note \<open>\<beta>\<in>\<xi>\<close>
   moreover from calculation
   have "\<alpha>\<in>\<xi>" using ords ltD Ord_cf Ord_trans by blast
   ultimately
   have "j`\<alpha> \<in> j`\<beta>" using j_mono mono_map_increasing by blast
   moreover from \<open>\<beta>\<in>\<xi>\<close>
   have "j`\<beta>\<in>\<gamma>"
     using j_mono domain_of_fun apply_rangeI mono_map_is_fun by force
   moreover from this
   have "Ord(j`\<beta>)"
     using Ord_in_Ord ords Limit_is_Ord by auto
   ultimately
   have "j`\<alpha> \<le> j`\<beta>"  unfolding lt_def by blast
   then
   have "j`\<beta> \<le> f`\<theta> \<Longrightarrow> j`\<alpha> \<le> f`\<theta>" for \<theta> using le_trans by blast
   moreover
   have "f`((\<lambda>w\<in>\<alpha>. G(w))`y) < f`z" if "z\<in>\<delta>" "\<forall>x<\<beta>. f`((\<lambda>w\<in>\<beta>. G(w))`x) < f`z" "y<\<alpha>" for y z
   proof -
     note \<open>y<\<alpha>\<close>
     also
     note \<open>\<alpha><\<beta>\<close>
     finally
     have "y<\<beta>" by simp
     with \<open>\<forall>x<\<beta>. f`((\<lambda>w\<in>\<beta>. G(w))`x) < f`z\<close>
     have "f ` ((\<lambda>w\<in>\<beta>. G(w)) ` y) < f ` z" by simp
     moreover from \<open>y<\<alpha>\<close> \<open>y<\<beta>\<close>
     have "(\<lambda>w\<in>\<beta>. G(w)) ` y = (\<lambda>w\<in>\<alpha>. G(w)) ` y"
       using beta_if  by (auto dest:ltD)
     ultimately show ?thesis by simp
   qed
   moreover
   note \<open>factor_body(\<beta>,\<lambda>x\<in>\<beta>. G(x),x)\<close>
   ultimately
   show ?thesis
     unfolding factor_body_def by blast
 qed
 
 lemma factor_body_simp[simp]: "factor_body(\<alpha>,g,\<delta>)"
   unfolding factor_body_def by simp
 
 lemma factor_rec_mono:
   assumes
     "\<beta>\<in>\<xi>" "\<alpha><\<beta>"
   shows
     "factor_rec(\<alpha>,\<lambda>x\<in>\<alpha>. G(x)) \<le> factor_rec(\<beta>,\<lambda>x\<in>\<beta>. G(x))"
   unfolding factor_rec_def
   using assms ords factor_body_mono Least_antitone by simp
 
 text\<open>We now define the factor as higher-order function.
 Later it will be restricted to a set to obtain a bona fide function of
 type @{typ i}.\<close>
 definition
   factor :: "i \<Rightarrow> i" where
   "factor(\<beta>) \<equiv> transrec(\<beta>,factor_rec)"
 
 lemma factor_unfold:
   "factor(\<alpha>) = factor_rec(\<alpha>,\<lambda>x\<in>\<alpha>. factor(x))"
   using def_transrec[OF factor_def] .
 
 lemma factor_mono:
   assumes "\<beta>\<in>\<xi>" "\<alpha><\<beta>" "factor(\<alpha>)\<noteq>\<delta>" "factor(\<beta>)\<noteq>\<delta>"
   shows "factor(\<alpha>) \<le> factor(\<beta>)"
 proof -
   have "factor(\<alpha>) = factor_rec(\<alpha>, \<lambda>x\<in>\<alpha>. factor(x))"
     using factor_unfold .
   also from assms and factor_rec_mono
   have "... \<le> factor_rec(\<beta>, \<lambda>x\<in>\<beta>. factor(x))"
     by simp
   also
   have "factor_rec(\<beta>, \<lambda>x\<in>\<beta>. factor(x)) = factor(\<beta>)"
     using def_transrec[OF factor_def, symmetric] .
   finally show ?thesis .
 qed
 
 text\<open>The factor satisfies the predicate body of the minimization.\<close>
 
 lemma factor_body_factor:
   "factor_body(\<alpha>,\<lambda>x\<in>\<alpha>. factor(x),factor(\<alpha>))"
   using ords factor_unfold[of \<alpha>]
     LeastI[of "factor_body(_,_)" \<delta>]
   unfolding factor_rec_def by simp
 
 lemma factor_type [TC]: "Ord(factor(\<alpha>))"
   using ords factor_unfold[of \<alpha>]
   unfolding factor_rec_def by simp
 
 text\<open>The value \<^term>\<open>\<delta>\<close> in \<^term>\<open>factor_body\<close> (and therefore, in
-\<^term>\<open>factor\<close>) is meant to be a “default value”. Whenever it is not 
+\<^term>\<open>factor\<close>) is meant to be a ``default value''. Whenever it is not 
 attained, the factor function behaves as expected: It is increasing
 and its composition with \<^term>\<open>f\<close> also is.\<close>
 
 lemma f_factor_increasing:
   assumes "\<beta>\<in>\<xi>" "\<alpha><\<beta>" "factor(\<beta>)\<noteq>\<delta>"
   shows "f`factor(\<alpha>) < f`factor(\<beta>)"
 proof -
   from assms
   have "f ` ((\<lambda>x\<in>\<beta>. factor(x)) ` \<alpha>) < f ` factor(\<beta>)"
     using factor_unfold[of \<beta>] ords LeastI[of "factor_body(\<beta>,\<lambda>x\<in>\<beta>. factor(x))"]
     unfolding factor_rec_def factor_body_def
     by (auto simp del:beta_if)
   with \<open>\<alpha><\<beta>\<close>
   show ?thesis using ltD by auto
 qed
 
 lemma factor_increasing:
   assumes "\<beta>\<in>\<xi>" "\<alpha><\<beta>" "factor(\<alpha>)\<noteq>\<delta>" "factor(\<beta>)\<noteq>\<delta>"
   shows "factor(\<alpha>)<factor(\<beta>)"
   using assms f_factor_increasing factor_mono by (force intro:le_neq_imp_lt)
 
 lemma factor_in_delta:
   assumes "factor(\<beta>) \<noteq> \<delta>"
   shows "factor(\<beta>) \<in> \<delta>"
   using assms factor_body_factor ords
   unfolding factor_body_def by auto
 
 text\<open>Finally, we define the (set) factor function as the restriction of
 factor to the ordinal  \<^term>\<open>\<xi>\<close>.\<close>
 
 definition
   fun_factor :: "i" where
   "fun_factor \<equiv> \<lambda>\<beta>\<in>\<xi>. factor(\<beta>)"
 
 lemma fun_factor_is_mono_map:
   assumes "\<And>\<beta>. \<beta> \<in> \<xi> \<Longrightarrow> factor(\<beta>) \<noteq> \<delta>"
   shows "fun_factor \<in> mono_map(\<xi>, Memrel(\<xi>), \<delta>, Memrel(\<delta>))"
   unfolding mono_map_def
 proof (intro CollectI ballI impI)
   (* Proof that \<^term>\<open>fun_factor\<close> respects membership *)
   fix \<alpha> \<beta>
   assume "\<alpha>\<in>\<xi>" "\<beta>\<in>\<xi>"
   moreover
   note assms
   moreover from calculation
   have "factor(\<alpha>)\<noteq>\<delta>" "factor(\<beta>)\<noteq>\<delta>" "Ord(\<beta>)"
     using factor_in_delta Ord_in_Ord ords by auto
   moreover
   assume "\<langle>\<alpha>, \<beta>\<rangle> \<in> Memrel(\<xi>)"
   ultimately
   show "\<langle>fun_factor ` \<alpha>, fun_factor ` \<beta>\<rangle> \<in> Memrel(\<delta>)"
     unfolding fun_factor_def
     using ltI factor_increasing[THEN ltD] factor_in_delta
     by simp
 next
   (* Proof of type *)
   from assms
   show "fun_factor : \<xi> \<rightarrow> \<delta>"
     unfolding fun_factor_def
     using ltI lam_type factor_in_delta by simp
 qed
 
 lemma f_fun_factor_is_mono_map:
   assumes "\<And>\<beta>. \<beta> \<in> \<xi> \<Longrightarrow> factor(\<beta>) \<noteq> \<delta>"
   shows "f O fun_factor \<in> mono_map(\<xi>, Memrel(\<xi>), \<gamma>, Memrel(\<gamma>))"
   unfolding mono_map_def
   using f_type
 proof (intro CollectI ballI impI comp_fun[of _ _ \<delta>])
   from assms
   show "fun_factor : \<xi> \<rightarrow> \<delta>"
     using fun_factor_is_mono_map mono_map_is_fun by simp
       (* Proof that f O ?g respects membership *)
   fix \<alpha> \<beta>
   assume "\<langle>\<alpha>, \<beta>\<rangle> \<in> Memrel(\<xi>)"
   then
   have "\<alpha><\<beta>"
     using Ord_in_Ord[of "\<xi>"] ltI ords by blast
   assume "\<alpha>\<in>\<xi>" "\<beta>\<in>\<xi>"
   moreover from this and assms
   have "factor(\<alpha>)\<noteq>\<delta>" "factor(\<beta>)\<noteq>\<delta>" by auto
   moreover
   have "Ord(\<gamma>)" "\<gamma>\<noteq>0" using ords Limit_is_Ord by auto
   moreover
   note \<open>\<alpha><\<beta>\<close> \<open>fun_factor : \<xi> \<rightarrow> \<delta>\<close>
   ultimately
   show "\<langle>(f O fun_factor) ` \<alpha>, (f O fun_factor) ` \<beta>\<rangle> \<in> Memrel(\<gamma>)"
     using ltD[of "f ` factor(\<alpha>)" "f ` factor(\<beta>)"]
       f_factor_increasing apply_in_range f_type
     unfolding fun_factor_def by auto
 qed
 
 end (* cofinal_factor *)
 
 text\<open>We state next the factorization lemma.\<close>
 
 lemma cofinal_fun_factorization:
   notes le_imp_subset [dest] lt_trans2 [trans]
   assumes
     "Ord(\<delta>)" "Limit(\<gamma>)" "f: \<delta> \<rightarrow> \<gamma>" "cf_fun(f,\<gamma>)"
   shows
     "\<exists>g \<in> cf(\<gamma>) \<rightarrow>\<^sub>< \<delta>.  f O g : cf(\<gamma>) \<rightarrow>\<^sub>< \<gamma> \<and>
            cofinal_fun(f O g,\<gamma>,Memrel(\<gamma>))"
 proof -
   from \<open>Limit(\<gamma>)\<close>
   have "Ord(\<gamma>)" using Limit_is_Ord by simp
   then
   obtain j where "j :cf(\<gamma>) \<rightarrow>\<^sub>< \<gamma>" "cf_fun(j,\<gamma>)"
     using cofinal_mono_map_cf by blast
   then
   have "domain(j) = cf(\<gamma>)"
     using domain_of_fun mono_map_is_fun by force
   from \<open>j \<in> _\<close> assms
   interpret cofinal_factor j \<delta> "cf(\<gamma>)"
     by (unfold_locales) (simp_all)
   text\<open>The core of the argument is to show that the factor function
   indeed maps into \<^term>\<open>\<delta>\<close>, therefore its values satisfy the first
   disjunct of \<^term>\<open>factor_body\<close>. This holds in turn because no
   restriction of the factor composed with \<^term>\<open>f\<close> to a proper initial
   segment of \<^term>\<open>cf(\<gamma>)\<close> can be cofinal in \<^term>\<open>\<gamma>\<close> by definition of
   cofinality. Hence there must be a witness that satisfies the first
   disjunct.\<close>
   have factor_not_delta: "factor(\<beta>)\<noteq>\<delta>" if "\<beta> \<in> cf(\<gamma>)" for \<beta>
     text\<open>For this, we induct on \<^term>\<open>\<beta>\<close> ranging over \<^term>\<open>cf(\<gamma>)\<close>.\<close>
   proof (induct \<beta> rule:Ord_induct[OF _ Ord_cf[of \<gamma>]])
     case 1 with that show ?case .
   next
     case (2 \<beta>)
     then
     have IH: "z\<in>\<beta> \<Longrightarrow> factor(z)\<noteq>\<delta>" for z by simp
     define h where "h \<equiv> \<lambda>x\<in>\<beta>. f`factor(x)"
     from IH
     have "z\<in>\<beta> \<Longrightarrow> factor(z) \<in> \<delta>" for z
       using factor_in_delta by blast
     with \<open>f:\<delta>\<rightarrow>\<gamma>\<close>
     have "h : \<beta> \<rightarrow> \<gamma>" unfolding h_def using apply_funtype lam_type by auto
     then
     have "h : \<beta> \<rightarrow>\<^sub>< \<gamma>"
       unfolding mono_map_def
     proof (intro CollectI ballI impI)
       fix x y
       assume "x\<in>\<beta>" "y\<in>\<beta>"
       moreover from this and IH
       have "factor(y) \<noteq> \<delta>" by simp
       moreover from calculation and \<open>h \<in> \<beta> \<rightarrow> \<gamma>\<close>
       have "h`x \<in> \<gamma>" "h`y \<in> \<gamma>" by simp_all
       moreover from \<open>\<beta>\<in>cf(\<gamma>)\<close> and \<open>y\<in>\<beta>\<close>
       have "y \<in> cf(\<gamma>)"
         using Ord_trans Ord_cf by blast
       moreover from this
       have "Ord(y)"
         using Ord_cf Ord_in_Ord by blast
       moreover
       assume "\<langle>x,y\<rangle> \<in> Memrel(\<beta>)"
       moreover from calculation
       have "x<y" by (blast intro:ltI)
       ultimately
       show "\<langle>h ` x, h ` y\<rangle> \<in> Memrel(\<gamma>)"
         unfolding h_def using f_factor_increasing ltD by (auto)
     qed
     with \<open>\<beta>\<in>cf(\<gamma>)\<close> \<open>Ord(\<gamma>)\<close>
     have "ordertype(h``\<beta>,Memrel(\<gamma>)) = \<beta>" (* Maybe should use range(h) *)
       using mono_map_ordertype_image[of \<beta>] Ord_cf Ord_in_Ord by blast
     also
     note \<open>\<beta> \<in>cf(\<gamma>)\<close>
     finally
     have "ordertype(h``\<beta>,Memrel(\<gamma>)) \<in> cf(\<gamma>)" by simp
     moreover from \<open>h \<in> \<beta> \<rightarrow> \<gamma>\<close>
     have "h``\<beta> \<subseteq> \<gamma>"
       using mono_map_is_fun Image_sub_codomain by blast
     ultimately
     have "\<not> cofinal(h``\<beta>,\<gamma>,Memrel(\<gamma>))"
       using ordertype_in_cf_imp_not_cofinal by simp
     then
     obtain \<alpha>_0 where "\<alpha>_0\<in>\<gamma>" "\<forall>x\<in>h `` \<beta>. \<not> \<langle>\<alpha>_0, x\<rangle> \<in> Memrel(\<gamma>) \<and> \<alpha>_0 \<noteq> x"
       unfolding cofinal_def by auto
     with \<open>Ord(\<gamma>)\<close> \<open>h``\<beta> \<subseteq> \<gamma>\<close>
     have "\<forall>x\<in>h `` \<beta>. x \<in> \<alpha>_0"
       using well_ord_Memrel[of \<gamma>] well_ord_is_linear[of \<gamma> "Memrel(\<gamma>)"]
       unfolding linear_def by blast
     from \<open>\<alpha>_0 \<in> \<gamma>\<close> \<open>j \<in> mono_map(_,_,\<gamma>,_)\<close> \<open>Ord(\<gamma>)\<close>
     have "j`\<beta> \<in> \<gamma>"
       using mono_map_is_fun apply_in_range by force
     with \<open>\<alpha>_0 \<in> \<gamma>\<close> \<open>Ord(\<gamma>)\<close>
     have "\<alpha>_0 \<union> j`\<beta> \<in> \<gamma>"
       using Un_least_mem_iff Ord_in_Ord by auto
     with \<open>cf_fun(f,\<gamma>)\<close>
     obtain \<theta> where "\<theta>\<in>domain(f)" "\<langle>\<alpha>_0 \<union> j`\<beta>, f ` \<theta>\<rangle> \<in> Memrel(\<gamma>) \<or>  \<alpha>_0 \<union> j`\<beta> = f ` \<theta>"
       by (auto simp add:cofinal_fun_def) blast
     moreover from this and \<open>f:\<delta>\<rightarrow>\<gamma>\<close>
     have "\<theta> \<in> \<delta>" using domain_of_fun by auto
     moreover
     note \<open>Ord(\<gamma>)\<close>
     moreover from this and \<open>f:\<delta>\<rightarrow>\<gamma>\<close>  \<open>\<alpha>_0 \<in> \<gamma>\<close>
     have "Ord(f`\<theta>)"
       using apply_in_range Ord_in_Ord by blast
     moreover from calculation and \<open>\<alpha>_0 \<in> \<gamma>\<close> and \<open>Ord(\<delta>)\<close> and \<open>j`\<beta> \<in> \<gamma>\<close>
     have "Ord(\<alpha>_0)" "Ord(j`\<beta>)" "Ord(\<theta>)"
       using Ord_in_Ord by auto
     moreover from \<open>\<forall>x\<in>h `` \<beta>. x \<in> \<alpha>_0\<close> \<open>Ord(\<alpha>_0)\<close> \<open>h:\<beta>\<rightarrow>\<gamma>\<close>
     have "x\<in>\<beta> \<Longrightarrow> h`x < \<alpha>_0" for x
       using fun_is_function[of h \<beta> "\<lambda>_. \<gamma>"]
         Image_subset_Ord_imp_lt domain_of_fun[of h \<beta> "\<lambda>_. \<gamma>"]
       by blast
     moreover
     have "x\<in>\<beta> \<Longrightarrow> h`x < f`\<theta>" for x
     proof -
       fix x
       assume "x\<in>\<beta>"
       with \<open>\<forall>x\<in>h `` \<beta>. x \<in> \<alpha>_0\<close> \<open>Ord(\<alpha>_0)\<close> \<open>h:\<beta>\<rightarrow>\<gamma>\<close>
       have "h`x < \<alpha>_0"
         using fun_is_function[of h \<beta> "\<lambda>_. \<gamma>"]
           Image_subset_Ord_imp_lt domain_of_fun[of h \<beta> "\<lambda>_. \<gamma>"]
         by blast
       also from \<open>\<langle>\<alpha>_0 \<union> _, f ` \<theta>\<rangle> \<in> Memrel(\<gamma>) \<or> \<alpha>_0 \<union> _= f ` \<theta>\<close>
         \<open>Ord(f`\<theta>)\<close> \<open>Ord(\<alpha>_0)\<close> \<open>Ord(j`\<beta>)\<close>
       have "\<alpha>_0 \<le> f`\<theta>"
         using Un_leD1[OF leI [OF ltI]] Un_leD1[OF le_eqI] by blast
       finally
       show "h`x < f`\<theta>" .
     qed
     ultimately
     have "factor_body(\<beta>,\<lambda>x\<in>\<beta>. factor(x),\<theta>)"
       unfolding h_def factor_body_def using ltD
       by (auto dest:Un_memD2 Un_leD2[OF le_eqI])
     with \<open>Ord(\<theta>)\<close>
     have "factor(\<beta>) \<le> \<theta>"
       using factor_unfold[of \<beta>] Least_le unfolding factor_rec_def by auto
     with \<open>\<theta>\<in>\<delta>\<close> \<open>Ord(\<delta>)\<close>
     have "factor(\<beta>) \<in> \<delta>"
       using leI[of \<theta>] ltI[of \<theta>]  by (auto dest:ltD)
     then
     show ?case by (auto elim:mem_irrefl)
   qed
   moreover
   have "cofinal_fun(f O fun_factor, \<gamma>, Memrel(\<gamma>))"
   proof (intro cofinal_funI)
     fix a
     assume "a \<in> \<gamma>"
     with \<open>cf_fun(j,\<gamma>)\<close> \<open>domain(j) = cf(\<gamma>)\<close>
     obtain x where "x\<in>cf(\<gamma>)" "a \<in> j`x \<or> a = j`x"
       by (auto simp add:cofinal_fun_def) blast
     with factor_not_delta
     have "x \<in> domain(f O fun_factor)"
       using f_fun_factor_is_mono_map mono_map_is_fun domain_of_fun by force
     moreover
     have "a \<in> (f O fun_factor) `x \<or> a = (f O fun_factor) `x"
     proof -
       from \<open>x\<in>cf(\<gamma>)\<close> factor_not_delta
       have "j ` x \<le> f ` factor(x)"
         using mem_not_refl factor_body_factor factor_in_delta
         unfolding factor_body_def by auto
       with \<open>a \<in> j`x \<or> a = j`x\<close>
       have "a \<in> f ` factor(x) \<or> a = f ` factor(x)"
         using ltD by blast
       with \<open>x\<in>cf(\<gamma>)\<close>
       show ?thesis using lam_funtype[of "cf(\<gamma>)" factor]
         unfolding fun_factor_def by auto
     qed
     moreover
     note \<open>a \<in> \<gamma>\<close>
     moreover from calculation and \<open>Ord(\<gamma>)\<close> and factor_not_delta
     have "(f O fun_factor) `x \<in> \<gamma>"
       using Limit_nonzero apply_in_range mono_map_is_fun[of "f O fun_factor"]
         f_fun_factor_is_mono_map by blast
     ultimately
     show "\<exists>x \<in> domain(f O fun_factor). \<langle>a, (f O fun_factor) ` x\<rangle> \<in> Memrel(\<gamma>)
                                        \<or> a = (f O fun_factor) `x"
       by blast
   qed
   ultimately
   show ?thesis
     using fun_factor_is_mono_map f_fun_factor_is_mono_map by blast
 qed
 
 text\<open>As a final observation in this part, we note that if the original
 cofinal map was increasing, then the factor function is also cofinal.\<close>
 lemma factor_is_cofinal:
   assumes
     "Ord(\<delta>)" "Ord(\<gamma>)"
     "f :\<delta> \<rightarrow>\<^sub>< \<gamma>"  "f O g \<in> mono_map(\<alpha>,r,\<gamma>,Memrel(\<gamma>))"
     "cofinal_fun(f O g,\<gamma>,Memrel(\<gamma>))" "g: \<alpha> \<rightarrow> \<delta>"
   shows
     "cf_fun(g,\<delta>)"
   unfolding cf_fun_def cofinal_fun_def
 proof
   fix a
   assume "a \<in> \<delta>"
   with \<open>f \<in> mono_map(\<delta>,_,\<gamma>,_)\<close>
   have "f`a \<in> \<gamma>"
     using mono_map_is_fun by force
   with \<open>cofinal_fun(f O g,\<gamma>,_)\<close>
   obtain y where "y\<in>\<alpha>"  "\<langle>f`a, (f O g) ` y\<rangle> \<in> Memrel(\<gamma>) \<or> f`a = (f O g) ` y"
     unfolding cofinal_fun_def using domain_of_fun[OF \<open>g:\<alpha> \<rightarrow> \<delta>\<close>] by blast
   with \<open>g:\<alpha> \<rightarrow> \<delta>\<close>
   have "\<langle>f`a, f ` (g ` y)\<rangle> \<in> Memrel(\<gamma>) \<or> f`a = f ` (g ` y)" "g`y \<in> \<delta>"
     using comp_fun_apply[of g \<alpha> \<delta> y f] by auto
   with assms(1-3) and \<open>a\<in>\<delta>\<close>
   have "\<langle>a, g ` y\<rangle> \<in> Memrel(\<delta>) \<or> a = g ` y"
     using Memrel_mono_map_reflects Memrel_mono_map_is_inj[of \<delta> f \<gamma> \<gamma>]
       inj_apply_equality[of f \<delta> \<gamma>]  by blast
   with \<open>y\<in>\<alpha>\<close>
   show "\<exists>x\<in>domain(g). \<langle>a, g ` x\<rangle> \<in> Memrel(\<delta>) \<or> a = g ` x"
     using domain_of_fun[OF \<open>g:\<alpha> \<rightarrow> \<delta>\<close>] by blast
 qed
 
 
 subsection\<open>Classical results on cofinalities\<close>
 
 text\<open>Now the rest of the results follow in a more algebraic way. The
 next proof one invokes a case analysis on whether the argument is zero,
 a successor ordinal or a limit one; the last case being the most
 relevant one and is immediate from the factorization lemma.\<close>
 
 lemma cf_le_domain_cofinal_fun:
   assumes
     "Ord(\<gamma>)" "Ord(\<delta>)" "f:\<delta> \<rightarrow> \<gamma>" "cf_fun(f,\<gamma>)"
   shows
     "cf(\<gamma>)\<le>\<delta>"
   using assms
 proof (cases rule:Ord_cases)
   case 0
   with \<open>Ord(\<delta>)\<close>
   show ?thesis using Ord_0_le by simp
 next
   case (succ \<gamma>)
   with assms
   obtain x where "x\<in>\<delta>" "f`x=\<gamma>" using cf_fun_succ' by blast
   then
   have "\<delta>\<noteq>0" by blast
   let ?f="{\<langle>0,f`x\<rangle>}"
   from \<open>f`x=\<gamma>\<close>
   have "?f:1\<rightarrow>succ(\<gamma>)"
     using singleton_0 singleton_fun[of 0 \<gamma>] singleton_subsetI fun_weaken_type by simp
   with \<open>Ord(\<gamma>)\<close>  \<open>f`x=\<gamma>\<close>
   have "cf(succ(\<gamma>)) = 1" using cf_succ by simp
   with \<open>\<delta>\<noteq>0\<close> succ
   show ?thesis using Ord_0_lt_iff succ_leI \<open>Ord(\<delta>)\<close> by simp
 next
   case (limit)
   with assms
   obtain g where "g :cf(\<gamma>) \<rightarrow>\<^sub>< \<delta>"
     using cofinal_fun_factorization by blast
   with assms
   show ?thesis using mono_map_imp_le by simp
 qed
 
 lemma cf_ordertype_cofinal:
   assumes
     "Limit(\<gamma>)" "A\<subseteq>\<gamma>" "cofinal(A,\<gamma>,Memrel(\<gamma>))"
   shows
     "cf(\<gamma>) = cf(ordertype(A,Memrel(\<gamma>)))"
 proof (intro le_anti_sym)
   from \<open>Limit(\<gamma>)\<close>
   have "Ord(\<gamma>)"
     using Limit_is_Ord by simp
   with \<open>A \<subseteq> \<gamma>\<close>
   have "well_ord(A,Memrel(\<gamma>))"
     using well_ord_Memrel well_ord_subset by blast
   then
   obtain f \<alpha> where "f:\<langle>\<alpha>, Memrel(\<alpha>)\<rangle> \<cong> \<langle>A,Memrel(\<gamma>)\<rangle>" "Ord(\<alpha>)" "\<alpha> = ordertype(A,Memrel(\<gamma>))"
     using ordertype_ord_iso Ord_ordertype ord_iso_sym by blast
   moreover from this
   have "f: \<alpha> \<rightarrow> A"
     using ord_iso_is_mono_map mono_map_is_fun[of f _ "Memrel(\<alpha>)"] by blast
   moreover from this
   have "function(f)"
     using fun_is_function by simp
   moreover from \<open>f:\<langle>\<alpha>, Memrel(\<alpha>)\<rangle> \<cong> \<langle>A,Memrel(\<gamma>)\<rangle>\<close>
   have "range(f) = A"
     using ord_iso_is_bij bij_is_surj surj_range by blast
   moreover note \<open>cofinal(A,\<gamma>,_)\<close>
   ultimately
   have "cf_fun(f,\<gamma>)"
     using cofinal_range_iff_cofinal_fun by blast
   moreover from \<open>Ord(\<alpha>)\<close>
   obtain h where "h :cf(\<alpha>) \<rightarrow>\<^sub>< \<alpha>" "cf_fun(h,\<alpha>)"
     using cofinal_mono_map_cf by blast
   moreover from \<open>Ord(\<gamma>)\<close>
   have "trans(Memrel(\<gamma>))"
     using trans_Memrel by simp
   moreover
   note \<open>A\<subseteq>\<gamma>\<close>
   ultimately
   have "cofinal_fun(f O h,\<gamma>,Memrel(\<gamma>))"
     using cofinal_comp ord_iso_is_mono_map[OF \<open>f:\<langle>\<alpha>,_\<rangle> \<cong> \<langle>A,_\<rangle>\<close>] mono_map_is_fun
       mono_map_mono by blast
   moreover from \<open>f:\<alpha>\<rightarrow>A\<close> \<open>A\<subseteq>\<gamma>\<close> \<open>h\<in>mono_map(cf(\<alpha>),_,\<alpha>,_)\<close>
   have "f O h : cf(\<alpha>) \<rightarrow> \<gamma>"
     using Pi_mono[of A \<gamma>] comp_fun  mono_map_is_fun by blast
   moreover
   note \<open>Ord(\<gamma>)\<close> \<open>Ord(\<alpha>)\<close> \<open>\<alpha> = ordertype(A,Memrel(\<gamma>))\<close>
   ultimately
   show "cf(\<gamma>) \<le> cf(ordertype(A,Memrel(\<gamma>)))"
     using cf_le_domain_cofinal_fun[of _ _ "f O h"]
     by (auto simp add:cf_fun_def)
       (********************************************************)
   from \<open>f:\<langle>\<alpha>, _\<rangle> \<cong> \<langle>A,_\<rangle>\<close> \<open>A\<subseteq>\<gamma>\<close>
   have "f :\<alpha> \<rightarrow>\<^sub>< \<gamma>"
     using mono_map_mono[OF ord_iso_is_mono_map] by simp
   then
   have "f: \<alpha> \<rightarrow> \<gamma>"
     using mono_map_is_fun by simp
   with \<open>cf_fun(f,\<gamma>)\<close> \<open>Limit(\<gamma>)\<close> \<open>Ord(\<alpha>)\<close>
   obtain g where "g :cf(\<gamma>) \<rightarrow>\<^sub>< \<alpha>"
     "f O g :cf(\<gamma>) \<rightarrow>\<^sub>< \<gamma>"
     "cofinal_fun(f O g,\<gamma>,Memrel(\<gamma>))"
     using cofinal_fun_factorization by blast
   moreover from this
   have "g:cf(\<gamma>)\<rightarrow>\<alpha>"
     using mono_map_is_fun by simp
   moreover
   note \<open>Ord(\<alpha>)\<close>
   moreover from calculation and \<open>f :\<alpha> \<rightarrow>\<^sub>< \<gamma>\<close> \<open>Ord(\<gamma>)\<close>
   have "cf_fun(g,\<alpha>)"
     using factor_is_cofinal by blast
   moreover
   note \<open>\<alpha> = ordertype(A,Memrel(\<gamma>))\<close>
   ultimately
   show "cf(ordertype(A,Memrel(\<gamma>))) \<le> cf(\<gamma>)"
     using cf_le_domain_cofinal_fun[OF _ Ord_cf mono_map_is_fun] by simp
 qed
 
 lemma cf_idemp:
   assumes "Limit(\<gamma>)"
   shows "cf(\<gamma>) = cf(cf(\<gamma>))"
 proof -
   from assms
   obtain A where "A\<subseteq>\<gamma>" "cofinal(A,\<gamma>,Memrel(\<gamma>))" "cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))"
     using Limit_is_Ord cf_is_ordertype by blast
   with assms
   have "cf(\<gamma>) = cf(ordertype(A,Memrel(\<gamma>)))" using cf_ordertype_cofinal by simp
   also
   have "... = cf(cf(\<gamma>))"
     using \<open>cf(\<gamma>) = ordertype(A,Memrel(\<gamma>))\<close> by simp
   finally
   show "cf(\<gamma>) = cf(cf(\<gamma>))"  .
 qed
 
 lemma cf_le_cardinal:
   assumes "Limit(\<gamma>)"
   shows "cf(\<gamma>) \<le> |\<gamma>|"
 proof -
   from assms
   have \<open>Ord(\<gamma>)\<close> using Limit_is_Ord by simp
   then
   obtain f where "f \<in> surj(|\<gamma>|,\<gamma>)"
     using Ord_cardinal_eqpoll unfolding eqpoll_def bij_def by blast
   with \<open>Ord(\<gamma>)\<close>
   show ?thesis
     using Card_is_Ord[OF Card_cardinal] surj_is_cofinal
       cf_le_domain_cofinal_fun[of \<gamma>] surj_is_fun by blast
 qed
 
 lemma regular_is_Card:
   notes le_imp_subset [dest]
   assumes "Limit(\<gamma>)" "\<gamma> = cf(\<gamma>)"
   shows "Card(\<gamma>)"
 proof -
   from assms
   have "|\<gamma>| \<subseteq> \<gamma>"
     using Limit_is_Ord Ord_cardinal_le by blast
   also from \<open>\<gamma> = cf(\<gamma>)\<close>
   have "\<gamma> \<subseteq> cf(\<gamma>)" by simp
   finally
   have "|\<gamma>| \<subseteq> cf(\<gamma>)" .
   with assms
   show ?thesis unfolding Card_def using cf_le_cardinal by force
 qed
 
 lemma Limit_cf: assumes "Limit(\<kappa>)" shows "Limit(cf(\<kappa>))"
   using Ord_cf[of \<kappa>, THEN Ord_cases]
     \<comment> \<open>\<^term>\<open>cf(\<kappa>)\<close> being 0 or successor leads to contradiction\<close>
 proof (cases)
   case 1
   with \<open>Limit(\<kappa>)\<close>
   show ?thesis using cf_zero_iff Limit_is_Ord by simp
 next
   case (2 \<alpha>)
   moreover
   note \<open>Limit(\<kappa>)\<close>
   moreover from calculation
   have "cf(\<kappa>) = 1"
     using cf_idemp cf_succ by fastforce
   ultimately
   show ?thesis
     using succ_LimitE cf_eq_one_iff Limit_is_Ord
     by auto
 qed
 
 lemma InfCard_cf: "Limit(\<kappa>) \<Longrightarrow> InfCard(cf(\<kappa>))"
   using regular_is_Card cf_idemp Limit_cf nat_le_Limit Limit_cf
   unfolding InfCard_def by simp
 
 lemma cf_le_cf_fun:
   notes [dest] = Limit_is_Ord
   assumes "cf(\<kappa>) \<le> \<nu>" "Limit(\<kappa>)"
   shows "\<exists>f.  f:\<nu> \<rightarrow> \<kappa>  \<and>  cf_fun(f, \<kappa>)"
 proof -
   note assms
   moreover from this
   obtain h where h_cofinal_mono: "cf_fun(h,\<kappa>)"
     "h :cf(\<kappa>) \<rightarrow>\<^sub>< \<kappa>"
     "h : cf(\<kappa>) \<rightarrow> \<kappa>"
     using cofinal_mono_map_cf mono_map_is_fun by force
   moreover from calculation
   obtain g where "g \<in> inj(cf(\<kappa>), \<nu>)"
     using le_imp_lepoll by blast
   from this and calculation(2,3,5)
   obtain f where "f \<in> surj(\<nu>, cf(\<kappa>))" "f: \<nu> \<rightarrow> cf(\<kappa>)"
     using inj_imp_surj[OF _ Limit_has_0[THEN ltD]]
       surj_is_fun Limit_cf by blast
   moreover from this
   have "cf_fun(f,cf(\<kappa>))"
     using surj_is_cofinal by simp
   moreover
   note h_cofinal_mono \<open>Limit(\<kappa>)\<close>
   moreover from calculation
   have "cf_fun(h O f,\<kappa>)"
     using cf_fun_comp by blast
   moreover from calculation
   have "h O f \<in> \<nu> -> \<kappa>"
     using comp_fun by simp
   ultimately
   show ?thesis by blast
 qed
 
 lemma Limit_cofinal_fun_lt:
   notes [dest] = Limit_is_Ord
   assumes "Limit(\<kappa>)" "f: \<nu> \<rightarrow> \<kappa>" "cf_fun(f,\<kappa>)" "n\<in>\<kappa>"
   shows "\<exists>\<alpha>\<in>\<nu>. n < f`\<alpha>"
 proof -
   from \<open>Limit(\<kappa>)\<close> \<open>n\<in>\<kappa>\<close>
   have "succ(n) \<in> \<kappa>"
     using Limit_has_succ[OF _ ltI, THEN ltD] by auto
   moreover
   note \<open>f: \<nu> \<rightarrow> _\<close>
   moreover from this
   have "domain(f) = \<nu>"
     using domain_of_fun by simp
   moreover
   note \<open>cf_fun(f,\<kappa>)\<close>
   ultimately
   obtain \<alpha> where "\<alpha> \<in> \<nu>" "succ(n) \<in> f`\<alpha> \<or> succ(n) = f `\<alpha>"
     using cf_funD[THEN cofinal_funD] by blast
   moreover from this
   consider (1) "succ(n) \<in> f`\<alpha>" | (2) "succ(n) = f `\<alpha>"
     by blast
   then
   have "n < f`\<alpha>"
   proof (cases)
     case 1
     moreover
     have "n \<in> succ(n)" by simp
     moreover
     note \<open>Limit(\<kappa>)\<close> \<open>f: \<nu> \<rightarrow> _\<close> \<open>\<alpha> \<in> \<nu>\<close>
     moreover from this
     have "Ord(f ` \<alpha>)"
       using apply_type[of f \<nu> "\<lambda>_. \<kappa>", THEN [2] Ord_in_Ord]
       by blast
     ultimately
     show ?thesis
       using Ord_trans[of n "succ(n)" "f ` \<alpha>"] ltI  by blast
   next
     case 2
     have "n \<in> f ` \<alpha>" by (simp add:2[symmetric])
     with \<open>Limit(\<kappa>)\<close> \<open>f: \<nu> \<rightarrow> _\<close> \<open>\<alpha> \<in> \<nu>\<close>
     show ?thesis
       using ltI
         apply_type[of f \<nu> "\<lambda>_. \<kappa>", THEN [2] Ord_in_Ord]
       by blast
   qed
   ultimately
   show ?thesis by blast
 qed
 
 context
   includes Ord_dests Aleph_dests Aleph_intros Aleph_mem_dests mono_map_rules
 begin
 
 text\<open>We end this section by calculating the cofinality of Alephs, for
 the zero and limit case. The successor case depends on $\AC$.\<close>
 
 lemma cf_nat: "cf(\<omega>) = \<omega>"
   using Limit_nat[THEN InfCard_cf] cf_le_cardinal[of \<omega>]
     Card_nat[THEN Card_cardinal_eq] le_anti_sym
   unfolding InfCard_def by auto
 
 lemma cf_Aleph_zero: "cf(\<aleph>\<^bsub>0\<^esub>) = \<aleph>\<^bsub>0\<^esub>" 
   using cf_nat unfolding Aleph_def by simp
 
 lemma cf_Aleph_Limit:
   assumes "Limit(\<gamma>)"
   shows "cf(\<aleph>\<^bsub>\<gamma>\<^esub>) = cf(\<gamma>)" 
 proof -
   note \<open>Limit(\<gamma>)\<close>
   moreover from this
   have "(\<lambda>x\<in>\<gamma>. \<aleph>\<^bsub>x\<^esub>) : \<gamma> \<rightarrow> \<aleph>\<^bsub>\<gamma>\<^esub>" (is "?f : _ \<rightarrow> _")
     using lam_funtype[of _ Aleph] fun_weaken_type[of _ _ _ "\<aleph>\<^bsub>\<gamma>\<^esub>"] by blast
   moreover from \<open>Limit(\<gamma>)\<close>
   have "x \<in> y \<Longrightarrow> \<aleph>\<^bsub>x\<^esub> \<in> \<aleph>\<^bsub>y\<^esub>" if "x \<in> \<gamma>" "y \<in> \<gamma>" for x y
     using that Ord_in_Ord[of \<gamma>] Ord_trans[of _ _ \<gamma>] by blast
   ultimately
   have "?f \<in> mono_map(\<gamma>,Memrel(\<gamma>),\<aleph>\<^bsub>\<gamma>\<^esub>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>))"
     by auto
   with  \<open>Limit(\<gamma>)\<close> 
   have "?f \<in> \<langle>\<gamma>, Memrel(\<gamma>)\<rangle> \<cong> \<langle>?f``\<gamma>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>)\<rangle>"
     using mono_map_imp_ord_iso_Memrel[of \<gamma> "\<aleph>\<^bsub>\<gamma>\<^esub>" ?f] 
       Card_Aleph (* Already an intro rule, but need it explicitly *)
     by blast
   then
   have "converse(?f) \<in> \<langle>?f``\<gamma>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>)\<rangle> \<cong> \<langle>\<gamma>, Memrel(\<gamma>)\<rangle>"
     using ord_iso_sym by simp
   with \<open>Limit(\<gamma>)\<close>
   have "ordertype(?f``\<gamma>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>)) = \<gamma>"
     using ordertype_eq[OF _ well_ord_Memrel]
     ordertype_Memrel by auto
   moreover from \<open>Limit(\<gamma>)\<close>
   have "cofinal(?f``\<gamma>, \<aleph>\<^bsub>\<gamma>\<^esub>, Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>))" 
     unfolding cofinal_def 
   proof (standard, intro ballI)
     fix a
     assume "a\<in>\<aleph>\<^bsub>\<gamma>\<^esub>" "\<aleph>\<^bsub>\<gamma>\<^esub> = (\<Union>i<\<gamma>. \<aleph>\<^bsub>i\<^esub>)"
     moreover from this
     obtain i where "i<\<gamma>" "a\<in>\<aleph>\<^bsub>i\<^esub>"
       by auto
     moreover from this and \<open>Limit(\<gamma>)\<close>
     have "Ord(i)" using ltD Ord_in_Ord by blast
     moreover from \<open>Limit(\<gamma>)\<close> and calculation
     have "succ(i) \<in> \<gamma>" using ltD by auto
     moreover from this and \<open>Ord(i)\<close>
     have "\<aleph>\<^bsub>i\<^esub> < \<aleph>\<^bsub>succ(i)\<^esub>" 
       by (auto) 
     ultimately
     have "\<langle>a,\<aleph>\<^bsub>i\<^esub>\<rangle> \<in> Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>)"
       using ltD by (auto dest:Aleph_increasing)
     moreover from \<open>i<\<gamma>\<close>
     have "\<aleph>\<^bsub>i\<^esub> \<in> ?f``\<gamma>" 
       using ltD apply_in_image[OF \<open>?f : _ \<rightarrow> _\<close>] by auto
     ultimately
     show "\<exists>x\<in>?f `` \<gamma>. \<langle>a, x\<rangle> \<in> Memrel(\<aleph>\<^bsub>\<gamma>\<^esub>) \<or> a = x" by blast
   qed
   moreover
   note \<open>?f: \<gamma> \<rightarrow> \<aleph>\<^bsub>\<gamma>\<^esub>\<close> \<open>Limit(\<gamma>)\<close>
   ultimately
   show "cf(\<aleph>\<^bsub>\<gamma>\<^esub>) =  cf(\<gamma>)"
     using cf_ordertype_cofinal[OF Limit_Aleph Image_sub_codomain, of \<gamma> ?f \<gamma> \<gamma> ] 
       Limit_is_Ord by simp 
 qed
 
 end (* includes *)
 
 end
\ No newline at end of file
diff --git a/thys/Jacobson_Basic_Algebra/Group_Theory.thy b/thys/Jacobson_Basic_Algebra/Group_Theory.thy
--- a/thys/Jacobson_Basic_Algebra/Group_Theory.thy
+++ b/thys/Jacobson_Basic_Algebra/Group_Theory.thy
@@ -1,1700 +1,1700 @@
 (*
   Copyright (c) 2014-2019 by Clemens Ballarin
   This file is licensed under the 3-clause BSD license.
 *)
 
 theory Group_Theory imports Set_Theory begin
 
 hide_const monoid
 hide_const group
 hide_const inverse
 
 no_notation quotient (infixl "'/'/" 90)
 
 
 section \<open>Monoids and Groups\<close>
 
 subsection \<open>Monoids of Transformations and Abstract Monoids\<close>
 
 text \<open>Def 1.1\<close>
 text \<open>p 28, ll 28--30\<close>
 locale monoid =
   fixes M and composition (infixl "\<cdot>" 70) and unit ("\<one>")
   assumes composition_closed [intro, simp]: "\<lbrakk> a \<in> M; b \<in> M \<rbrakk> \<Longrightarrow> a \<cdot> b \<in> M"
     and unit_closed [intro, simp]: "\<one> \<in> M"
     and associative [intro]: "\<lbrakk> a \<in> M; b \<in> M; c \<in> M \<rbrakk> \<Longrightarrow> (a \<cdot> b) \<cdot> c = a \<cdot> (b \<cdot> c)"
     and left_unit [intro, simp]: "a \<in> M \<Longrightarrow> \<one> \<cdot> a = a"
     and right_unit [intro, simp]: "a \<in> M \<Longrightarrow> a \<cdot> \<one> = a"
 
 text \<open>p 29, ll 27--28\<close>
 locale submonoid = monoid M "(\<cdot>)" \<one>
   for N and M and composition (infixl "\<cdot>" 70) and unit ("\<one>") +
   assumes subset: "N \<subseteq> M"
     and sub_composition_closed: "\<lbrakk> a \<in> N; b \<in> N \<rbrakk> \<Longrightarrow> a \<cdot> b \<in> N"
     and sub_unit_closed: "\<one> \<in> N"
 begin
 
 text \<open>p 29, ll 27--28\<close>
 lemma sub [intro, simp]:
   "a \<in> N \<Longrightarrow> a \<in> M"
   using subset by blast
 
 text \<open>p 29, ll 32--33\<close>
 sublocale sub: monoid N "(\<cdot>)" \<one>
   by unfold_locales (auto simp: sub_composition_closed sub_unit_closed)
 
 end (* submonoid *)
 
 text \<open>p 29, ll 33--34\<close>
 theorem submonoid_transitive:
   assumes "submonoid K N composition unit"
     and "submonoid N M composition unit"
   shows "submonoid K M composition unit"
 proof -
   interpret K: submonoid K N composition unit by fact
   interpret M: submonoid N M composition unit by fact
   show ?thesis by unfold_locales auto
 qed
 
 text \<open>p 28, l 23\<close>
 locale transformations =
   fixes S :: "'a set"
 
 (*  assumes non_vacuous: "S \<noteq> {}" *) (* Jacobson requires this but we don't need it, strange. *)
 
 text \<open>Monoid of all transformations\<close>
 text \<open>p 28, ll 23--24\<close>
 sublocale transformations \<subseteq> monoid "S \<rightarrow>\<^sub>E S" "compose S" "identity S"
   by unfold_locales (auto simp: PiE_def compose_eq compose_assoc Id_compose compose_Id)
 
 text \<open>@{term N} is a monoid of transformations of the set @{term S}.\<close>
 text \<open>p 29, ll 34--36\<close>
 locale transformation_monoid =
   transformations S + submonoid M "S \<rightarrow>\<^sub>E S" "compose S" "identity S" for M and S
 begin
 
 text \<open>p 29, ll 34--36\<close>
 lemma transformation_closed [intro, simp]:
   "\<lbrakk> \<alpha> \<in> M; x \<in> S \<rbrakk> \<Longrightarrow> \<alpha> x \<in> S"
   by (metis PiE_iff sub)
 
 text \<open>p 29, ll 34--36\<close>
 lemma transformation_undefined [intro, simp]:
   "\<lbrakk> \<alpha> \<in> M; x \<notin> S \<rbrakk> \<Longrightarrow> \<alpha> x = undefined"
   by (metis PiE_arb sub)
 
 end (* transformation_monoid *)
 
 
 subsection \<open>Groups of Transformations and Abstract Groups\<close>
 
 context monoid begin
 
 text \<open>Invertible elements\<close>
 
 text \<open>p 31, ll 3--5\<close>
 definition invertible where "u \<in> M \<Longrightarrow> invertible u \<longleftrightarrow> (\<exists>v \<in> M. u \<cdot> v = \<one> \<and> v \<cdot> u = \<one>)"
 
 text \<open>p 31, ll 3--5\<close>
 lemma invertibleI [intro]:
   "\<lbrakk> u \<cdot> v = \<one>; v \<cdot> u = \<one>; u \<in> M; v \<in> M \<rbrakk> \<Longrightarrow> invertible u"
   unfolding invertible_def by fast
 
 text \<open>p 31, ll 3--5\<close>
 lemma invertibleE [elim]:
   "\<lbrakk> invertible u; \<And>v. \<lbrakk> u \<cdot> v = \<one> \<and> v \<cdot> u = \<one>; v \<in> M \<rbrakk> \<Longrightarrow> P; u \<in> M \<rbrakk> \<Longrightarrow> P"
   unfolding invertible_def by fast
 
 text \<open>p 31, ll 6--7\<close>
 theorem inverse_unique:
   "\<lbrakk> u \<cdot> v' = \<one>; v \<cdot> u = \<one>; u \<in> M;  v \<in> M; v' \<in> M \<rbrakk> \<Longrightarrow> v = v'"
   by (metis associative left_unit right_unit)
 
 text \<open>p 31, l 7\<close>
 definition inverse where "inverse = (\<lambda>u \<in> M. THE v. v \<in> M \<and> u \<cdot> v = \<one> \<and> v \<cdot> u = \<one>)"
 
 text \<open>p 31, l 7\<close>
 theorem inverse_equality:
   "\<lbrakk> u \<cdot> v = \<one>; v \<cdot> u = \<one>; u \<in> M; v \<in> M \<rbrakk> \<Longrightarrow> inverse u = v"
   unfolding inverse_def using inverse_unique by simp blast
 
 text \<open>p 31, l 7\<close>
 lemma invertible_inverse_closed [intro, simp]:
   "\<lbrakk> invertible u; u \<in> M \<rbrakk> \<Longrightarrow> inverse u \<in> M"
   using inverse_equality by auto
 
 text \<open>p 31, l 7\<close>
 lemma inverse_undefined [intro, simp]:
   "u \<notin> M \<Longrightarrow> inverse u = undefined"
   by (simp add: inverse_def)
 
 text \<open>p 31, l 7\<close>
 lemma invertible_left_inverse [simp]:
   "\<lbrakk> invertible u; u \<in> M \<rbrakk> \<Longrightarrow> inverse u \<cdot> u = \<one>"
   using inverse_equality by auto
 
 text \<open>p 31, l 7\<close>
 lemma invertible_right_inverse [simp]:
   "\<lbrakk> invertible u; u \<in> M \<rbrakk> \<Longrightarrow> u \<cdot> inverse u = \<one>"
   using inverse_equality by auto
 
 text \<open>p 31, l 7\<close>
 lemma invertible_left_cancel [simp]:
   "\<lbrakk> invertible x; x \<in> M; y \<in> M; z \<in> M \<rbrakk> \<Longrightarrow> x \<cdot> y = x \<cdot> z \<longleftrightarrow> y = z"
   by (metis associative invertible_def left_unit)
 
 text \<open>p 31, l 7\<close>
 lemma invertible_right_cancel [simp]:
   "\<lbrakk> invertible x; x \<in> M; y \<in> M; z \<in> M \<rbrakk> \<Longrightarrow> y \<cdot> x = z \<cdot> x \<longleftrightarrow> y = z"
   by (metis associative invertible_def right_unit)
 
 text \<open>p 31, l 7\<close>
 lemma inverse_unit [simp]: "inverse \<one> = \<one>"
   using inverse_equality by blast
 
 text \<open>p 31, ll 7--8\<close>
 theorem invertible_inverse_invertible [intro, simp]:
   "\<lbrakk> invertible u; u \<in> M \<rbrakk> \<Longrightarrow> invertible (inverse u)"
   using invertible_left_inverse invertible_right_inverse by blast
 
 text \<open>p 31, l 8\<close>
 theorem invertible_inverse_inverse [simp]:
   "\<lbrakk> invertible u; u \<in> M \<rbrakk> \<Longrightarrow> inverse (inverse u) = u"
   by (simp add: inverse_equality)
 
 end (* monoid *)
 
 context submonoid begin
 
 text \<open>Reasoning about @{term invertible} and @{term inverse} in submonoids.\<close>
 
 text \<open>p 31, l 7\<close>
 lemma submonoid_invertible [intro, simp]:
   "\<lbrakk> sub.invertible u; u \<in> N \<rbrakk> \<Longrightarrow> invertible u"
   using invertibleI by blast
 
 text \<open>p 31, l 7\<close>
 lemma submonoid_inverse_closed [intro, simp]:
   "\<lbrakk> sub.invertible u; u \<in> N \<rbrakk> \<Longrightarrow> inverse u \<in> N"
   using inverse_equality by auto
 
 end (* submonoid *)
 
 text \<open>Def 1.2\<close>
 text \<open>p 31, ll 9--10\<close>
 locale group =
   monoid G "(\<cdot>)" \<one> for G and composition (infixl "\<cdot>" 70) and unit ("\<one>") +
   assumes invertible [simp, intro]: "u \<in> G \<Longrightarrow> invertible u"
 
 text \<open>p 31, ll 11--12\<close>
 locale subgroup = submonoid G M "(\<cdot>)" \<one> + sub: group G "(\<cdot>)" \<one>
   for G and M and composition (infixl "\<cdot>" 70) and unit ("\<one>")
 begin
 
 text \<open>Reasoning about @{term invertible} and @{term inverse} in subgroups.\<close>
 
 text \<open>p 31, ll 11--12\<close>
 lemma subgroup_inverse_equality [simp]:
   "u \<in> G \<Longrightarrow> inverse u = sub.inverse u"
   by (simp add: inverse_equality)
 
 text \<open>p 31, ll 11--12\<close>
 lemma subgroup_inverse_iff [simp]:
   "\<lbrakk> invertible x; x \<in> M \<rbrakk> \<Longrightarrow> inverse x \<in> G \<longleftrightarrow> x \<in> G"
   using invertible_inverse_inverse sub.invertible_inverse_closed by fastforce
 
 end (* subgroup *)
 
 
 text \<open>p 31, ll 11--12\<close>
 lemma subgroup_transitive [trans]:
   assumes "subgroup K H composition unit"
     and "subgroup H G composition unit"
   shows "subgroup K G composition unit"
 proof -
   interpret K: subgroup K H composition unit by fact
   interpret H: subgroup H G composition unit by fact
   show ?thesis by unfold_locales auto
 qed
 
 context monoid begin
 
 text \<open>Jacobson states both directions, but the other one is trivial.\<close>
 text \<open>p 31, ll 12--15\<close>
 theorem subgroupI:
   fixes G
   assumes subset [THEN subsetD, intro]: "G \<subseteq> M"
     and [intro]: "\<one> \<in> G"
     and [intro]: "\<And>g h. \<lbrakk> g \<in> G; h \<in> G \<rbrakk> \<Longrightarrow> g \<cdot> h \<in> G"
     and [intro]: "\<And>g. g \<in> G \<Longrightarrow> invertible g"
     and [intro]: "\<And>g. g \<in> G \<Longrightarrow> inverse g \<in> G"
   shows "subgroup G M (\<cdot>) \<one>"
 proof -
   interpret sub: monoid G "(\<cdot>)" \<one> by unfold_locales auto
   show ?thesis
   proof unfold_locales
     fix u assume [intro]: "u \<in> G" show "sub.invertible u"
     using invertible_left_inverse invertible_right_inverse by blast
   qed auto
 qed
 
 text \<open>p 31, l 16\<close>
 definition "Units = {u \<in> M. invertible u}"
 
 text \<open>p 31, l 16\<close>
 lemma mem_UnitsI:
   "\<lbrakk> invertible u; u \<in> M \<rbrakk> \<Longrightarrow> u \<in> Units"
   unfolding Units_def by clarify
 
 text \<open>p 31, l 16\<close>
 lemma mem_UnitsD:
   "\<lbrakk> u \<in> Units \<rbrakk> \<Longrightarrow> invertible u \<and> u \<in> M"
   unfolding Units_def by clarify
 
 text \<open>p 31, ll 16--21\<close>
 interpretation units: subgroup Units M
 proof (rule subgroupI)
   fix u1 u2
   assume Units [THEN mem_UnitsD, simp]: "u1 \<in> Units" "u2 \<in> Units"
   have "(u1 \<cdot> u2) \<cdot> (inverse u2 \<cdot> inverse u1) = (u1 \<cdot> (u2 \<cdot> inverse u2)) \<cdot> inverse u1"
     by (simp add: associative del: invertible_left_inverse invertible_right_inverse)
   also have "\<dots> = \<one>" by simp
   finally have inv1: "(u1 \<cdot> u2) \<cdot> (inverse u2 \<cdot> inverse u1) = \<one>" by simp  \<comment> \<open>ll 16--18\<close>
   have "(inverse u2 \<cdot> inverse u1) \<cdot> (u1 \<cdot> u2) = (inverse u2 \<cdot> (inverse u1 \<cdot> u1)) \<cdot> u2"
     by (simp add: associative del: invertible_left_inverse invertible_right_inverse)
   also have "\<dots> = \<one>" by simp
-  finally have inv2: "(inverse u2 \<cdot> inverse u1) \<cdot> (u1 \<cdot> u2) = \<one>" by simp  \<comment> \<open>l 9, “and similarly”\<close>
+  finally have inv2: "(inverse u2 \<cdot> inverse u1) \<cdot> (u1 \<cdot> u2) = \<one>" by simp  \<comment> \<open>l 9, ``and similarly''\<close>
   show "u1 \<cdot> u2 \<in> Units" using inv1 inv2 invertibleI mem_UnitsI by auto
 qed (auto simp: Units_def)
 
 text \<open>p 31, ll 21--22\<close>
 theorem group_of_Units [intro, simp]:
   "group Units (\<cdot>) \<one>"
   ..
 
 text \<open>p 31, l 19\<close>
 lemma composition_invertible [simp, intro]:
   "\<lbrakk> invertible x; invertible y; x \<in> M; y \<in> M \<rbrakk> \<Longrightarrow> invertible (x \<cdot> y)"
   using mem_UnitsD mem_UnitsI by blast
 
 text \<open>p 31, l 20\<close>
 lemma unit_invertible:
   "invertible \<one>"
   by fast
 
 text \<open>Useful simplification rules\<close>
 text \<open>p 31, l 22\<close>
 lemma invertible_right_inverse2:
   "\<lbrakk> invertible u; u \<in> M; v \<in> M \<rbrakk> \<Longrightarrow> u \<cdot> (inverse u \<cdot> v) = v"
   by (simp add: associative [THEN sym])
 
 text \<open>p 31, l 22\<close>
 lemma invertible_left_inverse2:
   "\<lbrakk> invertible u; u \<in> M; v \<in> M \<rbrakk> \<Longrightarrow> inverse u \<cdot> (u \<cdot> v) = v"
   by (simp add: associative [THEN sym])
 
 text \<open>p 31, l 22\<close>
 lemma inverse_composition_commute:
   assumes [simp]: "invertible x" "invertible y" "x \<in> M" "y \<in> M"
   shows "inverse (x \<cdot> y) = inverse y \<cdot> inverse x"
 proof -
   have "inverse (x \<cdot> y) \<cdot> (x \<cdot> y) = (inverse y \<cdot> inverse x) \<cdot> (x \<cdot> y)"
   by (simp add: invertible_left_inverse2 associative)
   then show ?thesis by (simp del: invertible_left_inverse)
 qed
 
 end (* monoid *)
 
 text \<open>p 31, l 24\<close>
 context transformations begin
 
 text \<open>p 31, ll 25--26\<close>
 theorem invertible_is_bijective:
   assumes dom: "\<alpha> \<in> S \<rightarrow>\<^sub>E S"
   shows "invertible \<alpha> \<longleftrightarrow> bij_betw \<alpha> S S"
 proof -
   from dom interpret map \<alpha> S S by unfold_locales
   show ?thesis by (auto simp add: bij_betw_iff_has_inverse invertible_def)
 qed
 
 text \<open>p 31, ll 26--27\<close>
 theorem Units_bijective:
   "Units = {\<alpha> \<in> S \<rightarrow>\<^sub>E S. bij_betw \<alpha> S S}"
   unfolding Units_def by (auto simp add: invertible_is_bijective)
 
 text \<open>p 31, ll 26--27\<close>
 lemma Units_bij_betwI [intro, simp]:
   "\<alpha> \<in> Units \<Longrightarrow> bij_betw \<alpha> S S"
   by (simp add: Units_bijective)
 
 text \<open>p 31, ll 26--27\<close>
 lemma Units_bij_betwD [dest, simp]:
   "\<lbrakk> \<alpha> \<in> S \<rightarrow>\<^sub>E S; bij_betw \<alpha> S S \<rbrakk> \<Longrightarrow> \<alpha> \<in> Units"
   unfolding Units_bijective by simp
 
 text \<open>p 31, ll 28--29\<close>
 abbreviation "Sym \<equiv> Units"
 
 text \<open>p 31, ll 26--28\<close>
 sublocale symmetric: group "Sym" "compose S" "identity S"
   by (fact group_of_Units)
 
 end (* transformations *)
 
 text \<open>p 32, ll 18--19\<close>
 locale transformation_group =
   transformations S + symmetric: subgroup G Sym "compose S" "identity S" for G and S
 begin
 
 text \<open>p 32, ll 18--19\<close>
 lemma transformation_group_closed [intro, simp]:
   "\<lbrakk> \<alpha> \<in> G; x \<in> S \<rbrakk> \<Longrightarrow> \<alpha> x \<in> S"
   using bij_betwE by blast
 
 text \<open>p 32, ll 18--19\<close>
 lemma transformation_group_undefined [intro, simp]:
   "\<lbrakk> \<alpha> \<in> G; x \<notin> S \<rbrakk> \<Longrightarrow> \<alpha> x = undefined"
   by (metis compose_def symmetric.sub.right_unit restrict_apply)
 
 end (* transformation_group *)
 
 
 subsection \<open>Isomorphisms.  Cayley's Theorem\<close>
 
 text \<open>Def 1.3\<close>
 text \<open>p 37, ll 7--11\<close>
 locale monoid_isomorphism =
   bijective_map \<eta> M M' +  source: monoid M "(\<cdot>)" \<one> + target: monoid M' "(\<cdot>')" "\<one>'"
   for \<eta> and M and composition (infixl "\<cdot>" 70) and unit ("\<one>")
     and M' and composition' (infixl "\<cdot>''" 70) and unit' ("\<one>''") +
   assumes commutes_with_composition: "\<lbrakk> x \<in> M; y \<in> M \<rbrakk> \<Longrightarrow> \<eta> x \<cdot>' \<eta> y = \<eta> (x \<cdot> y)"
     and commutes_with_unit: "\<eta> \<one> = \<one>'"
 
 text \<open>p 37, l 10\<close>
 definition isomorphic_as_monoids (infixl "\<cong>\<^sub>M" 50)
   where "\<M> \<cong>\<^sub>M \<M>' \<longleftrightarrow> (let (M, composition, unit) = \<M>; (M', composition', unit') = \<M>' in
   (\<exists>\<eta>. monoid_isomorphism \<eta> M composition unit M' composition' unit'))"
 
 text \<open>p 37, ll 11--12\<close>
 locale monoid_isomorphism' =
   bijective_map \<eta> M M' +  source: monoid M "(\<cdot>)" \<one> + target: monoid M' "(\<cdot>')" "\<one>'"
   for \<eta> and M and composition (infixl "\<cdot>" 70) and unit ("\<one>")
     and M' and composition' (infixl "\<cdot>''" 70) and unit' ("\<one>''") +
   assumes commutes_with_composition: "\<lbrakk> x \<in> M; y \<in> M \<rbrakk> \<Longrightarrow> \<eta> x \<cdot>' \<eta> y = \<eta> (x \<cdot> y)"
 
 text \<open>p 37, ll 11--12\<close>
 sublocale monoid_isomorphism \<subseteq> monoid_isomorphism'
   by unfold_locales (simp add: commutes_with_composition)
 
 text \<open>Both definitions are equivalent.\<close>
 text \<open>p 37, ll 12--15\<close>
 sublocale monoid_isomorphism' \<subseteq> monoid_isomorphism
 proof unfold_locales
   {
     fix y assume "y \<in> M'"
     then obtain x where "\<eta> x = y" "x \<in> M" by (metis image_iff surjective)
     then have "y \<cdot>' \<eta> \<one> = y" using commutes_with_composition by auto
   }
   then show "\<eta> \<one> = \<one>'" by fastforce
 qed (simp add: commutes_with_composition)
 
 context monoid_isomorphism begin
 
 text \<open>p 37, ll 30--33\<close>
 theorem inverse_monoid_isomorphism:
   "monoid_isomorphism (restrict (inv_into M \<eta>) M') M' (\<cdot>') \<one>' M (\<cdot>) \<one>"
   using commutes_with_composition commutes_with_unit surjective by unfold_locales auto
 
 end (* monoid_isomorphism *)
 
 text \<open>We only need that @{term \<eta>} is symmetric.\<close>
 text \<open>p 37, ll 28--29\<close>
 theorem isomorphic_as_monoids_symmetric:
   "(M, composition, unit) \<cong>\<^sub>M (M', composition', unit') \<Longrightarrow> (M', composition', unit') \<cong>\<^sub>M (M, composition, unit)"
   by (simp add: isomorphic_as_monoids_def) (meson monoid_isomorphism.inverse_monoid_isomorphism)
 
 text \<open>p 38, l 4\<close>
 locale left_translations_of_monoid = monoid begin
 
 (*
   We take the liberty of omitting "left_" from the name of the translation operation.  The derived
   transformation monoid and group won't be qualified with "left" either.  This avoids qualifications
   such as "left.left_...".  In contexts where left and right translations are used simultaneously,
   notably subgroup_of_group, qualifiers are needed.
 *)
 
 text \<open>p 38, ll 5--7\<close>
 definition translation ("'(_')\<^sub>L") where "translation = (\<lambda>a \<in> M. \<lambda>x \<in> M. a \<cdot> x)"
 
 text \<open>p 38, ll 5--7\<close>
 lemma translation_map [intro, simp]:
   "a \<in> M \<Longrightarrow> (a)\<^sub>L \<in> M \<rightarrow>\<^sub>E M"
   unfolding translation_def by simp
 
 text \<open>p 38, ll 5--7\<close>
 lemma Translations_maps [intro, simp]:
   "translation ` M \<subseteq> M \<rightarrow>\<^sub>E M"
   by (simp add: image_subsetI)
 
 text \<open>p 38, ll 5--7\<close>
 lemma translation_apply:
   "\<lbrakk> a \<in> M; b \<in> M \<rbrakk> \<Longrightarrow> (a)\<^sub>L b = a \<cdot> b"
   unfolding translation_def by auto
 
 text \<open>p 38, ll 5--7\<close>
 lemma translation_exist:
   "f \<in> translation ` M \<Longrightarrow> \<exists>a \<in> M. f = (a)\<^sub>L"
   by auto
 
 text \<open>p 38, ll 5--7\<close>
 lemmas Translations_E [elim] = translation_exist [THEN bexE]
 
 text \<open>p 38, l 10\<close>
 theorem translation_unit_eq [simp]:
   "identity M = (\<one>)\<^sub>L"
   unfolding translation_def by auto
 
 text \<open>p 38, ll 10--11\<close>
 theorem translation_composition_eq [simp]:
   assumes [simp]: "a \<in> M" "b \<in> M"
   shows "compose M (a)\<^sub>L (b)\<^sub>L = (a \<cdot> b)\<^sub>L"
   unfolding translation_def by rule (simp add: associative compose_def)
 
 (* Activate @{locale monoid} to simplify subsequent proof. *)
 text \<open>p 38, ll 7--9\<close>
 sublocale transformation: transformations M .
 
 text \<open>p 38, ll 7--9\<close>
 theorem Translations_transformation_monoid:
   "transformation_monoid (translation ` M) M"
   by unfold_locales auto
 
 text \<open>p 38, ll 7--9\<close>
 sublocale transformation: transformation_monoid "translation ` M" M
   by (fact Translations_transformation_monoid)
 
 text \<open>p 38, l 12\<close>
 sublocale map translation M "translation ` M"
   by unfold_locales (simp add: translation_def)
 
 text \<open>p 38, ll 12--16\<close>
 theorem translation_isomorphism [intro]:
   "monoid_isomorphism translation M (\<cdot>) \<one> (translation ` M) (compose M) (identity M)"
 proof unfold_locales
   have "inj_on translation M"
   proof (rule inj_onI)
     fix a b
     assume [simp]: "a \<in> M" "b \<in> M" "(a)\<^sub>L = (b)\<^sub>L"
     have "(a)\<^sub>L \<one> = (b)\<^sub>L \<one>" by simp
     then show "a = b" by (simp add: translation_def)
   qed
   then show "bij_betw translation M (translation ` M)"
     by (simp add: inj_on_imp_bij_betw)
 qed simp_all
 
 text \<open>p 38, ll 12--16\<close>
 sublocale monoid_isomorphism translation M "(\<cdot>)" \<one> "translation ` M" "compose M" "identity M" ..
 
 end (* left_translations_of_monoid *)
 
 context monoid begin
 
 text \<open>p 38, ll 1--2\<close>
 interpretation left_translations_of_monoid ..
 
 text \<open>p 38, ll 1--2\<close>
 theorem cayley_monoid:
   "\<exists>M' composition' unit'. transformation_monoid M' M \<and> (M, (\<cdot>), \<one>) \<cong>\<^sub>M (M', composition', unit')"
   by (simp add: isomorphic_as_monoids_def) (fast intro: Translations_transformation_monoid)
 
 end (* monoid *)
 
 text \<open>p 38, l 17\<close>
 locale left_translations_of_group = group begin
 
 text \<open>p 38, ll 17--18\<close>
 sublocale left_translations_of_monoid where M = G ..
 
 text \<open>p 38, ll 17--18\<close>
 notation translation ("'(_')\<^sub>L")
 
 text \<open>
   The group of left translations is a subgroup of the symmetric group,
   hence @{term transformation.sub.invertible}.
 \<close>
 text \<open>p 38, ll 20--22\<close>
 theorem translation_invertible [intro, simp]:
   assumes [simp]: "a \<in> G"
   shows "transformation.sub.invertible (a)\<^sub>L"
 proof
   show "compose G (a)\<^sub>L (inverse a)\<^sub>L = identity G" by simp
 next
   show "compose G (inverse a)\<^sub>L (a)\<^sub>L = identity G" by simp
 qed auto
 
 text \<open>p 38, ll 19--20\<close>
 theorem translation_bijective [intro, simp]:
   "a \<in> G \<Longrightarrow> bij_betw (a)\<^sub>L G G"
   by (blast intro: transformation.invertible_is_bijective [THEN iffD1])
 
 text \<open>p 38, ll 18--20\<close>
 theorem Translations_transformation_group:
   "transformation_group (translation ` G) G"
 proof unfold_locales
   show "(translation ` G) \<subseteq> transformation.Sym"
     unfolding transformation.Units_bijective by auto
 next
   fix \<alpha>
   assume \<alpha>: "\<alpha> \<in> translation ` G"
   then obtain a where a: "a \<in> G" and eq: "\<alpha> = (a)\<^sub>L" ..
   with translation_invertible show "transformation.sub.invertible \<alpha>" by simp
 qed auto
 
 text \<open>p 38, ll 18--20\<close>
 sublocale transformation: transformation_group "translation ` G" G
   by (fact Translations_transformation_group)
 
 end (* left_translations_of_group *)
 
 context group begin
 
 text \<open>p 38, ll 2--3\<close>
 interpretation left_translations_of_group ..
 
 text \<open>p 38, ll 2--3\<close>
 theorem cayley_group:
   "\<exists>G' composition' unit'. transformation_group G' G \<and> (G, (\<cdot>), \<one>) \<cong>\<^sub>M (G', composition', unit')"
   by (simp add: isomorphic_as_monoids_def) (fast intro: Translations_transformation_group)
 
 end (* group *)
 
 text \<open>Exercise 3\<close>
 
 text \<open>p 39, ll 9--10\<close>
 locale right_translations_of_group = group begin
 
 text \<open>p 39, ll 9--10\<close>
 definition translation ("'(_')\<^sub>R") where "translation = (\<lambda>a \<in> G. \<lambda>x \<in> G. x \<cdot> a)"
 
 text \<open>p 39, ll 9--10\<close>
 abbreviation "Translations \<equiv> translation ` G"
 
 text \<open>The isomorphism that will be established is a map different from @{term translation}.\<close>
 text \<open>p 39, ll 9--10\<close>
 interpretation aux: map translation G Translations
   by unfold_locales (simp add: translation_def)
 
 text \<open>p 39, ll 9--10\<close>
 lemma translation_map [intro, simp]:
   "a \<in> G \<Longrightarrow> (a)\<^sub>R \<in> G \<rightarrow>\<^sub>E G"
   unfolding translation_def by simp
 
 text \<open>p 39, ll 9--10\<close>
 lemma Translation_maps [intro, simp]:
   "Translations \<subseteq> G \<rightarrow>\<^sub>E G"
   by (simp add: image_subsetI)
 
 text \<open>p 39, ll 9--10\<close>
 lemma translation_apply:
   "\<lbrakk> a \<in> G; b \<in> G \<rbrakk> \<Longrightarrow> (a)\<^sub>R b = b \<cdot> a"
   unfolding translation_def by auto
 
 text \<open>p 39, ll 9--10\<close>
 lemma translation_exist:
   "f \<in> Translations \<Longrightarrow> \<exists>a \<in> G. f = (a)\<^sub>R"
   by auto
 
 text \<open>p 39, ll 9--10\<close>
 lemmas Translations_E [elim] = translation_exist [THEN bexE]
 
 text \<open>p 39, ll 9--10\<close>
 lemma translation_unit_eq [simp]:
   "identity G = (\<one>)\<^sub>R"
   unfolding translation_def by auto
 
 text \<open>p 39, ll 10--11\<close>
 lemma translation_composition_eq [simp]:
   assumes [simp]: "a \<in> G" "b \<in> G"
   shows "compose G (a)\<^sub>R (b)\<^sub>R = (b \<cdot> a)\<^sub>R"
   unfolding translation_def by rule (simp add: associative compose_def)
 
 text \<open>p 39, ll 10--11\<close>
 sublocale transformation: transformations G .
 
 text \<open>p 39, ll 10--11\<close>
 lemma Translations_transformation_monoid:
   "transformation_monoid Translations G"
   by unfold_locales auto
 
 text \<open>p 39, ll 10--11\<close>
 sublocale transformation: transformation_monoid Translations G
   by (fact Translations_transformation_monoid)
 
 text \<open>p 39, ll 10--11\<close>
 lemma translation_invertible [intro, simp]:
   assumes [simp]: "a \<in> G"
   shows "transformation.sub.invertible (a)\<^sub>R"
 proof
   show "compose G (a)\<^sub>R (inverse a)\<^sub>R = identity G" by simp
 next
   show "compose G (inverse a)\<^sub>R (a)\<^sub>R = identity G" by simp
 qed auto
 
 text \<open>p 39, ll 10--11\<close>
 lemma translation_bijective [intro, simp]:
   "a \<in> G \<Longrightarrow> bij_betw (a)\<^sub>R G G"
   by (blast intro: transformation.invertible_is_bijective [THEN iffD1])
 
 text \<open>p 39, ll 10--11\<close>
 theorem Translations_transformation_group:
   "transformation_group Translations G"
 proof unfold_locales
   show "Translations \<subseteq> transformation.Sym"
   unfolding transformation.Units_bijective by auto
 next
   fix \<alpha>
   assume \<alpha>: "\<alpha> \<in> Translations"
   then obtain a where a: "a \<in> G" and eq: "\<alpha> = (a)\<^sub>R" ..
   with translation_invertible show "transformation.sub.invertible \<alpha>" by simp
 qed auto
 
 text \<open>p 39, ll 10--11\<close>
 sublocale transformation: transformation_group Translations G
   by (rule Translations_transformation_group)
 
 text \<open>p 39, ll 10--11\<close>
 lemma translation_inverse_eq [simp]:
   assumes [simp]: "a \<in> G"
   shows "transformation.sub.inverse (a)\<^sub>R = (inverse a)\<^sub>R"
 proof (rule transformation.sub.inverse_equality)
   show "compose G (a)\<^sub>R (inverse a)\<^sub>R = identity G" by simp
 next
   show "compose G (inverse a)\<^sub>R (a)\<^sub>R = identity G" by simp
 qed auto
 
 text \<open>p 39, ll 10--11\<close>
 theorem translation_inverse_monoid_isomorphism [intro]:
   "monoid_isomorphism (\<lambda>a\<in>G. transformation.symmetric.inverse (a)\<^sub>R) G (\<cdot>) \<one> Translations (compose G) (identity G)"
   (is "monoid_isomorphism ?inv _ _ _ _ _ _")
 proof unfold_locales
   show "?inv \<in> G \<rightarrow>\<^sub>E Translations" by (simp del: translation_unit_eq)
 next
   note bij_betw_compose [trans]
   have "bij_betw inverse G G"
     by (rule bij_betwI [where g = inverse]) auto
   also have "bij_betw translation G Translations"
     by (rule bij_betwI [where g = "\<lambda>\<alpha>\<in>Translations. \<alpha> \<one>"]) (auto simp: translation_apply)
   finally show "bij_betw ?inv G Translations"
     by (simp cong: bij_betw_cong add: compose_eq del: translation_unit_eq)
 next
   fix x and y
   assume [simp]: "x \<in> G" "y \<in> G"
   show "compose G (?inv x) (?inv y) = (?inv (x \<cdot> y))" by (simp add: inverse_composition_commute del: translation_unit_eq)
 next
   show "?inv \<one> = identity G" by (simp del: translation_unit_eq) simp
 qed
 
 text \<open>p 39, ll 10--11\<close>
 sublocale monoid_isomorphism
   "\<lambda>a\<in>G. transformation.symmetric.inverse (a)\<^sub>R" G "(\<cdot>)" \<one> Translations "compose G" "identity G" ..
 
 end (* right_translations_of_group *)
 
 
 subsection \<open>Generalized Associativity.  Commutativity\<close>
 
 text \<open>p 40, l 27; p 41, ll 1--2\<close>
 locale commutative_monoid = monoid +
   assumes commutative: "\<lbrakk> x \<in> M; y \<in> M \<rbrakk> \<Longrightarrow> x \<cdot> y = y \<cdot> x"
   
 text \<open>p 41, l 2\<close>
 locale abelian_group = group + commutative_monoid G "(\<cdot>)" \<one>
 
 
 subsection \<open>Orbits.  Cosets of a Subgroup\<close>
 
 context transformation_group begin
 
 text \<open>p 51, ll 18--20\<close>
 definition Orbit_Relation
   where "Orbit_Relation = {(x, y). x \<in> S \<and> y \<in> S \<and> (\<exists>\<alpha> \<in> G. y = \<alpha> x)}"
 
 text \<open>p 51, ll 18--20\<close>
 lemma Orbit_Relation_memI [intro]:
   "\<lbrakk> \<exists>\<alpha> \<in> G. y = \<alpha> x; x \<in> S \<rbrakk> \<Longrightarrow> (x, y) \<in> Orbit_Relation"
   unfolding Orbit_Relation_def by auto
 
 text \<open>p 51, ll 18--20\<close>
 lemma Orbit_Relation_memE [elim]:
   "\<lbrakk> (x, y) \<in> Orbit_Relation; \<And>\<alpha>. \<lbrakk> \<alpha> \<in> G; x \<in> S; y = \<alpha> x \<rbrakk> \<Longrightarrow> Q \<rbrakk> \<Longrightarrow> Q"
   unfolding Orbit_Relation_def by auto
 
 text \<open>p 51, ll 20--23, 26--27\<close>
 sublocale orbit: equivalence S Orbit_Relation
 proof (unfold_locales, auto simp: Orbit_Relation_def)
   fix x
   assume x: "x \<in> S"
   then have id: "x = identity S x" by simp
   with x show "\<exists>\<alpha> \<in> G. x = \<alpha> x" by fast
   fix \<alpha>
   assume \<alpha>: "\<alpha> \<in> G"
   with x id have y: "x = compose S (symmetric.inverse \<alpha>) \<alpha> x" by auto
   with x \<alpha> show "\<exists>\<alpha>' \<in> G. x = \<alpha>' (\<alpha> x)"
     by (metis compose_eq symmetric.sub.invertible symmetric.submonoid_inverse_closed)
   fix \<beta>
   assume \<beta>: "\<beta> \<in> G"
   with x have "\<beta> (\<alpha> x) = compose S \<beta> \<alpha> x" by (simp add: compose_eq)
   with \<alpha> \<beta> show "\<exists>\<gamma> \<in> G. \<beta> (\<alpha> x) = \<gamma> x" by fast
 qed
 
 text \<open>p 51, ll 23--24\<close>
 theorem orbit_equality:
   "x \<in> S \<Longrightarrow> orbit.Class x = {\<alpha> x | \<alpha>. \<alpha> \<in> G}"
 by (simp add: orbit.Class_def) (blast intro: orbit.symmetric dest: orbit.symmetric)
 
 end (* transformation_group *)
 
 context monoid_isomorphism begin
 
 text \<open>p 52, ll 16--17\<close>
 theorem image_subgroup:
   assumes "subgroup G M (\<cdot>) \<one>"
   shows "subgroup (\<eta> ` G) M' (\<cdot>') \<one>'"
 proof -
   interpret subgroup G M "(\<cdot>)" \<one> by fact
   interpret image: monoid "\<eta> ` G" "(\<cdot>')" "\<one>'"
     by unfold_locales (auto simp add: commutes_with_composition commutes_with_unit [symmetric])
   show ?thesis
   proof (unfold_locales, auto)
     fix x
     assume x: "x \<in> G"
     show "image.invertible (\<eta> x)"
     proof
       show "\<eta> (sub.inverse x) \<in> \<eta> ` G" using x by simp
     qed (auto simp: x commutes_with_composition commutes_with_unit)
   qed
 qed
 
 end (* monoid_isomorphism *)
 
 text \<open>
   Technical device to achieve Jacobson's notation for @{text Right_Coset} and @{text Left_Coset}.  The
   definitions are pulled out of @{text subgroup_of_group} to a context where @{text H} is not a parameter.
 \<close>
 text \<open>p 52, l 20\<close>
 locale coset_notation = fixes composition (infixl "\<cdot>" 70)  begin
 
 text \<open>Equation 23\<close>
 text \<open>p 52, l 20\<close>
 definition Right_Coset (infixl "|\<cdot>" 70) where "H |\<cdot> x = {h \<cdot> x | h. h \<in> H}"
 
 text \<open>p 53, ll 8--9\<close>
 definition Left_Coset (infixl "\<cdot>|" 70) where "x \<cdot>| H = {x \<cdot> h | h. h \<in> H}"
 
 text \<open>p 52, l 20\<close>
 lemma Right_Coset_memI [intro]:
   "h \<in> H \<Longrightarrow> h \<cdot> x \<in> H |\<cdot> x"
   unfolding Right_Coset_def by blast
 
 text \<open>p 52, l 20\<close>
 lemma Right_Coset_memE [elim]:
   "\<lbrakk> a \<in> H |\<cdot> x; \<And>h. \<lbrakk> h \<in> H; a = h \<cdot> x \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
   unfolding Right_Coset_def by blast
 
 text \<open>p 53, ll 8--9\<close>
 lemma Left_Coset_memI [intro]:
   "h \<in> H \<Longrightarrow> x \<cdot> h \<in> x \<cdot>| H"
   unfolding Left_Coset_def by blast
 
 text \<open>p 53, ll 8--9\<close>
 lemma Left_Coset_memE [elim]:
   "\<lbrakk> a \<in> x \<cdot>| H; \<And>h. \<lbrakk> h \<in> H; a = x \<cdot> h \<rbrakk> \<Longrightarrow> P \<rbrakk> \<Longrightarrow> P"
   unfolding Left_Coset_def by blast
 
 end (* coset_notation *)
 
 text \<open>p 52, l 12\<close>
 locale subgroup_of_group = subgroup H G "(\<cdot>)" \<one> + coset_notation "(\<cdot>)" + group G "(\<cdot>)" \<one>
   for H and G and composition (infixl "\<cdot>" 70) and unit ("\<one>")
 begin
 
 text \<open>p 52, ll 12--14\<close>
 interpretation left: left_translations_of_group ..
 interpretation right: right_translations_of_group ..
 
 text \<open>
   @{term "left.translation ` H"} denotes Jacobson's @{text "H\<^sub>L(G)"} and
   @{term "left.translation ` G"} denotes Jacobson's @{text "G\<^sub>L"}.
 \<close>
 
 text \<open>p 52, ll 16--18\<close>
 theorem left_translations_of_subgroup_are_transformation_group [intro]:
   "transformation_group (left.translation ` H) G"
 proof -
   have "subgroup (left.translation ` H) (left.translation ` G) (compose G) (identity G)"
     by (rule left.image_subgroup) unfold_locales
   also have "subgroup (left.translation ` G) left.transformation.Sym (compose G) (identity G)" ..
   finally interpret right_coset: subgroup "left.translation ` H" left.transformation.Sym "compose G" "identity G" .
   show ?thesis ..
 qed
 
 text \<open>p 52, l 18\<close>
 interpretation transformation_group "left.translation ` H" G ..
 
 text \<open>p 52, ll 19--20\<close>
 theorem Right_Coset_is_orbit:
   "x \<in> G \<Longrightarrow> H |\<cdot> x = orbit.Class x"
   using left.translation_apply by (auto simp: orbit_equality Right_Coset_def) (metis imageI sub)
 
 text \<open>p 52, ll 24--25\<close>
 theorem Right_Coset_Union:
   "(\<Union>x\<in>G. H |\<cdot> x) = G"
   by (simp add: Right_Coset_is_orbit)
 
 text \<open>p 52, l 26\<close>
 theorem Right_Coset_bij:
   assumes G [simp]: "x \<in> G" "y \<in> G"
   shows "bij_betw (inverse x \<cdot> y)\<^sub>R (H |\<cdot> x) (H |\<cdot> y)"
 proof (rule bij_betw_imageI)
   show "inj_on (inverse x \<cdot> y)\<^sub>R (H |\<cdot> x)"
     by (fastforce intro: inj_onI simp add: Right_Coset_is_orbit right.translation_apply orbit.block_closed)
 next
   show "(inverse x \<cdot> y)\<^sub>R ` (H |\<cdot> x) = H |\<cdot> y"
     by (force simp add: right.translation_apply associative invertible_right_inverse2)
 qed
 
 text \<open>p 52, ll 25--26\<close>
 theorem Right_Cosets_cardinality:
   "\<lbrakk> x \<in> G; y \<in> G \<rbrakk> \<Longrightarrow> card (H |\<cdot> x) = card (H |\<cdot> y)"
   by (fast intro: bij_betw_same_card Right_Coset_bij)
 
 text \<open>p 52, l 27\<close>
 theorem Right_Coset_unit:
   "H |\<cdot> \<one> = H"
   by (force simp add: Right_Coset_def)
 
 text \<open>p 52, l 27\<close>
 theorem Right_Coset_cardinality:
   "x \<in> G \<Longrightarrow> card (H |\<cdot> x) = card H"
   using Right_Coset_unit Right_Cosets_cardinality unit_closed by presburger
 
 text \<open>p 52, ll 31--32\<close>
 definition "index = card orbit.Partition"
 
 text \<open>Theorem 1.5\<close>
 text \<open>p 52, ll 33--35; p 53, ll 1--2\<close>
 theorem lagrange:
   "finite G \<Longrightarrow> card G = card H * index"
   unfolding index_def
   apply (subst card_partition)
       apply (auto simp: finite_UnionD orbit.complete orbit.disjoint)
   apply (metis Right_Coset_cardinality Right_Coset_is_orbit orbit.Block_self orbit.element_exists)
   done
 
 end (* subgroup_of_group *)
 
 text \<open>Left cosets\<close>
 
 context subgroup begin
 
 text \<open>p 31, ll 11--12\<close>
 lemma image_of_inverse [intro, simp]:
   "x \<in> G \<Longrightarrow> x \<in> inverse ` G"
   by (metis image_eqI sub.invertible sub.invertible_inverse_closed sub.invertible_inverse_inverse subgroup_inverse_equality)
 
 end (* subgroup *)
 
 context group begin
 
 (* Does Jacobson show this somewhere? *)
 text \<open>p 53, ll 6--7\<close>
 lemma inverse_subgroupI:
   assumes sub: "subgroup H G (\<cdot>) \<one>"
   shows "subgroup (inverse ` H) G (\<cdot>) \<one>"
 proof -
   from sub interpret subgroup H G "(\<cdot>)" \<one> .
   interpret inv: monoid "inverse ` H" "(\<cdot>)" \<one>
     by unfold_locales (auto simp del: subgroup_inverse_equality)
   interpret inv: group "inverse ` H" "(\<cdot>)" \<one>
     by unfold_locales (force simp del: subgroup_inverse_equality)
   show ?thesis
     by unfold_locales (auto simp del: subgroup_inverse_equality)
 qed
 
 text \<open>p 53, ll 6--7\<close>
 lemma inverse_subgroupD:
   assumes sub: "subgroup (inverse ` H) G (\<cdot>) \<one>"
     and inv: "H \<subseteq> Units"
   shows "subgroup H G (\<cdot>) \<one>"
 proof -
   from sub have "subgroup (inverse ` inverse ` H) G (\<cdot>) \<one>" by (rule inverse_subgroupI)
   moreover from inv [THEN subsetD, simplified Units_def] have "inverse ` inverse ` H = H"
     by (simp cong: image_cong add: image_comp)
   ultimately show ?thesis by simp
 qed
 
 end (* group *)
 
 context subgroup_of_group begin
 
 text \<open>p 53, l 6\<close>
 interpretation right_translations_of_group ..
 
 text \<open>
   @{term "translation ` H"} denotes Jacobson's @{text "H\<^sub>R(G)"} and
   @{term "Translations"} denotes Jacobson's @{text "G\<^sub>R"}.
 \<close>
 
 text \<open>p 53, ll 6--7\<close>
 theorem right_translations_of_subgroup_are_transformation_group [intro]:
   "transformation_group (translation ` H) G"
 proof -
   have "subgroup ((\<lambda>a\<in>G. transformation.symmetric.inverse (a)\<^sub>R) ` H) Translations (compose G) (identity G)"
     by (rule image_subgroup) unfold_locales
   also have "subgroup Translations transformation.Sym (compose G) (identity G)" ..
   finally interpret left_coset: subgroup "translation ` H" transformation.Sym "compose G" "identity G"
     by (auto intro: transformation.symmetric.inverse_subgroupD cong: image_cong
       simp: image_image transformation.symmetric.Units_def simp del: translation_unit_eq)
   show ?thesis ..
 qed
 
 text \<open>p 53, ll 6--7\<close>
 interpretation transformation_group "translation ` H" G ..
 
 text \<open>Equation 23 for left cosets\<close>
 text \<open>p 53, ll 7--8\<close>
 theorem Left_Coset_is_orbit:
   "x \<in> G \<Longrightarrow> x \<cdot>| H = orbit.Class x"
   using translation_apply
   by (auto simp: orbit_equality Left_Coset_def) (metis imageI sub)
 
 end (* subgroup_of_group *)
 
 
 subsection \<open>Congruences.  Quotient Monoids and Groups\<close>
 
 text \<open>Def 1.4\<close>
 text \<open>p 54, ll 19--22\<close>
 locale monoid_congruence = monoid + equivalence where S = M +
   assumes cong: "\<lbrakk> (a, a') \<in> E; (b, b') \<in> E \<rbrakk> \<Longrightarrow> (a \<cdot> b, a' \<cdot> b') \<in> E"
 begin
 
 text \<open>p 54, ll 26--28\<close>
 theorem Class_cong:
   "\<lbrakk> Class a = Class a'; Class b = Class b'; a \<in> M; a' \<in> M; b \<in> M; b' \<in> M \<rbrakk> \<Longrightarrow> Class (a \<cdot> b) = Class (a' \<cdot> b')"
   by (simp add: Class_equivalence cong)
 
 text \<open>p 54, ll 28--30\<close>
 definition quotient_composition (infixl "[\<cdot>]" 70)
   where "quotient_composition = (\<lambda>A \<in> M / E. \<lambda>B \<in> M / E. THE C. \<exists>a \<in> A. \<exists>b \<in> B. C = Class (a \<cdot> b))"
 
 text \<open>p 54, ll 28--30\<close>
 theorem Class_commutes_with_composition:
   "\<lbrakk> a \<in> M; b \<in> M \<rbrakk> \<Longrightarrow> Class a [\<cdot>] Class b = Class (a \<cdot> b)"
   by (auto simp: quotient_composition_def intro: Class_cong [OF Class_eq Class_eq] del: equalityI)
 
 text \<open>p 54, ll 30--31\<close>
 theorem quotient_composition_closed [intro, simp]:
   "\<lbrakk> A \<in> M / E; B \<in> M / E \<rbrakk> \<Longrightarrow> A [\<cdot>] B \<in> M / E"
   by (erule quotient_ClassE)+ (simp add: Class_commutes_with_composition)
 
 text \<open>p 54, l 32; p 55, ll 1--3\<close>
 sublocale quotient: monoid "M / E" "([\<cdot>])" "Class \<one>"
   by unfold_locales (auto simp: Class_commutes_with_composition associative elim!: quotient_ClassE)
 
 end (* monoid_congruence *)
 
 text \<open>p 55, ll 16--17\<close>
 locale group_congruence = group + monoid_congruence where M = G begin
 
 text \<open>p 55, ll 16--17\<close>
 notation quotient_composition (infixl "[\<cdot>]" 70)
 
 text \<open>p 55, l 18\<close>
 theorem Class_right_inverse:
   "a \<in> G \<Longrightarrow> Class a [\<cdot>] Class (inverse a) = Class \<one>"
   by (simp add: Class_commutes_with_composition)
 
 text \<open>p 55, l 18\<close>
 theorem Class_left_inverse:
   "a \<in> G \<Longrightarrow> Class (inverse a) [\<cdot>] Class a = Class \<one>"
   by (simp add: Class_commutes_with_composition)
 
 text \<open>p 55, l 18\<close>
 theorem Class_invertible:
   "a \<in> G \<Longrightarrow> quotient.invertible (Class a)"
   by (blast intro!: Class_right_inverse Class_left_inverse)+
 
 text \<open>p 55, l 18\<close>
 theorem Class_commutes_with_inverse:
   "a \<in> G \<Longrightarrow> quotient.inverse (Class a) = Class (inverse a)"
   by (rule quotient.inverse_equality) (auto simp: Class_right_inverse Class_left_inverse)
 
 text \<open>p 55, l 17\<close>
 sublocale quotient: group "G / E" "([\<cdot>])" "Class \<one>"
   by unfold_locales (metis Block_self Class_invertible element_exists)
 
 end (* group_congruence *)
 
 text \<open>Def 1.5\<close>
 text \<open>p 55, ll 22--25\<close>
 locale normal_subgroup =
   subgroup_of_group K G "(\<cdot>)" \<one> for K and G and composition (infixl "\<cdot>" 70) and unit ("\<one>") +
   assumes normal: "\<lbrakk> g \<in> G; k \<in> K \<rbrakk> \<Longrightarrow> inverse g \<cdot> k \<cdot> g \<in> K"
 
 text \<open>Lemmas from the proof of Thm 1.6\<close>
 
 context subgroup_of_group begin
 
 text \<open>We use @{term H} for @{term K}.\<close>
 text \<open>p 56, ll 14--16\<close>
 theorem Left_equals_Right_coset_implies_normality:
   assumes [simp]: "\<And>g. g \<in> G \<Longrightarrow> g \<cdot>| H = H |\<cdot> g"
   shows "normal_subgroup H G (\<cdot>) \<one>"
 proof
   fix g k
   assume [simp]: "g \<in> G" "k \<in> H"
   have "k \<cdot> g \<in> g \<cdot>| H" by auto
   then obtain k' where "k \<cdot> g = g \<cdot> k'" and "k' \<in> H" by blast
   then show "inverse g \<cdot> k \<cdot> g \<in> H" by (simp add: associative invertible_left_inverse2)
 qed
 
 end (* subgroup_of_group *)
 
 text \<open>Thm 1.6, first part\<close>
 
 context group_congruence begin
 
 text \<open>Jacobson's $K$\<close>
 text \<open>p 56, l 29\<close>
 definition "Normal = Class \<one>"
 
 text \<open>p 56, ll 3--6\<close>
 interpretation subgroup "Normal" G "(\<cdot>)" \<one>
   unfolding Normal_def
 proof (rule subgroupI)
   fix k1 and k2
   assume K: "k1 \<in> Class \<one>" "k2 \<in> Class \<one>"
   then have "k1 \<cdot> k2 \<in> Class (k1 \<cdot> k2)" by blast
   also have "\<dots> = Class k1 [\<cdot>] Class k2" using K by (auto simp add: Class_commutes_with_composition Class_closed)
   also have "\<dots> = Class \<one> [\<cdot>] Class \<one>" using K by (metis ClassD Class_eq unit_closed)
   also have "\<dots> = Class \<one>" by simp
   finally show "k1 \<cdot> k2 \<in> Class \<one>" .
 next
   fix k
   assume K: "k \<in> Class \<one>"
   then have "inverse k \<in> Class (inverse k)" by blast
   also have "\<dots> = quotient.inverse (Class k)" using Class_commutes_with_inverse K by blast
   also have "\<dots> = quotient.inverse (Class \<one>)" using Block_self K by auto
   also have "\<dots> = Class \<one>" using quotient.inverse_unit by blast
   finally show "inverse k \<in> Class \<one>" .
 qed auto
 
 text \<open>Coset notation\<close>
 text \<open>p 56, ll 5--6\<close>
 interpretation subgroup_of_group "Normal" G "(\<cdot>)" \<one> ..
 
 text \<open>Equation 25 for right cosets\<close>
 text \<open>p 55, ll 29--30; p 56, ll 6--11\<close>
 theorem Right_Coset_Class_unit:
   assumes g: "g \<in> G" shows "Normal |\<cdot> g = Class g"
   unfolding Normal_def
 proof auto
   fix a  \<comment> \<open>ll 6--8\<close>
   assume a: "a \<in> Class g"
   from a g have "a \<cdot> inverse g \<in> Class (a \<cdot> inverse g)" by blast
   also from a g have "\<dots> = Class a [\<cdot>] Class (inverse g)"
     by (simp add: Class_commutes_with_composition block_closed)
   also from a g have "\<dots> = Class g [\<cdot>] quotient.inverse (Class g)"
     using Block_self Class_commutes_with_inverse by auto
   also from g have "\<dots> = Class \<one>" by simp
   finally show "a \<in> Class \<one> |\<cdot> g"
     unfolding Right_Coset_def
     by simp (metis Class_closed a associative g inverse_equality invertible invertible_def right_unit) 
 next
   fix a  \<comment> \<open>ll 8--9\<close>
   assume a: "a \<in> Class \<one> |\<cdot> g"
   then obtain k where eq: "a = k \<cdot> g" and k: "k \<in> Class \<one>" by blast
   with g have "Class a = Class k [\<cdot>] Class g" using Class_commutes_with_composition by auto
   also from k have "\<dots> = Class \<one> [\<cdot>] Class g" using Block_self by auto
   also from g have "\<dots> = Class g" by simp
   finally show "a \<in> Class g" using g eq k composition_closed quotient.unit_closed by blast
 qed
 
 text \<open>Equation 25 for left cosets\<close>
 text \<open>p 55, ll 29--30; p 56, ll 6--11\<close>
 theorem Left_Coset_Class_unit:
   assumes g: "g \<in> G" shows "g \<cdot>| Normal = Class g"
   unfolding Normal_def
 proof auto
   fix a  \<comment> \<open>ll 6--8\<close>
   assume a: "a \<in> Class g"
   from a g have "inverse g \<cdot> a \<in> Class (inverse g \<cdot> a)" by blast
   also from a g have "\<dots> = Class (inverse g) [\<cdot>] Class a"
     by (simp add: Class_commutes_with_composition block_closed)
   also from a g have "\<dots> = quotient.inverse (Class g) [\<cdot>] Class g"
     using Block_self Class_commutes_with_inverse by auto
   also from g have "\<dots> = Class \<one>" by simp
   finally show "a \<in> g \<cdot>| Class \<one>"
     unfolding Left_Coset_def
     by simp (metis Class_closed a associative g inverse_equality invertible invertible_def right_unit) 
 next
   fix a  \<comment> \<open>ll 8--9, ``the same thing holds''\<close>
   assume a: "a \<in> g \<cdot>| Class \<one>"
   then obtain k where eq: "a = g \<cdot> k" and k: "k \<in> Class \<one>" by blast
   with g have "Class a = Class g [\<cdot>] Class k" using Class_commutes_with_composition by auto
   also from k have "\<dots> = Class g [\<cdot>] Class \<one>" using Block_self by auto
   also from g have "\<dots> = Class g" by simp
   finally show "a \<in> Class g" using g eq k composition_closed quotient.unit_closed by blast
 qed
 
 text \<open>Thm 1.6, statement of first part\<close>
 text \<open>p 55, ll 28--29; p 56, ll 12--16\<close>
 theorem Class_unit_is_normal:
   "normal_subgroup Normal G (\<cdot>) \<one>"
 proof -
   {
     fix g
     assume "g \<in> G"
     then have "g \<cdot>| Normal = Normal |\<cdot> g" by (simp add: Right_Coset_Class_unit Left_Coset_Class_unit)
   }
   then show ?thesis by (rule Left_equals_Right_coset_implies_normality)
 qed
 
 sublocale normal: normal_subgroup Normal G "(\<cdot>)" \<one>
   by (fact Class_unit_is_normal)
 
 end (* group_congruence *)
 
 context normal_subgroup begin
 
 text \<open>p 56, ll 16--19\<close>
 theorem Left_equals_Right_coset:
   "g \<in> G \<Longrightarrow> g \<cdot>| K = K |\<cdot> g"
 proof
   assume [simp]: "g \<in> G"
   show "K |\<cdot> g \<subseteq> g \<cdot>| K"
   proof
     fix x
     assume x: "x \<in> K |\<cdot> g"
     then obtain k where "x = k \<cdot> g" and [simp]: "k \<in> K" by (auto simp add: Right_Coset_def)
     then have "x = g \<cdot> (inverse g \<cdot> k \<cdot> g)" by (simp add: associative invertible_right_inverse2)
     also from normal have "\<dots> \<in> g \<cdot>| K" by (auto simp add: Left_Coset_def)
     finally show "x \<in> g \<cdot>| K" .
   qed
 next
   assume [simp]: "g \<in> G"
   show "g \<cdot>| K \<subseteq> K |\<cdot> g"
   proof
     fix x
     assume x: "x \<in> g \<cdot>| K"
     then obtain k where "x = g \<cdot> k" and [simp]: "k \<in> K" by (auto simp add: Left_Coset_def)
     then have "x = (inverse (inverse g) \<cdot> k \<cdot> inverse g) \<cdot> g" by (simp add: associative del: invertible_right_inverse)
     also from normal [where g = "inverse g"] have "\<dots> \<in> K |\<cdot> g" by (auto simp add: Right_Coset_def)
     finally show "x \<in> K |\<cdot> g" .
   qed
 qed
 
 text \<open>Thm 1.6, second part\<close>
 
 text \<open>p 55, ll 31--32; p 56, ll 20--21\<close>
 definition "Congruence = {(a, b). a \<in> G \<and> b \<in> G \<and> inverse a \<cdot> b \<in> K}"
 
 text \<open>p 56, ll 21--22\<close>
 interpretation right_translations_of_group ..
 
 text \<open>p 56, ll 21--22\<close>
 interpretation transformation_group "translation ` K" G rewrites "Orbit_Relation = Congruence"
 proof -
   interpret transformation_group "translation ` K" G ..
   show "Orbit_Relation = Congruence"
     unfolding Orbit_Relation_def Congruence_def
     by (force simp: invertible_left_inverse2 invertible_right_inverse2 translation_apply simp del: restrict_apply)
 qed rule
 
 text \<open>p 56, ll 20--21\<close>
 lemma CongruenceI: "\<lbrakk> a = b \<cdot> k; a \<in> G; b \<in> G; k \<in> K \<rbrakk> \<Longrightarrow> (a, b) \<in> Congruence"
   by (clarsimp simp: Congruence_def associative inverse_composition_commute)
 
 text \<open>p 56, ll 20--21\<close>
 lemma CongruenceD: "(a, b) \<in> Congruence \<Longrightarrow> \<exists>k\<in>K. a = b \<cdot> k"
   by (drule orbit.symmetric) (force simp: Congruence_def invertible_right_inverse2)
 
 text \<open>
   ``We showed in the last section that the relation we are considering is an equivalence relation in
   @{term G} for any subgroup @{term K} of @{term G}.  We now proceed to show that normality of @{term K}
   ensures that [...] $a \equiv b \pmod{K}$ is a congruence.''
 \<close>
 text \<open>p 55, ll 30--32; p 56, ll 1, 22--28\<close>
 sublocale group_congruence where E = Congruence rewrites "Normal = K"
 proof -
   show "group_congruence G (\<cdot>) \<one> Congruence"
   proof unfold_locales
     note CongruenceI [intro] CongruenceD [dest]
     fix a g b h
     assume 1: "(a, g) \<in> Congruence" and 2: "(b, h) \<in> Congruence"
     then have G: "a \<in> G" "g \<in> G" "b \<in> G" "h \<in> G" unfolding Congruence_def by clarify+
     from 1 obtain k1 where a: "a = g \<cdot> k1" and k1: "k1 \<in> K" by blast
     from 2 obtain k2 where b: "b = h \<cdot> k2" and k2: "k2 \<in> K" by blast
     from G Left_equals_Right_coset have "K |\<cdot> h = h \<cdot>| K" by blast
     with k1 obtain k3 where c: "k1 \<cdot> h = h \<cdot> k3" and k3: "k3 \<in> K"
       unfolding Left_Coset_def Right_Coset_def by blast
     from G k1 k2 a b have "a \<cdot> b = g \<cdot> k1 \<cdot> h \<cdot> k2" by (simp add: associative)
     also from G k1 k3 c have "\<dots> = g \<cdot> h \<cdot> k3 \<cdot> k2" by (simp add: associative)
     also have "\<dots> = (g \<cdot> h) \<cdot> (k3 \<cdot> k2)" using G k2 k3 by (simp add: associative)
     finally show "(a \<cdot> b, g \<cdot> h) \<in> Congruence" using G k2 k3 by blast
   qed
   then interpret group_congruence where E = Congruence .
   show "Normal = K"
     unfolding Normal_def orbit.Class_def unfolding Congruence_def
     using invertible_inverse_inverse submonoid_inverse_closed by fastforce 
 qed
 
 end (* normal_subgroup *)  (* deletes translations and orbits, recovers Class for congruence class *)
 
 context group begin
 
 text \<open>Pulled out of @{locale normal_subgroup} to achieve standard notation.\<close>
 text \<open>p 56, ll 31--32\<close>
 abbreviation Factor_Group (infixl "'/'/" 75)
   where "S // K \<equiv> S / (normal_subgroup.Congruence K G (\<cdot>) \<one>)"
 
 end (* group *)
 
 context normal_subgroup begin
 
 text \<open>p 56, ll 28--29\<close>
 theorem Class_unit_normal_subgroup: "Class \<one> = K"
   unfolding Class_def unfolding Congruence_def
   using invertible_inverse_inverse submonoid_inverse_closed by fastforce
 
 text \<open>p 56, ll 1--2; p 56, l 29\<close>
 theorem Class_is_Left_Coset:
   "g \<in> G \<Longrightarrow> Class g = g \<cdot>| K"
   using Left_Coset_Class_unit Class_unit_normal_subgroup by simp
 
 text \<open>p 56, l 29\<close>
 lemma Left_CosetE: "\<lbrakk> A \<in> G // K; \<And>a. a \<in> G \<Longrightarrow> P (a \<cdot>| K) \<rbrakk> \<Longrightarrow> P A"
   by (metis Class_is_Left_Coset quotient_ClassE)
 
 text \<open>Equation 26\<close>
 text \<open>p 56, ll 32--34\<close>
 theorem factor_composition [simp]:
   "\<lbrakk> g \<in> G; h \<in> G \<rbrakk> \<Longrightarrow> (g \<cdot>| K) [\<cdot>] (h \<cdot>| K) = g \<cdot> h \<cdot>| K"
   using Class_commutes_with_composition Class_is_Left_Coset by auto
 
 text \<open>p 56, l 35\<close>
 theorem factor_unit:
   "K = \<one> \<cdot>| K"
   using Class_is_Left_Coset Class_unit_normal_subgroup by blast
 
 text \<open>p 56, l 35\<close>
 theorem factor_inverse [simp]:
   "g \<in> G \<Longrightarrow> quotient.inverse (g \<cdot>| K) = (inverse g \<cdot>| K)"
   using Class_commutes_with_inverse Class_is_Left_Coset by auto
 
 end (* normal_subgroup *)
 
 text \<open>p 57, ll 4--5\<close>
 locale subgroup_of_abelian_group = subgroup_of_group H G "(\<cdot>)" \<one> + abelian_group G "(\<cdot>)" \<one>
   for H and G and composition (infixl "\<cdot>" 70) and unit ("\<one>")
 
 text \<open>p 57, ll 4--5\<close>
 sublocale subgroup_of_abelian_group \<subseteq> normal_subgroup H G "(\<cdot>)" \<one>
   using commutative invertible_right_inverse2 by unfold_locales auto
 
 
 subsection \<open>Homomorphims\<close>
 
 text \<open>Def 1.6\<close>
 text \<open>p 58, l 33; p 59, ll 1--2\<close>
 locale monoid_homomorphism =
   map \<eta> M M'+  source: monoid M "(\<cdot>)" \<one> + target: monoid M' "(\<cdot>')" "\<one>'"
   for \<eta> and M and composition (infixl "\<cdot>" 70) and unit ("\<one>")
     and M' and composition' (infixl "\<cdot>''" 70) and unit' ("\<one>''") +
   assumes commutes_with_composition: "\<lbrakk> x \<in> M; y \<in> M \<rbrakk> \<Longrightarrow> \<eta> (x \<cdot> y) = \<eta> x \<cdot>' \<eta> y"
     and commutes_with_unit: "\<eta> \<one> = \<one>'"
 begin
 
 text \<open>Jacobson notes that @{thm [source] commutes_with_unit} is not necessary for groups, but doesn't make use of that later.\<close>
 
 text \<open>p 58, l 33; p 59, ll 1--2\<close>
 notation source.invertible ("invertible _" [100] 100)
 notation source.inverse ("inverse _" [100] 100)
 notation target.invertible ("invertible'' _" [100] 100)
 notation target.inverse ("inverse'' _" [100] 100)
 
 end (* monoid_homomorphism *)
 
 text \<open>p 59, ll 29--30\<close>
 locale monoid_epimorphism = monoid_homomorphism + surjective_map \<eta> M M'
 
 text \<open>p 59, l 30\<close>
 locale monoid_monomorphism = monoid_homomorphism + injective_map \<eta> M M'
 
 text \<open>p 59, ll 30--31\<close>
 sublocale monoid_isomorphism \<subseteq> monoid_epimorphism
   by unfold_locales (auto simp: commutes_with_composition commutes_with_unit)
 
 text \<open>p 59, ll 30--31\<close>
 sublocale monoid_isomorphism \<subseteq> monoid_monomorphism
   by unfold_locales (auto simp: commutes_with_composition commutes_with_unit)
 
 context monoid_homomorphism begin
 
 text \<open>p 59, ll 33--34\<close>
 theorem invertible_image_lemma:
   assumes "invertible a" "a \<in> M"
   shows "\<eta> a \<cdot>' \<eta> (inverse a) = \<one>'" and "\<eta> (inverse a) \<cdot>' \<eta> a = \<one>'"
   using assms commutes_with_composition commutes_with_unit source.inverse_equality
   by auto (metis source.invertible_inverse_closed source.invertible_left_inverse)
 
 text \<open>p 59, l 34; p 60, l 1\<close>
 theorem invertible_target_invertible [intro, simp]:
   "\<lbrakk> invertible a; a \<in> M \<rbrakk> \<Longrightarrow> invertible' (\<eta> a)"
   using invertible_image_lemma by blast
 
 text \<open>p 60, l 1\<close>
 theorem invertible_commutes_with_inverse:
   "\<lbrakk> invertible a; a \<in> M \<rbrakk> \<Longrightarrow> \<eta> (inverse a) = inverse' (\<eta> a)"
   using invertible_image_lemma target.inverse_equality by fastforce
 
 end (* monoid_homomorphism *)
 
 text \<open>p 60, ll 32--34; p 61, l 1\<close>
 sublocale monoid_congruence \<subseteq> natural: monoid_homomorphism Class M "(\<cdot>)" \<one> "M / E" "([\<cdot>])" "Class \<one>"
   by unfold_locales (auto simp: PiE_I Class_commutes_with_composition)
 
 text \<open>Fundamental Theorem of Homomorphisms of Monoids\<close>
 
 text \<open>p 61, ll 5, 14--16\<close>
 sublocale monoid_homomorphism \<subseteq> image: submonoid "\<eta> ` M" M' "(\<cdot>')" "\<one>'"
   by unfold_locales (auto simp: commutes_with_composition [symmetric] commutes_with_unit [symmetric])
 
 text \<open>p 61, l 4\<close>
 locale monoid_homomorphism_fundamental = monoid_homomorphism begin
 
 text \<open>p 61, ll 17--18\<close>
 sublocale fiber_relation \<eta> M M' ..
 notation Fiber_Relation ("E'(_')")
 
 text \<open>p 61, ll 6--7, 18--20\<close>
 sublocale monoid_congruence where E = "E(\<eta>)"
   using Class_eq
   by unfold_locales (rule Class_equivalence [THEN iffD1],
     auto simp: left_closed right_closed commutes_with_composition Fiber_equality)
 
 text \<open>p 61, ll 7--9\<close>
 text \<open>
   @{term induced} denotes Jacobson's $\bar{\eta}$.  We have the commutativity of the diagram, where
   @{term induced} is unique: @{thm [display] factorization} @{thm [display] uniqueness}.
 \<close>
 
 text \<open>p 61, l 20\<close>
 notation quotient_composition (infixl "[\<cdot>]" 70)
 
 text \<open>p 61, ll 7--8, 22--25\<close>
 sublocale induced: monoid_homomorphism induced "M / E(\<eta>)" "([\<cdot>])" "Class \<one>" "M'" "(\<cdot>')" "\<one>'"
   apply unfold_locales
     apply (auto simp: commutes_with_unit)
   apply (fastforce simp: commutes_with_composition commutes_with_unit Class_commutes_with_composition)
   done
 
 text \<open>p 61, ll 9, 26\<close>
 sublocale natural: monoid_epimorphism Class M "(\<cdot>)" \<one> "M / E(\<eta>)" "([\<cdot>])" "Class \<one>" ..
 
 text \<open>p 61, ll 9, 26--27\<close>
 sublocale induced: monoid_monomorphism induced "M / E(\<eta>)" "([\<cdot>])" "Class \<one>" "M'" "(\<cdot>')" "\<one>'" ..
 
 end (* monoid_homomorphism_fundamental *)
 
 text \<open>p 62, ll 12--13\<close>
 locale group_homomorphism =
   monoid_homomorphism \<eta> G "(\<cdot>)" \<one> G' "(\<cdot>')" "\<one>'" +
   source: group G "(\<cdot>)" \<one> + target: group G' "(\<cdot>')" "\<one>'"
   for \<eta> and G and composition (infixl "\<cdot>" 70) and unit ("\<one>")
     and G' and composition' (infixl "\<cdot>''" 70) and unit' ("\<one>''")
 begin
 
 text \<open>p 62, l 13\<close>
 sublocale image: subgroup "\<eta> ` G" G' "(\<cdot>')" "\<one>'"
   using invertible_image_lemma by unfold_locales auto
 
 text \<open>p 62, ll 13--14\<close>
 definition "Ker = \<eta> -` {\<one>'} \<inter> G"
 
 text \<open>p 62, ll 13--14\<close>
 lemma Ker_equality:
   "Ker = {a | a. a \<in> G \<and> \<eta> a = \<one>'}"
   unfolding Ker_def by auto
 
 text \<open>p 62, ll 13--14\<close>
 lemma Ker_closed [intro, simp]:
   "a \<in> Ker \<Longrightarrow> a \<in> G"
   unfolding Ker_def by simp
 
 text \<open>p 62, ll 13--14\<close>
 lemma Ker_image [intro]: (* loops as a simprule *)
   "a \<in> Ker \<Longrightarrow> \<eta> a = \<one>'"
   unfolding Ker_def by simp
 
 text \<open>p 62, ll 13--14\<close>
 lemma Ker_memI [intro]: (* loops as a simprule *)
   "\<lbrakk> \<eta> a = \<one>'; a \<in> G \<rbrakk> \<Longrightarrow> a \<in> Ker"
   unfolding Ker_def by simp
 
 text \<open>p 62, ll 15--16\<close>
 sublocale kernel: normal_subgroup Ker G
 proof -
   interpret kernel: submonoid Ker G
     unfolding Ker_def by unfold_locales (auto simp: commutes_with_composition commutes_with_unit)
   interpret kernel: subgroup Ker G
     by unfold_locales (force intro: source.invertible_right_inverse simp: Ker_image invertible_commutes_with_inverse)
   show "normal_subgroup Ker G (\<cdot>) \<one>"
     apply unfold_locales
     unfolding Ker_def
     by (auto simp: commutes_with_composition invertible_image_lemma(2))
 qed
 
 text \<open>p 62, ll 17--20\<close>
 theorem injective_iff_kernel_unit:
   "inj_on \<eta> G \<longleftrightarrow> Ker = {\<one>}"
 proof (rule Not_eq_iff [THEN iffD1, OF iffI])
   assume "Ker \<noteq> {\<one>}"
   then obtain b where b: "b \<in> Ker" "b \<noteq> \<one>" by blast
   then have "\<eta> b = \<eta> \<one>" by (simp add: Ker_image)
   with b show "\<not> inj_on \<eta> G"  by (meson inj_onD kernel.sub source.unit_closed)
 next
   assume "\<not> inj_on \<eta> G"
   then obtain a b where "a \<noteq> b" and ab: "a \<in> G" "b \<in> G" "\<eta> a = \<eta> b" by (meson inj_onI)
   then have "inverse a \<cdot> b \<noteq> \<one>" "\<eta> (inverse a \<cdot> b) = \<one>'"
     using ab source.invertible_right_inverse2
     by force (metis ab commutes_with_composition invertible_image_lemma(2) source.invertible source.invertible_inverse_closed)
   then have "inverse a \<cdot> b \<in> Ker" using Ker_memI ab by blast
   then show "Ker \<noteq> {\<one>}" using \<open>inverse a \<cdot> b \<noteq> \<one>\<close> by blast
 qed
 
 end (* group_homomorphism *)
 
 text \<open>p 62, l 24\<close>
 locale group_epimorphism = group_homomorphism + monoid_epimorphism \<eta> G "(\<cdot>)" \<one> G' "(\<cdot>')" "\<one>'"
 
 text \<open>p 62, l 21\<close>
 locale normal_subgroup_in_kernel =
   group_homomorphism + contained: normal_subgroup L G "(\<cdot>)" \<one> for L +
   assumes subset: "L \<subseteq> Ker"
 begin
 
 text \<open>p 62, l 21\<close>
 notation contained.quotient_composition (infixl "[\<cdot>]" 70)
 
 text \<open>"homomorphism onto @{term "G // L"}"\<close>
 text \<open>p 62, ll 23--24\<close>
 sublocale natural: group_epimorphism contained.Class G "(\<cdot>)" \<one> "G // L" "([\<cdot>])" "contained.Class \<one>" ..
 
 text \<open>p 62, ll 25--26\<close>
 theorem left_coset_equality:
   assumes eq: "a \<cdot>| L = b \<cdot>| L" and [simp]: "a \<in> G" and b: "b \<in> G"
   shows "\<eta> a = \<eta> b"
 proof -
   obtain l where l: "b = a \<cdot> l" "l \<in> L"
     by (metis b contained.Class_is_Left_Coset contained.Class_self eq kernel.Left_Coset_memE)
   then have "\<eta> a = \<eta> a \<cdot>' \<eta> l" using Ker_image monoid_homomorphism.commutes_with_composition subset by auto
   also have "\<dots> = \<eta> b" by (simp add: commutes_with_composition l)
   finally show ?thesis .
 qed
 
 text \<open>$\bar{\eta}$\<close>
 text \<open>p 62, ll 26--27\<close>
 definition "induced = (\<lambda>A \<in> G // L. THE b. \<exists>a \<in> G. a \<cdot>| L = A \<and> b = \<eta> a)"
 
 text \<open>p 62, ll 26--27\<close>
 lemma induced_closed [intro, simp]:
   assumes [simp]: "A \<in> G // L" shows "induced A \<in> G'"
 proof -
   obtain a where a: "a \<in> G" "a \<cdot>| L = A" using contained.Class_is_Left_Coset contained.Partition_def assms by auto
   have "(THE b. \<exists>a \<in> G. a \<cdot>| L = A \<and> b = \<eta> a) \<in> G'"
     apply (rule theI2)
     using a by (auto intro: left_coset_equality)
   then show ?thesis unfolding induced_def by simp
 qed
 
 text \<open>p 62, ll 26--27\<close>
 lemma induced_undefined [intro, simp]:
   "A \<notin> G // L \<Longrightarrow> induced A = undefined"
   unfolding induced_def by simp
 
 text \<open>p 62, ll 26--27\<close>
 theorem induced_left_coset_closed [intro, simp]:
   "a \<in> G \<Longrightarrow> induced (a \<cdot>| L) \<in> G'"
   using contained.Class_is_Left_Coset contained.Class_in_Partition by auto 
 
 text \<open>p 62, ll 26--27\<close>
 theorem induced_left_coset_equality [simp]:
   assumes [simp]: "a \<in> G" shows "induced (a \<cdot>| L) = \<eta> a"
 proof -
   have "(THE b. \<exists>a' \<in> G. a' \<cdot>| L = a \<cdot>| L \<and> b = \<eta> a') = \<eta> a"
     by (rule the_equality) (auto intro: left_coset_equality)
   then show ?thesis unfolding induced_def
     using contained.Class_is_Left_Coset contained.Class_in_Partition by auto 
 qed
 
 text \<open>p 62, l 27\<close>
 theorem induced_Left_Coset_commutes_with_composition [simp]:
   "\<lbrakk> a \<in> G; b \<in> G \<rbrakk> \<Longrightarrow> induced ((a \<cdot>| L) [\<cdot>] (b \<cdot>| L)) = induced (a \<cdot>| L) \<cdot>' induced (b \<cdot>| L)"
   by (simp add: commutes_with_composition)
 
 text \<open>p 62, ll 27--28\<close>
 theorem induced_group_homomorphism:
   "group_homomorphism induced (G // L) ([\<cdot>]) (contained.Class \<one>) G' (\<cdot>') \<one>'"
   apply unfold_locales
     apply (auto elim!: contained.Left_CosetE simp: commutes_with_composition commutes_with_unit)
   using contained.factor_unit induced_left_coset_equality apply (fastforce simp: contained.Class_unit_normal_subgroup)
   done
 
 text \<open>p 62, l 28\<close>
 sublocale induced: group_homomorphism induced "G // L" "([\<cdot>])" "contained.Class \<one>" G' "(\<cdot>')" "\<one>'"
   by (fact induced_group_homomorphism)
 
 text \<open>p 62, ll 28--29\<close>
 theorem factorization_lemma: "a \<in> G \<Longrightarrow> compose G induced contained.Class a = \<eta> a"
   unfolding compose_def by (simp add: contained.Class_is_Left_Coset)
 
 text \<open>p 62, ll 29--30\<close>
 theorem factorization [simp]: "compose G induced contained.Class = \<eta>"
   by rule (simp add: compose_def contained.Class_is_Left_Coset map_undefined)
 
 text \<open>
   Jacobson does not state the uniqueness of @{term induced} explicitly but he uses it later,
   for rings, on p 107.
 \<close>
 text \<open>p 62, l 30\<close>
 theorem uniqueness:
   assumes map: "\<beta> \<in> G // L \<rightarrow>\<^sub>E G'"
     and factorization: "compose G \<beta> contained.Class = \<eta>"
   shows "\<beta> = induced"
 proof
   fix A
   show "\<beta> A = induced A"
   proof (cases "A \<in> G // L")
     case True
     then obtain a where [simp]: "A = contained.Class a" "a \<in> G" by fast
     then have "\<beta> (contained.Class a) = \<eta> a" by (metis compose_eq factorization)
     also have "\<dots> = induced (contained.Class a)" by (simp add: contained.Class_is_Left_Coset)
     finally show ?thesis by simp
   qed (simp add: induced_def PiE_arb [OF map])
 qed
 
 text \<open>p 62, l 31\<close>
 theorem induced_image:
   "induced ` (G // L) = \<eta> ` G"
   by (metis factorization contained.natural.surjective surj_compose)
 
 text \<open>p 62, l 33\<close>
 interpretation L: normal_subgroup L Ker
   by unfold_locales (auto simp: subset, metis kernel.sub kernel.subgroup_inverse_equality contained.normal)
 
 text \<open>p 62, ll 31--33\<close>
 theorem induced_kernel:
   "induced.Ker = Ker / L.Congruence" (* Ker // L is apparently not the right thing *)
 proof -
   have "induced.Ker = { a \<cdot>| L | a. a \<in> G \<and> a \<in> Ker }"
     unfolding induced.Ker_equality
     by simp (metis (opaque_lifting) contained.Class_is_Left_Coset Ker_image Ker_memI
         induced_left_coset_equality contained.Class_in_Partition contained.representant_exists)
   also have "\<dots> = Ker / L.Congruence"
     using L.Class_is_Left_Coset L.Class_in_Partition
     by auto (metis L.Class_is_Left_Coset L.representant_exists kernel.sub)
   finally show ?thesis .
 qed
 
 text \<open>p 62, ll 34--35\<close>
 theorem induced_inj_on:
   "inj_on induced (G // L) \<longleftrightarrow> L = Ker"
   apply (simp add: induced.injective_iff_kernel_unit induced_kernel contained.Class_unit_normal_subgroup)
   apply rule
   using L.block_exists apply auto [1]
   using L.Block_self L.Class_unit_normal_subgroup L.quotient.unit_closed L.representant_exists
   apply auto
   done
 
 end (* normal_subgroup_in_kernel *)
 
 text \<open>Fundamental Theorem of Homomorphisms of Groups\<close>
 
 text \<open>p 63, l 1\<close>
 locale group_homomorphism_fundamental = group_homomorphism begin
 
 text \<open>p 63, l 1\<close>
 notation kernel.quotient_composition (infixl "[\<cdot>]" 70)
 
 text \<open>p 63, l 1\<close>
 sublocale normal_subgroup_in_kernel where L = Ker by unfold_locales rule
 
 text \<open>p 62, ll 36--37; p 63, l 1\<close>
 text \<open>
   @{term induced} denotes Jacobson's $\bar{\eta}$.  We have the commutativity of the diagram, where
   @{term induced} is unique: @{thm [display] factorization} @{thm [display] uniqueness}
 \<close>
 
 end (* group_homomorphism_fundamental *)
 
 text \<open>p 63, l 5\<close>
 locale group_isomorphism = group_homomorphism + bijective_map \<eta> G G' begin
 
 text \<open>p 63, l 5\<close>
 sublocale monoid_isomorphism \<eta> G "(\<cdot>)" \<one> G' "(\<cdot>')" "\<one>'" 
   by unfold_locales (auto simp: commutes_with_composition)
 
 text \<open>p 63, l 6\<close>
 lemma inverse_group_isomorphism:
   "group_isomorphism (restrict (inv_into G \<eta>) G') G' (\<cdot>') \<one>' G (\<cdot>) \<one>"
   using commutes_with_composition commutes_with_unit surjective by unfold_locales auto
 
 end (* group_isomorphism *)
 
 text \<open>p 63, l 6\<close>
 definition isomorphic_as_groups (infixl "\<cong>\<^sub>G" 50)
   where "\<G> \<cong>\<^sub>G \<G>' \<longleftrightarrow> (let (G, composition, unit) = \<G>; (G', composition', unit') = \<G>' in
   (\<exists>\<eta>. group_isomorphism \<eta> G composition unit G' composition' unit'))"
 
 text \<open>p 63, l 6\<close>
 lemma isomorphic_as_groups_symmetric:
   "(G, composition, unit) \<cong>\<^sub>G (G', composition', unit') \<Longrightarrow> (G', composition', unit') \<cong>\<^sub>G (G, composition, unit)"
   by (simp add: isomorphic_as_groups_def) (meson group_isomorphism.inverse_group_isomorphism)
 
 text \<open>p 63, l 1\<close>
 sublocale group_isomorphism \<subseteq> group_epimorphism ..
 
 text \<open>p 63, l 1\<close>
 locale group_epimorphism_fundamental = group_homomorphism_fundamental + group_epimorphism begin
 
 text \<open>p 63, ll 1--2\<close>
 interpretation image: group_homomorphism induced "G // Ker" "([\<cdot>])" "kernel.Class \<one>" "(\<eta> ` G)" "(\<cdot>')" "\<one>'"
   by (simp add: surjective group_homomorphism_fundamental.intro induced_group_homomorphism)
 
 text \<open>p 63, ll 1--2\<close>
 sublocale image: group_isomorphism induced "G // Ker" "([\<cdot>])" "kernel.Class \<one>" "(\<eta> ` G)" "(\<cdot>')" "\<one>'"
   using induced_group_homomorphism
   by unfold_locales (auto simp: bij_betw_def induced_image induced_inj_on induced.commutes_with_composition)
 
 end (* group_epimorphism_fundamental *)
 
 context group_homomorphism begin
 
 text \<open>p 63, ll 5--7\<close>
 theorem image_isomorphic_to_factor_group:
   "\<exists>K composition unit. normal_subgroup K G (\<cdot>) \<one> \<and> (\<eta> ` G, (\<cdot>'), \<one>') \<cong>\<^sub>G (G // K, composition, unit)"
 proof -
   interpret image: group_epimorphism_fundamental where G' = "\<eta> ` G"
     by unfold_locales (auto simp: commutes_with_composition)
   have "group_isomorphism image.induced (G // Ker) ([\<cdot>]) (kernel.Class \<one>) (\<eta> ` G) (\<cdot>') \<one>'" ..
   then have "(\<eta> ` G, (\<cdot>'), \<one>') \<cong>\<^sub>G (G // Ker, ([\<cdot>]), kernel.Class \<one>)"
     by (simp add: isomorphic_as_groups_def) (meson group_isomorphism.inverse_group_isomorphism)
   moreover have "normal_subgroup Ker G (\<cdot>) \<one>" ..
   ultimately show ?thesis by blast
 qed
 
 end (* group_homomorphism *)
 
 end