diff --git a/thys/Conditional_Transfer_Rule/CTR/Tests/CTR_Tests.thy b/thys/Conditional_Transfer_Rule/CTR/Tests/CTR_Tests.thy
--- a/thys/Conditional_Transfer_Rule/CTR/Tests/CTR_Tests.thy
+++ b/thys/Conditional_Transfer_Rule/CTR/Tests/CTR_Tests.thy
@@ -1,250 +1,252 @@
 (* Title: CTR/Tests/CTR_Tests.thy
    Author: Mihails Milehins
    Copyright 2021 (C) Mihails Milehins
 
 A test suite for the sub-framework CTR.
 *)
 
 section\<open>A test suite for CTR\<close>
 theory CTR_Tests
   imports
     "../CTR"
     "../../IML_UT/IML_UT"
     Complex_Main
   keywords "ctr_test" :: thy_defn
 begin
 
 
 
 subsection\<open>Background\<close>
 
 ML\<open>
 
 type ctr_test_data =
   {
     ctr_type : string,
     synthesis : (string * thm list option) option,
     elems: (string, string, Facts.ref) Element.ctxt list,
     type_specs : (string * string) list,
     thm_specs : ((binding option * thm) * mixfix) list
   };
 
 structure CTRTestData = Generic_Data
   (
     type T = ctr_test_data Symtab.table
     val empty = Symtab.empty
     val merge = Symtab.merge (K true)
   );
 
 val get_ctr_test_data_generic = CTRTestData.get;
 val get_ctr_test_data_proof = Context.Proof #> get_ctr_test_data_generic;
 val get_ctr_test_data_global = Context.Theory #> get_ctr_test_data_generic;
 fun test_data_of_generic context = context
   |> get_ctr_test_data_generic
   |> Symtab.lookup;
 val ctr_test_data_of_proof = Context.Proof #> test_data_of_generic;
 
 (*oversimplified: to be used with care*)
 fun update_ctr_test_data k ctr_test_data =
   Local_Theory.declaration
     {pervasive=true, syntax=false}
     (fn _ => (k, ctr_test_data) |> Symtab.update |> CTRTestData.map);
 
 fun process_ctr_test_data (k, args) (lthy : local_theory) =
   let
     fun preprocess_thm_specs lthy =
       map (apfst (apsnd (singleton (Attrib.eval_thms lthy))))
     fun process_ctrs_impl (CTR.ALG_PP _) (lthy : local_theory) = lthy
       | process_ctrs_impl
           (CTR.ALG_RP (((synthesis, elems), type_specs), thm_specs))
           (lthy : local_theory) =
           let
             val thm_specs' = preprocess_thm_specs lthy thm_specs
             val synthesis' = Option.map
               (apsnd (Option.map ((single #> Attrib.eval_thms lthy))))
               synthesis
             val data : ctr_test_data =
               {
                 ctr_type = "relativization",
                 synthesis = synthesis',
                 elems = elems,
                 type_specs = type_specs,
                 thm_specs = thm_specs'
               }
           in update_ctr_test_data k data lthy end
   in process_ctrs_impl args lthy end;
 
 val ctr_test_parser = Parse.string -- CTR.ctr_parser;
 
 val _ =
   Outer_Syntax.local_theory
     \<^command_keyword>\<open>ctr_test\<close>
     "test setup for the command ctr"
     (ctr_test_parser >> process_ctr_test_data);
 
 \<close>
 
-ud \<open>order.mono\<close>
-ud mono' \<open>mono\<close> 
+definition mono where
+  "mono f \<longleftrightarrow> (\<forall>x y. x \<le> y \<longrightarrow> f x \<le> f y)"
+
+ud \<open>mono\<close>
 
 definition mono_ow :: 
   "'a set \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "mono_ow UB leb lea f \<equiv> \<forall>x\<in>UB. \<forall>y\<in>UB. lea x y \<longrightarrow> leb (f x) (f y)"
 
 typedef 'a K = \<open>{xs::'a list. length xs = 2}\<close>
   by (simp add: Ex_list_of_length)
 
 definition KK :: "'a K \<Rightarrow> 'a K \<Rightarrow> bool" 
   where "KK k1 k2 \<equiv> k1 = k2"
 
 typedef 'a L = \<open>{xs::'a list. length xs = 2}\<close>
   by (simp add: Ex_list_of_length)
 
 definition LL :: "'a L \<Rightarrow> 'a L \<Rightarrow> bool" 
   where "LL k1 k2 \<equiv> k1 = k2"
 
 definition rel_L :: 
   "('a::group_add \<Rightarrow> 'b::group_add \<Rightarrow> bool) \<Rightarrow>
   'a::group_add L \<Rightarrow>
   'b::group_add L \<Rightarrow>
   bool" 
   where "rel_L A b c = True"
 
 ctr_relator rel_L
 
 definition not_binders_binrelT :: 
   "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('c \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool"
   where "not_binders_binrelT R1 R2 a b = True"
 
 definition no_dup_binrelT :: 
   "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('c \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool"
   where "no_dup_binrelT R1 R2 a b = True"
 
 definition not_binders_binrelT_ftv_stv :: 
   "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> (nat \<Rightarrow> 'c \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool"
   where "not_binders_binrelT_ftv_stv R1 R2 a b = True"
 
 definition not_type_constructor_lhs :: 
   "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('c \<Rightarrow> 'd \<Rightarrow> bool) \<Rightarrow> 'a \<Rightarrow> 'a K \<Rightarrow> bool"
   where "not_type_constructor_lhs R1 R2 a b = True"
 
 definition not_type_constructor_rhs :: 
   "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('c \<Rightarrow> 'd \<Rightarrow> bool) \<Rightarrow> 'a K \<Rightarrow> 'e \<Rightarrow> bool"
   where "not_type_constructor_rhs R1 R2 a b = True"
 
 definition not_identical_type_constructors ::
   "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('c \<Rightarrow> 'd \<Rightarrow> bool) \<Rightarrow> 'a K \<Rightarrow> 'e L \<Rightarrow> bool"
   where "not_identical_type_constructors R1 R2 a b = True"
 
 definition not_identical_type_constructors_lhs ::
   "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('c \<Rightarrow> 'd \<Rightarrow> bool) \<Rightarrow> 'a K \<Rightarrow> 'b K \<Rightarrow> bool"
   where "not_identical_type_constructors_lhs R1 R2 a b = True"
 
 definition not_identical_type_constructors_rhs ::
   "('a \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> 'a K \<Rightarrow> 'c K \<Rightarrow> bool"
   where "not_identical_type_constructors_rhs R1 a b = True"
 
 
 
 subsection\<open>Test data\<close>
 
 lemma mono_ow_transfer':
   includes lifting_syntax
   assumes [transfer_domain_rule, transfer_rule]: "Domainp B = (\<lambda>x. x \<in> UB)" 
     and [transfer_rule]: "right_total B" 
   shows
     "((A ===> A ===> (=)) ===> (B ===> B ===> (=)) ===> (B ===> A) ===> (=))
       (mono_ow UB) mono.with"
   unfolding mono_ow_def mono.with_def
   by (transfer_prover_start, transfer_step+) simp
 
 ctr_test "mono_with" relativization
   synthesis ctr_simps_Collect_mem_eq
   assumes [transfer_domain_rule, transfer_rule]:
     "Domainp (B::'c\<Rightarrow>'d\<Rightarrow>bool) = (\<lambda>x. x \<in> UB)"
     and [transfer_rule]: "right_total B" 
   trp (?'b \<open>A::'a\<Rightarrow>'b\<Rightarrow>bool\<close>) and (?'a B)
   in mono_ow': mono.with_def 
 
 ctr_test "exI" relativization
   in mono_ow'': exI
 
 ctr_test "binrel" relativization
   synthesis ctr_simps_Collect_mem_eq
   assumes [transfer_domain_rule, transfer_rule]:
     "Domainp (B::'c\<Rightarrow>'d\<Rightarrow>bool) = (\<lambda>x. x \<in> UB)"
     and [transfer_rule]: "right_total B" 
   trp (?'b A) and (?'a B)
   in mono_ow': mono.with_def 
 
 ctr_test "binrel_ftv" relativization
   synthesis ctr_simps_Collect_mem_eq
   assumes [transfer_domain_rule, transfer_rule]:
     "Domainp (B::'c\<Rightarrow>'d\<Rightarrow>bool) = (\<lambda>x. x \<in> UB)"
     and [transfer_rule]: "right_total B" 
   trp (?'b \<open>A::nat\<Rightarrow>'b\<Rightarrow>bool\<close>) and (?'a B)
   in mono_ow': mono.with_def 
 
 ctr_test "dup_stvs" relativization
   synthesis ctr_simps_Collect_mem_eq
   assumes [transfer_domain_rule, transfer_rule]:
     "Domainp (B::'c\<Rightarrow>'d\<Rightarrow>bool) = (\<lambda>x. x \<in> UB)"
     and [transfer_rule]: "right_total B" 
   trp (?'b \<open>A::'a\<Rightarrow>'b\<Rightarrow>bool\<close>) and (?'b B)
   in mono_ow': mono.with_def 
 
 ctr_test "dup_binrel_ftvs" relativization
   synthesis ctr_simps_Collect_mem_eq
   assumes [transfer_domain_rule, transfer_rule]:
     "Domainp (B::'c\<Rightarrow>'d\<Rightarrow>bool) = (\<lambda>x. x \<in> UB)"
     and [transfer_rule]: "right_total B" 
   trp (?'b \<open>A::'a\<Rightarrow>'d\<Rightarrow>bool\<close>) and (?'a B)
   in mono_ow': mono.with_def 
 
 ctr_test "no_relator" relativization
   synthesis ctr_simps_Collect_mem_eq
   assumes [transfer_domain_rule, transfer_rule]:
     "Domainp (B::'c\<Rightarrow>'d\<Rightarrow>bool) = (\<lambda>x. x \<in> UB)"
     and [transfer_rule]: "right_total B" 
   trp (?'b \<open>A::'a\<Rightarrow>'b\<Rightarrow>bool\<close>) and (?'a B) 
   in KK_def
 
 ctr_test "invalid_relator" relativization
   synthesis ctr_simps_Collect_mem_eq
   assumes [transfer_domain_rule, transfer_rule]:
     "Domainp (B::'c\<Rightarrow>'d\<Rightarrow>bool) = (\<lambda>x. x \<in> UB)"
     and [transfer_rule]: "right_total B" 
   trp (?'b \<open>A::'a\<Rightarrow>'b\<Rightarrow>bool\<close>) and (?'a B)
   in LL_def
 
 
 
 subsection\<open>Tests\<close>
 
 
 subsubsection\<open>\<open>process_relativization\<close>\<close>
 
 ML_file\<open>CTR_TEST_PROCESS_RELATIVIZATION.ML\<close>
 
 context
   includes lifting_syntax
 begin
 ML\<open>
 Lecker.test_group @{context} () [ctr_test_process_relativization.test_suite]
 \<close>
 end
 
 
 subsubsection\<open>\<open>process_ctr_relator\<close>\<close>
 
 ML_file\<open>CTR_TEST_PROCESS_CTR_RELATOR.ML\<close>
 
 context
   includes lifting_syntax
 begin
 ML\<open>
 Lecker.test_group @{context} () [ctr_test_process_ctr_relator.test_suite]
 \<close>
 end
 
 end
\ No newline at end of file
diff --git a/thys/Conditional_Transfer_Rule/UD/UD_Reference.thy b/thys/Conditional_Transfer_Rule/UD/UD_Reference.thy
--- a/thys/Conditional_Transfer_Rule/UD/UD_Reference.thy
+++ b/thys/Conditional_Transfer_Rule/UD/UD_Reference.thy
@@ -1,348 +1,340 @@
 (* Title: UD/UD_Reference.thy
    Author: Mihails Milehins
    Copyright 2021 (C) Mihails Milehins
 
 Reference manual for the UD.
 *)
 
 section\<open>UD\<close>
 theory UD_Reference
   imports 
     UD
     "../Reference_Prerequisites"
 begin
 
 
 
 subsection\<open>Introduction\<close>
 
 
 subsubsection\<open>Background\<close>
 
 text\<open>
 This section presents a reference manual for the sub-framework UD. 
 The UD can be used for the elimination of 
 \textit{sort constraints} (e.g., see \cite{altenkirch_constructive_2007})
 and unoverloading of definitions in the object logic Isabelle/HOL of the 
 formal proof assistant Isabelle. 
 The UD evolved from the author's work on an extension of the 
 framework \textit{Types-To-Sets} 
 (see 
 \cite{blanchette_types_2016, kuncar_types_2019, immler_smooth_2019, immler_automation_2019},
 for a description of the framework Types-To-Sets
 and \cite{milehins_extension_2021} for a description of the author's extension)
 and builds upon certain ideas expressed in \cite{kaufmann_mechanized_2010}.
 \<close>
 
 
 subsubsection\<open>Purpose and scope\<close>
 
 text\<open>
 The primary functionality of the framework is available via the Isabelle/Isar 
 command @{command ud}. This command automates the processes of the 
 elimination of sort constraints and unoverloading of definitions.
 Thus, the command @{command ud} allows for the synthesis
 of the convenience constants and theorems that are usually needed for the 
 application of the derivation step 2 of the original relativization algorithm
 of Types-To-Sets (see subsection 5.4 in \cite{blanchette_types_2016}). However, 
 it is expected that the command can be useful for other purposes.
 \<close>
 
 
 subsubsection\<open>Related and previous work\<close>
 
 text\<open>
 The functionality provided by the command @{command ud} shares similarities
 with the functionality provided by the algorithms for the elimination of
 sort constraints and elimination of overloading that were 
 presented in \cite{kaufmann_mechanized_2010}
 and with the algorithm associated with the command 
 \mbox{\textbf{unoverload\_definition}} that was proposed
 in \cite{immler_automation_2019}. 
 Nonetheless, technically, unlike \mbox{\textbf{unoverload\_definition}}, 
 the command @{command ud} does
 not require the additional axiom UO associated with Types-To-Sets for 
 its operation (see \cite{blanchette_types_2016}, 
 \cite{immler_automation_2019}), it uses 
 the \textit{definitional axioms} (e.g., see \cite{kaufmann_mechanized_2010})
 instead of arbitrary theorems supplied by the user
 and it is independent of the infrastructure associated with
 the \textit{axiomatic type classes} 
 \cite{nipkow_type_1991,wenzel_type_1997,altenkirch_constructive_2007}.
 
 It should also be mentioned that the Isabelle/ML code from the main 
 distribution of Isabelle was frequently reused during the 
 development of the UD. Lastly, it should be mentioned that the
 framework SpecCheck \cite{kappelmann_speccheck_2021} was used for unit 
 testing the framework UD.
 \<close>
 
 
 
 subsection\<open>Theory\label{sec:ud_theory}\<close>
 
 
 text\<open>
 The general references for this subsection are
 \cite{kaufmann_mechanized_2010} and \cite{yang_comprehending_2017}.
 The command @{command ud} relies 
 on a restricted (non-recursive) variant of the 
 \textit{classical overloading elimination algorithm}
 that was originally proposed in \cite{kaufmann_mechanized_2010}.
 It is assumed that there exists 
 a variable $ud_{\mathsf{with}}$ that stores theorems of the 
 form $c_{\tau} = c_{\mathsf{with}}\ \bar{*}$, where $c_{\tau}$ and 
 $c_{\mathsf{with}}$ are distinct \textit{constant-instances} 
 and $\bar{*}$ is a finite sequence of \textit{uninterpreted constant-instances},
 such that, if $c_{\tau}$ depends on a type variable $\alpha_{\Upsilon}$, 
 with $\Upsilon$ being a \textit{type class} 
 \cite{nipkow_type_1991,wenzel_type_1997,altenkirch_constructive_2007}
 that depends on the overloaded 
 constants $\bar{*'}$, then $\bar{*}$ contains $\bar{*'}$ as a subsequence. 
 Lastly, the binary operation $\cup$ is defined in a manner such that 
 for any sequences $\bar{*}$ and $\bar{*'}$, $\bar{*} \cup \bar{*'}$ 
 is a sequence that consists of all elements of the union of the 
 elements of $\bar{*}$ and $\bar{*'}$ without duplication. 
 Assuming an underlying 
 \textit{well-formed definitional theory} $D$, 
 the input to the algorithm is a constant-instance $c_{\sigma}$. 
 Given the constant-instance $c_{\sigma}$, 
 there exists at most one definitional axiom
 $c_{\tau} = \phi_{\tau}\left[\bar{*}\right]$ 
 in $D$ such that $c_{\sigma} \leq c_{\tau}$: otherwise 
 the \textit{orthogonality} of $D$ and, 
 therefore, the \textit{well-formedness}
 of $D$ are violated ($\phi$ is assumed to be parameterized by 
 the types that it can have with respect to the
 type substitution operation, 
 and $\bar{*}$ in $c_{\tau} = \phi_{\tau}\left[\bar{*}\right]$ 
 is a list of all uninterpreted constant-instances that 
 occur in $\phi_{\tau}\left[\bar{*}\right]$).
 
 If a definitional axiom $c_{\tau}=\phi_{\tau}\left[\bar{*}\right]$ 
 such that $c_{\sigma} \leq c_{\tau}$ 
 exists for the constant-instance $c_{\sigma}$, 
 then the following derivation is applied to it by the algorithm
 \[
 \infer[(6)]
 {\vdash c_{\sigma} = c_{\mathsf{with}}\ \left(\bar{*} \cup \bar{*'}\right)}
 {
 \infer[(5)]
 {
 \vdash c_{\mathsf{with}}\ \left(\bar{*} \cup \bar{*'}\right) = 
 \phi_{\mathsf{with}}\left[\bar{*} \cup \bar{*'}\right]
 }
 {
 \infer[(4)]
 {\vdash c_{\mathsf{with}}\ ?\bar{f} = \phi_{\mathsf{with}}\left[?\bar{f}\right]}
 {
 \infer[(3)]
 {\vdash c_{\mathsf{with}} = (\lambda \bar{f}.\ \phi_{\mathsf{with}}\left[\bar{f}\right])}
 {
 \infer[(2)]
 {\vdash c_{\sigma}=\phi_{\mathsf{with}}\left[\bar{*} \cup \bar{*'}\right]}
 {
 \infer[(1)]
 {\vdash c_{\sigma}=\phi_{\sigma}\left[\bar{*}\right]}
 {\vdash c_{\tau}=\phi_{\tau}\left[\bar{*}\right]}
 }
 }
 }
 }
 }
 \]
 In step 1, the previously established 
 property $c_{\sigma} \leq c_{\tau}$ is used to create the 
 (extended variant of the) type substitution 
 map $\rho$ such that $\sigma = \rho \left( \tau \right)$ 
 (see \cite{kuncar_types_2015}) and perform the type
 substitution in $c_{\tau}=\phi_{\tau}\left[\bar{*}\right]$ 
 to obtain $c_{\sigma}=\phi_{\sigma}\left[\bar{*}\right]$; 
 in step 2, the collection of theorems $ud_{\mathsf{with}}$ is unfolded,
 using it as a term rewriting system, possibly introducing further uninterpreted
 constants $\bar{*'}$; in step 3, the term on the right-hand side of the
 theorem is processed by removing the sort constraints from all type
 variables that occur in it, replacing every uninterpreted constant-instance 
 (this excludes all built-in constants of Isabelle/HOL) that occurs in it by a 
 fresh term variable, and applying the abstraction until the resulting term 
 is closed: this term forms the right-hand side of a new definitional axiom 
 of a fresh constant $c_{\mathsf{with}}$ (if the conditions associated with 
 the definitional principles of Isabelle/HOL \cite{yang_comprehending_2017} 
 are satisfied); step 4 is justified by the beta-contraction; 
 step 5 is a substitution of the uninterpreted constants $\bar{*} \cup \bar{*'}$;
 step 6 follows trivially from the results of the application of steps 2 and 5.
 
 The implementation of the command @{command ud} closely follows the steps of 
 the algorithm outlined above. Thus, at the end of the successful
 execution, the command declares the constant $c_{\mathsf{with}}$ and stores the 
 constant-instance definition that is obtained at the end of step 3 of
 the algorithm UD; furthermore, the command adds the theorem that is 
 obtained after the execution of step 6 of the algorithm
 to $ud_{\mathsf{with}}$.
 
 Unlike the classical overloading elimination algorithm, 
 the algorithm employed in the implementation
 of the command @{command ud} is not recursive. Thus, the users are responsible 
 for maintaining an adequate collection of theorems $ud_{\mathsf{with}}$. 
 Nonetheless, in this case, the users can provide their own 
 unoverloaded constants $c_{\mathsf{with}}$ and the associated theorems 
 $c_{\sigma} = c_{\mathsf{with}}\ \bar{*}$ for any constant-instance $c_{\sigma}$. 
 From the perspective of the relativization algorithm associated with
 Types-To-Sets this can be useful because there is no 
 guarantee that the automatically synthesized constants $c_{\mathsf{with}}$ 
 will possess desirable parametricity characteristics
 (e.g., see \cite{kuncar_types_2015} and \cite{immler_smooth_2019}).
 Unfortunately, the implemented algorithm still suffers from the fundamental 
 limitation that was already outlined in \cite{kaufmann_mechanized_2010}, 
 \cite{blanchette_types_2016} and \cite{kuncar_types_2019}: 
 it does not offer a solution for handling the 
 constants whose types contain occurrences of the type constructors whose 
 type definitions contain occurrences of unresolvable overloading.
 \<close>
 
 
 
 subsection\<open>Syntax\<close>
 
 text\<open>
 This subsection presents the syntactic categories that are associated with the 
 command @{command ud}. It is important to note that the presentation is 
 only approximate.
 \<close>
 
 text\<open>
 
 \begin{matharray}{rcl}
   @{command_def "ud"} & : & \<open>theory \<rightarrow> theory\<close>\\
 \end{matharray}
 
   \<^medskip>
 
   \<^rail>\<open>@@{command ud} binding? const mixfix?\<close>
 
   \<^descr> \<^theory_text>\<open>ud\<close> (\<open>b\<close>) \<open>const\<close> (\<open>mixfix\<close>) provides access to the algorithm for
 the elimination of sort constraints and unoverloading of definitions
 that was described in subsection \ref{sec:ud_theory}.
 The optional binding \<open>b\<close> is used for the specification
 of the names of the entities added by the command to the theory and the 
 optional argument \<open>mixfix\<close> is used for the specification 
 of the concrete inner syntax for the constant in the usual manner
 (e.g., see \cite{wenzel_isabelle/isar_2019-1}). 
 If either \<open>b\<close> or \<open>mixfix\<close> are not specified by the user, then the command
 introduces sensible defaults. Following the specification of the 
 definition of the constant, an additional theorem that establishes
 the relationship between the newly introduced constant and the 
 constant provided by the user as an input is established and added 
 to the dynamic fact @{thm [source] ud_with}.
 \<close>
 
 
 
 subsection\<open>Examples\label{sec:ud_ex}\<close>
 
 text\<open>
 In this subsection, some of the capabilities of the UD are 
 demonstrated by example. The examples that are presented in this subsection are 
 expected to be sufficient for beginning an independent exploration of the 
 framework, but do not cover the entire spectrum of the functionality 
 and the problems that one may encounter while using it.
 \<close>
 
 
 subsubsection\<open>Type classes\<close>
 
+definition mono where
+  "mono f \<longleftrightarrow> (\<forall>x y. x \<le> y \<longrightarrow> f x \<le> f y)"
+
 text\<open>
 We begin the exploration of the capabilities of the framework by considering
 the constant @{const mono}.
-The constant @{const mono} is an overloaded constant that is defined 
-in the standard library of Isabelle/HOL \cite{noauthor_isabellehol_2020} as  
+It is defined as
 \begin{center}
 @{thm [names_short = true] mono_def[no_vars]} 
 \end{center}
 for any @{term [show_sorts] "f::'a::order\<Rightarrow>'b::order"}.
-Technically, there exist two distinct constants that are associated with
-the definition of the constant @{const mono} 
-(see, e.g., \cite{berardi_local_2009} 
-for further details): @{const order.mono} that is provided by the 
-Isabelle system automatically and the constant @{const mono} itself.
-The constants are unoverloaded successively using the command @{command ud}:
+The constants is unoverloaded using the command @{command ud}:
 \<close>
-ud \<open>order.mono\<close>
-ud mono' \<open>mono\<close>
+ud \<open>mono\<close>
 text\<open>
-The invocation of the commands above declares the constant @{const mono.with} 
+The invocation of the command above declares the constant @{const mono.with} 
 that is defined as
 \begin{center}
 @{thm mono.with_def[no_vars]}
 \end{center}
 and provides the theorem @{thm [source] mono.with} given by
 \begin{center}
-@{thm mono.with[no_vars]}
-\end{center}
-and the theorem @{thm [source] mono'.with} given by
-\begin{center}
-@{thm mono'.with[no_vars]}.
+@{thm mono.with[no_vars]}.
 \end{center}
 The theorems establish the relationship between the unoverloaded constant
 @{const mono.with} and the overloaded constant @{const mono}:
 both theorems are automatically added to the dynamic fact 
 @{thm [source] ud_with}.
 \<close>
 
 
 subsubsection\<open>Low-level overloading\<close>
 
 text\<open>
 The following example closely follows Example 5 in section 5.2. in 
 \cite{kaufmann_mechanized_2010}. 
 \<close>
 
 consts pls :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"
 
 overloading
 pls_nat \<equiv> "pls::nat \<Rightarrow> nat \<Rightarrow> nat"
 pls_times \<equiv> "pls::'a \<times> 'b \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'a \<times> 'b"
 begin
 definition pls_nat :: "nat \<Rightarrow> nat \<Rightarrow> nat" where "pls_nat a b = a + b"
 definition pls_times :: "'a \<times> 'b \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'a \<times> 'b" 
   where "pls_times \<equiv> \<lambda>x y. (pls (fst x) (fst y), pls (snd x) (snd y))"
 end
 
 ud pls_nat \<open>pls::nat \<Rightarrow> nat \<Rightarrow> nat\<close>
 ud pls_times \<open>pls::'a \<times> 'b \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'a \<times> 'b\<close>
 
 text\<open>
 As expected, two new unoverloaded constants are produced via
 the invocations of the command @{command ud} above. The first constant,
 \<^const>\<open>pls_nat.with\<close>, corresponds to \<open>pls::nat \<Rightarrow> nat \<Rightarrow> nat\<close> and is given by
 \begin{center}
 @{thm pls_nat.with_def[no_vars]},
 \end{center}
 the second constant, \<^const>\<open>pls_times.with\<close>, corresponds to
 \begin{center}
 \<open>pls::'a \<times> 'b \<Rightarrow> 'a \<times> 'b \<Rightarrow> 'a \<times> 'b\<close> 
 \end{center}
 and is given by 
 \begin{center}
 @{thm pls_times.with_def[no_vars]}.
 \end{center}
 The theorems that establish the relationship between the overloaded and
 the unoverloaded constants are given by 
 \begin{center}
 @{thm pls_nat.with} 
 \end{center}
 and 
 \begin{center}
 @{thm pls_times.with}.
 \end{center}
 The definitions of the constants \<^const>\<open>pls_nat.with\<close> and 
 \<^const>\<open>pls_times.with\<close> are consistent with the ones suggested in
 \cite{kaufmann_mechanized_2010}. Nonetheless, of course, it is
 important to keep in mind that the command @{command ud}
 has a more restricted scope of applicability than the
 algorithm suggested in \cite{kaufmann_mechanized_2010}.
 \<close>
 
 text\<open>\newpage\<close>
 
 end
diff --git a/thys/CryptHOL/Partial_Function_Set.thy b/thys/CryptHOL/Partial_Function_Set.thy
--- a/thys/CryptHOL/Partial_Function_Set.thy
+++ b/thys/CryptHOL/Partial_Function_Set.thy
@@ -1,196 +1,193 @@
 (* Title: Partial_Function_Set.thy
   Author: Andreas Lochbihler, ETH Zurich *)
 
 theory Partial_Function_Set imports Main begin
 
 subsection \<open>Setup for \<open>partial_function\<close> for sets\<close>
 
 lemma (in complete_lattice) lattice_partial_function_definition:
   "partial_function_definitions (\<le>) Sup"
 by(unfold_locales)(auto intro: Sup_upper Sup_least)
 
 interpretation set: partial_function_definitions "(\<subseteq>)" Union
 by(rule lattice_partial_function_definition)
 
 lemma fun_lub_Sup: "fun_lub Sup = (Sup :: _ \<Rightarrow> _ :: complete_lattice)"
 by(fastforce simp add: fun_lub_def fun_eq_iff Sup_fun_def intro: Sup_eqI SUP_upper SUP_least)
 
 lemma set_admissible: "set.admissible (\<lambda>f :: 'a \<Rightarrow> 'b set. \<forall>x y. y \<in> f x \<longrightarrow> P x y)"
 by(rule ccpo.admissibleI)(auto simp add: fun_lub_Sup)
 
 abbreviation "mono_set \<equiv> monotone (fun_ord (\<subseteq>)) (\<subseteq>)"
 
 lemma fixp_induct_set_scott:
   fixes F :: "'c \<Rightarrow> 'c"
   and U :: "'c \<Rightarrow> 'b \<Rightarrow> 'a set"
   and C :: "('b \<Rightarrow> 'a set) \<Rightarrow> 'c"
   and P :: "'b \<Rightarrow> 'a \<Rightarrow> bool"
   and x and y
   assumes mono: "\<And>x. mono_set (\<lambda>f. U (F (C f)) x)"
   and eq: "f \<equiv> C (ccpo.fixp (fun_lub Sup) (fun_ord (\<le>)) (\<lambda>f. U (F (C f))))"
   and inverse2: "\<And>f. U (C f) = f"
   and step: "\<And>f x y. \<lbrakk> \<And>x y. y \<in> U f x \<Longrightarrow> P x y; y \<in> U (F f) x \<rbrakk> \<Longrightarrow> P x y"
   and enforce_variable_ordering: "x = x"
   and elem: "y \<in> U f x"
   shows "P x y"
 using step elem set.fixp_induct_uc[of U F C, OF mono eq inverse2 set_admissible, of P]
 by blast
 
 
 lemma fixp_Sup_le:
   defines "le \<equiv> ((\<le>) :: _ :: complete_lattice \<Rightarrow> _)"
   shows "ccpo.fixp Sup le = ccpo_class.fixp"
 proof -
   have "class.ccpo Sup le (<)" unfolding le_def by unfold_locales
   thus ?thesis
     by(simp add: ccpo.fixp_def fixp_def ccpo.iterates_def iterates_def ccpo.iteratesp_def iteratesp_def fun_eq_iff le_def)
 qed
 
 lemma fun_ord_le: "fun_ord (\<le>) = (\<le>)"
 by(auto simp add: fun_ord_def fun_eq_iff le_fun_def)
 
-lemma monotone_le_le: "monotone (\<le>) (\<le>) = mono"
-by(simp add: monotone_def[abs_def] mono_def[abs_def])
-
 lemma fixp_induct_set:
   fixes F :: "'c \<Rightarrow> 'c"
   and U :: "'c \<Rightarrow> 'b \<Rightarrow> 'a set"
   and C :: "('b \<Rightarrow> 'a set) \<Rightarrow> 'c"
   and P :: "'b \<Rightarrow> 'a \<Rightarrow> bool"
   and x and y
   assumes mono: "\<And>x. mono_set (\<lambda>f. U (F (C f)) x)"
   and eq: "f \<equiv> C (ccpo.fixp (fun_lub Sup) (fun_ord (\<le>)) (\<lambda>f. U (F (C f))))"
   and inverse2: "\<And>f. U (C f) = f"
 
   and step: "\<And>f' x y. \<lbrakk> \<And>x. U f' x = U f' x; y \<in> U (F (C (inf (U f) (\<lambda>x. {y. P x y})))) x \<rbrakk> \<Longrightarrow> P x y"
     \<comment> \<open>partial\_function requires a quantifier over f', so let's have a fake one\<close>
   and elem: "y \<in> U f x"
   shows "P x y"
 proof -
   from mono
   have mono': "mono (\<lambda>f. U (F (C f)))"
-    by(simp add: fun_ord_le monotone_le_le mono_def le_fun_def)
+    by(simp add: fun_ord_le mono_def le_fun_def)
   hence eq': "f \<equiv> C (lfp (\<lambda>f. U (F (C f))))"
     using eq unfolding fun_ord_le fun_lub_Sup fixp_Sup_le by(simp add: lfp_eq_fixp)
 
   let ?f = "C (lfp (\<lambda>f. U (F (C f))))"
   have step': "\<And>x y. \<lbrakk> y \<in> U (F (C (inf (U ?f) (\<lambda>x. {y. P x y})))) x \<rbrakk> \<Longrightarrow> P x y"
     unfolding eq'[symmetric] by(rule step[OF refl])
 
   let ?P = "\<lambda>x. {y. P x y}"
   from mono' have "lfp (\<lambda>f. U (F (C f))) \<le> ?P"
     by(rule lfp_induct)(auto intro!: le_funI step' simp add: inverse2)
   with elem show ?thesis
     by(subst (asm) eq')(auto simp add: inverse2 le_fun_def)
 qed
 
 declaration \<open>Partial_Function.init "set" @{term set.fixp_fun}
   @{term set.mono_body} @{thm set.fixp_rule_uc} @{thm set.fixp_induct_uc}
   (SOME @{thm fixp_induct_set})\<close>
 
 lemma [partial_function_mono]:
   shows insert_mono: "mono_set A \<Longrightarrow> mono_set (\<lambda>f. insert x (A f))"
   and UNION_mono: "\<lbrakk>mono_set B; \<And>y. mono_set (\<lambda>f. C y f)\<rbrakk> \<Longrightarrow> mono_set (\<lambda>f. \<Union>y\<in>B f. C y f)"
   and set_bind_mono: "\<lbrakk>mono_set B; \<And>y. mono_set (\<lambda>f. C y f)\<rbrakk> \<Longrightarrow> mono_set (\<lambda>f. Set.bind (B f) (\<lambda>y. C y f))"
   and Un_mono: "\<lbrakk> mono_set A; mono_set B \<rbrakk> \<Longrightarrow> mono_set (\<lambda>f. A f \<union> B f)"
   and Int_mono: "\<lbrakk> mono_set A; mono_set B \<rbrakk> \<Longrightarrow> mono_set (\<lambda>f. A f \<inter> B f)"
   and Diff_mono1: "mono_set A \<Longrightarrow> mono_set (\<lambda>f. A f - X)"
   and image_mono: "mono_set A \<Longrightarrow> mono_set (\<lambda>f. g ` A f)"
   and vimage_mono: "mono_set A \<Longrightarrow> mono_set (\<lambda>f. g -` A f)"
 unfolding bind_UNION by(fast intro!: monotoneI dest: monotoneD)+
 
 partial_function (set) test :: "'a list \<Rightarrow> nat \<Rightarrow> bool \<Rightarrow> int set"
 where
   "test xs i j = insert 4 (test [] 0 j \<union> test [] 1 True \<inter> test [] 2 False - {5} \<union> uminus ` test [undefined] 0 True \<union> uminus -` test [] 1 False)"
 
 interpretation coset: partial_function_definitions "(\<supseteq>)" Inter
 by(rule complete_lattice.lattice_partial_function_definition[OF dual_complete_lattice])
 
 lemma fun_lub_Inf: "fun_lub Inf = (Inf :: _ \<Rightarrow> _ :: complete_lattice)"
 by(auto simp add: fun_lub_def fun_eq_iff Inf_fun_def intro: Inf_eqI INF_lower INF_greatest)
 
 lemma fun_ord_ge: "fun_ord (\<ge>) = (\<ge>)"
 by(auto simp add: fun_ord_def fun_eq_iff le_fun_def)
 
 lemma coset_admissible: "coset.admissible (\<lambda>f :: 'a \<Rightarrow> 'b set. \<forall>x y. P x y \<longrightarrow> y \<in> f x)"
 by(rule ccpo.admissibleI)(auto simp add: fun_lub_Inf)
 
 abbreviation "mono_coset \<equiv> monotone (fun_ord (\<supseteq>)) (\<supseteq>)"
 
 lemma gfp_eq_fixp:
   fixes f :: "'a :: complete_lattice \<Rightarrow> 'a"
   assumes f: "monotone (\<ge>) (\<ge>) f"
   shows "gfp f = ccpo.fixp Inf (\<ge>) f"
 proof (rule antisym)
   from f have f': "mono f" by(simp add: mono_def monotone_def)
 
   interpret ccpo Inf "(\<ge>)" "mk_less (\<ge>) :: 'a \<Rightarrow> _"
     by(rule ccpo)(rule complete_lattice.lattice_partial_function_definition[OF dual_complete_lattice])
   show "ccpo.fixp Inf (\<ge>) f \<le> gfp f"
     by(rule gfp_upperbound)(subst fixp_unfold[OF f], rule order_refl)
 
   show "gfp f \<le> ccpo.fixp Inf (\<ge>) f"
     by(rule fixp_lowerbound[OF f])(subst gfp_unfold[OF f'], rule order_refl)
 qed
 
 lemma fixp_coinduct_set:
   fixes F :: "'c \<Rightarrow> 'c"
   and U :: "'c \<Rightarrow> 'b \<Rightarrow> 'a set"
   and C :: "('b \<Rightarrow> 'a set) \<Rightarrow> 'c"
   and P :: "'b \<Rightarrow> 'a \<Rightarrow> bool"
   and x and y
   assumes mono: "\<And>x. mono_coset (\<lambda>f. U (F (C f)) x)"
   and eq: "f \<equiv> C (ccpo.fixp (fun_lub Inter) (fun_ord (\<ge>)) (\<lambda>f. U (F (C f))))"
   and inverse2: "\<And>f. U (C f) = f"
 
   and step: "\<And>f' x y. \<lbrakk> \<And>x. U f' x = U f' x; \<not> P x y \<rbrakk> \<Longrightarrow> y \<in> U (F (C (sup (\<lambda>x. {y. \<not> P x y}) (U f)))) x"
     \<comment> \<open>partial\_function requires a quantifier over f', so let's have a fake one\<close>
   and elem: "y \<notin> U f x"
   shows "P x y"
 using elem
 proof(rule contrapos_np)
   have mono': "monotone (\<ge>) (\<ge>) (\<lambda>f. U (F (C f)))"
     and mono'': "mono (\<lambda>f. U (F (C f)))"
     using mono by(simp_all add: monotone_def fun_ord_def le_fun_def mono_def)
   hence eq': "U f = gfp (\<lambda>f. U (F (C f)))"
     by(subst eq)(simp add: fun_lub_Inf fun_ord_ge gfp_eq_fixp inverse2)
 
   let ?P = "\<lambda>x. {y. \<not> P x y}"
   have "?P \<le> gfp (\<lambda>f. U (F (C f)))"
     using mono'' by(rule coinduct)(auto intro!:  le_funI dest: step[OF refl] simp add: eq')
   moreover
   assume "\<not> P x y"
   ultimately show "y \<in> U f x" by(auto simp add: le_fun_def eq')
 qed
 
 declaration \<open>Partial_Function.init "coset" @{term coset.fixp_fun}
   @{term coset.mono_body} @{thm coset.fixp_rule_uc} @{thm coset.fixp_induct_uc}
   (SOME @{thm fixp_coinduct_set})\<close>
 
 abbreviation "mono_set' \<equiv> monotone (fun_ord (\<supseteq>)) (\<supseteq>)"
 
 lemma [partial_function_mono]:
   shows insert_mono': "mono_set' A \<Longrightarrow> mono_set' (\<lambda>f. insert x (A f))"
   and UNION_mono': "\<lbrakk>mono_set' B; \<And>y. mono_set' (\<lambda>f. C y f)\<rbrakk> \<Longrightarrow> mono_set' (\<lambda>f. \<Union>y\<in>B f. C y f)"
   and set_bind_mono': "\<lbrakk>mono_set' B; \<And>y. mono_set' (\<lambda>f. C y f)\<rbrakk> \<Longrightarrow> mono_set' (\<lambda>f. Set.bind (B f) (\<lambda>y. C y f))"
   and Un_mono': "\<lbrakk> mono_set' A; mono_set' B \<rbrakk> \<Longrightarrow> mono_set' (\<lambda>f. A f \<union> B f)"
   and Int_mono': "\<lbrakk> mono_set' A; mono_set' B \<rbrakk> \<Longrightarrow> mono_set' (\<lambda>f. A f \<inter> B f)"
 unfolding bind_UNION by(fast intro!: monotoneI dest: monotoneD)+
 
 context begin
 private partial_function (coset) test2 :: "nat \<Rightarrow> nat set"
 where "test2 x = insert x (test2 (Suc x))"
 
 private lemma test2_coinduct:
   assumes "P x y"
   and *: "\<And>x y. P x y \<Longrightarrow> y = x \<or> (P (Suc x) y \<or> y \<in> test2 (Suc x))"
   shows "y \<in> test2 x"
 using \<open>P x y\<close>
 apply(rule contrapos_pp)
 apply(erule test2.raw_induct[rotated])
 apply(simp add: *)
 done
 
 end
 
 end
diff --git a/thys/Lp/Lp.thy b/thys/Lp/Lp.thy
--- a/thys/Lp/Lp.thy
+++ b/thys/Lp/Lp.thy
@@ -1,2246 +1,2248 @@
 (*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
     License: BSD
 *)
 
 theory Lp
 imports Functional_Spaces
 begin
 
 text \<open>The material in this file is essentially of analytic nature. However, one of the central
 proofs (the proof of Holder inequality below) uses a probability space, and Jensen's inequality
 there. Hence, we need to import \verb+Probability+. Moreover, we use several lemmas from
 \verb+SG_Library_Complement+.\<close>
 
 
 section \<open>Conjugate exponents\<close>
 
 text \<open>Two numbers $p$ and $q$ are \emph{conjugate} if $1/p + 1/q = 1$. This relation keeps
 appearing in the theory of $L^p$ spaces, as the dual of $L^p$ is $L^q$ where $q$ is the conjugate
 of $p$. This relation makes sense for real numbers, but also for ennreals
 (where the case $p=1$ and $q=\infty$ is most important). Unfortunately, manipulating the
 previous relation with ennreals is tedious as there is no good simproc involving addition and
 division there. To mitigate this difficulty, we prove once and for all most useful properties
 of such conjugates exponents in this paragraph.\<close>
 
 lemma Lp_cases_1_PInf:
   assumes "p \<ge> (1::ennreal)"
   obtains (gr) p2 where "p = ennreal p2" "p2 > 1" "p > 1"
     | (one) "p = 1"
     | (PInf) "p = \<infinity>"
 using assms by (metis (full_types) antisym_conv ennreal_cases ennreal_le_1 infinity_ennreal_def not_le)
 
 lemma Lp_cases:
   obtains (real_pos) p2 where "p = ennreal p2" "p2 > 0" "p > 0"
     | (zero) "p = 0"
     | (PInf) "p = \<infinity>"
 by (metis enn2real_positive_iff ennreal_enn2real_if infinity_ennreal_def not_gr_zero top.not_eq_extremum)
 
 definition
   "conjugate_exponent p = 1 + 1/(p-1)"
 
 lemma conjugate_exponent_real:
   assumes "p > (1::real)"
   shows "1/p + 1/(conjugate_exponent p) = 1"
         "conjugate_exponent p > 1"
         "conjugate_exponent(conjugate_exponent p) = p"
         "(p-1) * conjugate_exponent p = p"
         "p - p / conjugate_exponent p = 1"
 unfolding conjugate_exponent_def using assms by (auto simp add: algebra_simps divide_simps)
 
 lemma conjugate_exponent_real_iff:
   assumes "p > (1::real)"
   shows "q = conjugate_exponent p \<longleftrightarrow> (1/p + 1/q = 1)"
 unfolding conjugate_exponent_def using assms by (auto simp add: algebra_simps divide_simps)
 
 lemma conjugate_exponent_real_2 [simp]:
   "conjugate_exponent (2::real) = 2"
   unfolding conjugate_exponent_def by (auto simp add: algebra_simps divide_simps)
 
 lemma conjugate_exponent_realI:
   assumes "p > (0::real)" "q > 0" "1/p + 1/q = 1"
   shows "p > 1" "q = conjugate_exponent p" "q > 1" "p = conjugate_exponent q"
 unfolding conjugate_exponent_def using assms apply (auto simp add: algebra_simps divide_simps)
 apply (metis assms(3) divide_less_eq_1_pos less_add_same_cancel1 zero_less_divide_1_iff)
 using mult_less_cancel_left_pos by fastforce
 
 
 lemma conjugate_exponent_real_ennreal:
   assumes "p> (1::real)"
   shows "conjugate_exponent(ennreal p) = ennreal(conjugate_exponent p)"
 unfolding conjugate_exponent_def using assms
 by (auto, metis diff_gt_0_iff_gt divide_ennreal ennreal_1 ennreal_minus zero_le_one)
 
 lemma conjugate_exponent_ennreal_1_2_PInf [simp]:
   "conjugate_exponent (1::ennreal) = \<infinity>"
   "conjugate_exponent (\<infinity>::ennreal) = 1"
   "conjugate_exponent (\<top>::ennreal) = 1"
   "conjugate_exponent (2::ennreal) = 2"
 using conjugate_exponent_real_ennreal[of 2] by (auto simp add: conjugate_exponent_def)
 
 lemma conjugate_exponent_ennreal:
   assumes "p \<ge> (1::ennreal)"
   shows "1/p + 1/(conjugate_exponent p) = 1"
         "conjugate_exponent p \<ge> 1"
         "conjugate_exponent(conjugate_exponent p) = p"
 proof -
   have "(1/p + 1/(conjugate_exponent p) = 1) \<and> (conjugate_exponent p \<ge> 1) \<and> conjugate_exponent(conjugate_exponent p) = p"
   using \<open>p \<ge> 1\<close> proof (cases rule: Lp_cases_1_PInf)
     case (gr p2)
     then have *: "conjugate_exponent p = ennreal (conjugate_exponent p2)" using conjugate_exponent_real_ennreal[OF \<open>p2 > 1\<close>] by auto
     have a: "conjugate_exponent p \<ge> 1" using * conjugate_exponent_real[OF \<open>p2 > 1\<close>] by auto
     have b: "conjugate_exponent(conjugate_exponent p) = p"
       using conjugate_exponent_real(3)[OF \<open>p2 > 1\<close>] conjugate_exponent_real_ennreal[OF \<open>p2 > 1\<close>]
       conjugate_exponent_real_ennreal[OF conjugate_exponent_real(2)[OF \<open>p2 > 1\<close>]] unfolding * \<open>p = ennreal p2\<close> by auto
     have "1 / p + 1 / conjugate_exponent p = ennreal(1/p2 + 1/(conjugate_exponent p2))" unfolding * unfolding \<open>p = ennreal p2\<close>
       using conjugate_exponent_real(2)[OF \<open>p2 > 1\<close>] \<open>p2 > 1\<close>
       apply (subst ennreal_plus, auto) apply (subst divide_ennreal[symmetric], auto)
       using divide_ennreal_def inverse_ennreal inverse_eq_divide by auto
     then have c: "1 / p + 1 / conjugate_exponent p = 1" using conjugate_exponent_real[OF \<open>p2 > 1\<close>] by auto
     show ?thesis using a b c by simp
   qed (auto)
   then show "1/p + 1/(conjugate_exponent p) = 1"
             "conjugate_exponent p \<ge> 1"
             "conjugate_exponent(conjugate_exponent p) = p"
     by auto
 qed
 
 lemma conjugate_exponent_ennreal_iff:
   assumes "p \<ge> (1::ennreal)"
   shows "q = conjugate_exponent p \<longleftrightarrow> (1/p + 1/q = 1)"
 using conjugate_exponent_ennreal[OF assms]
 by (auto, metis ennreal_add_diff_cancel_left ennreal_add_eq_top ennreal_top_neq_one one_divide_one_divide_ennreal)
 
 lemma conjugate_exponent_ennrealI:
   assumes "1/p + 1/q = (1::ennreal)"
   shows "p \<ge> 1" "q \<ge> 1" "p = conjugate_exponent q" "q = conjugate_exponent p"
 proof -
   have "1/p \<le> 1" using assms using le_iff_add by fastforce
   then show "p \<ge> 1"
     by (metis assms divide_ennreal_def ennreal_add_eq_top ennreal_divide_self ennreal_divide_zero ennreal_le_epsilon ennreal_one_neq_top mult.left_neutral mult_left_le zero_le)
   then show "q = conjugate_exponent p" using conjugate_exponent_ennreal_iff assms by auto
   then show "q \<ge> 1" using conjugate_exponent_ennreal[OF \<open>p \<ge> 1\<close>] by auto
   show "p = conjugate_exponent q"
     using conjugate_exponent_ennreal_iff[OF \<open>q\<ge>1\<close>, of p] assms by (simp add: add.commute)
 qed
 
 
 section \<open>Convexity inequalities and integration\<close>
 
 text \<open>In this paragraph, we describe the basic inequalities relating the integral of a function
 and of its $p$-th power, for $p > 0$. These inequalities imply in particular that the $L^p$ norm
 satisfies the triangular inequality, a feature we will need when defining the $L^p$ spaces below.
 In particular, we prove the Hölder and Minkowski inequalities. The Hölder inequality,
 especially, is the basis of all further inequalities for $L^p$ spaces.
 \<close>
 
 lemma (in prob_space) bound_L1_Lp:
   assumes "p \<ge> (1::real)"
           "f \<in> borel_measurable M"
           "integrable M (\<lambda>x. \<bar>f x\<bar> powr p)"
   shows "integrable M f"
         "abs(\<integral>x. f x \<partial>M) powr p \<le> (\<integral>x. \<bar>f x\<bar> powr p \<partial>M)"
         "abs(\<integral>x. f x \<partial>M) \<le> (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
 proof -
   have *: "norm x \<le> 1 + (norm x) powr p" for x::real
     apply (cases "norm x \<le> 1")
     apply (meson le_add_same_cancel1 order.trans powr_ge_pzero)
     apply (metis add_le_same_cancel2 assms(1) less_le_trans linear not_less not_one_le_zero powr_le_cancel_iff powr_one_gt_zero_iff)
     done
   show *: "integrable M f"
     apply (rule Bochner_Integration.integrable_bound[of _ "\<lambda>x. 1 + \<bar>f x\<bar> powr p"], auto simp add: assms) using * by auto
   show "abs(\<integral>x. f x \<partial>M) powr p \<le> (\<integral>x. \<bar>f x\<bar> powr p \<partial>M)"
     by (rule jensens_inequality[OF * _ _ assms(3) convex_abs_powr[OF \<open>p \<ge> 1\<close>]], auto)
   then have "(abs(\<integral>x. f x \<partial>M) powr p) powr (1/p) \<le> (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
     using assms(1) powr_mono2 by auto
   then show "abs(\<integral>x. f x \<partial>M) \<le> (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
     using \<open>p \<ge> 1\<close> by (auto simp add: powr_powr)
 qed
 
 
 theorem Holder_inequality:
   assumes "p > (0::real)" "q > 0" "1/p + 1/q = 1"
       and [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
           "integrable M (\<lambda>x. \<bar>f x\<bar> powr p)"
           "integrable M (\<lambda>x. \<bar>g x\<bar> powr q)"
   shows "integrable M (\<lambda>x. f x * g x)"
         "(\<integral>x. \<bar>f x * g x\<bar> \<partial>M) \<le> (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) * (\<integral>x. \<bar>g x\<bar> powr q \<partial>M) powr (1/q)"
         "abs(\<integral>x. f x * g x \<partial>M) \<le> (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) * (\<integral>x. \<bar>g x\<bar> powr q \<partial>M) powr (1/q)"
 proof -
   have "p > 1" using conjugate_exponent_realI(1)[OF \<open>p>0\<close> \<open>q>0\<close> \<open>1/p+1/q=1\<close>].
 
   have *: "x * y \<le> x powr p + y powr q" if "x \<ge> 0" "y \<ge> 0" for x y
   proof -
     have "x * y = (x powr p) powr (1/p) * (y powr q) powr (1/q)"
       using \<open>p > 0\<close> \<open>q > 0\<close> powr_powr that(1) that(2) by auto
     also have "... \<le> (max (x powr p) (y powr q)) powr (1/p) * (max (x powr p) (y powr q)) powr (1/q)"
       apply (rule mult_mono, auto) using assms(1) assms(2) powr_mono2 by auto
     also have "... = max (x powr p) (y powr q)"
       by (metis max_def mult.right_neutral powr_add powr_powr assms(3))
     also have "... \<le> x powr p + y powr q"
       by auto
     finally show ?thesis by simp
   qed
   show [simp]: "integrable M (\<lambda>x. f x * g x)"
     apply (rule Bochner_Integration.integrable_bound[of _ "\<lambda>x. \<bar>f x\<bar> powr p + \<bar>g x\<bar> powr q"], auto)
     by (rule Bochner_Integration.integrable_add, auto simp add: assms * abs_mult)
 
   text \<open>The proof of the main inequality is done by applying the inequality
         $(\int |h| d\mu \leq \int |h|^p d\mu)^{1/p}$ to the right function $h$ in the right
         probability space. One should take $h = f \cdot |g|^{1-q}$, and $d\mu = |g|^q dM / I$,
         where $I = \int |g|^q$. This readily gives the result.\<close>
 
   show *: "(\<integral>x. \<bar>f x * g x\<bar> \<partial>M) \<le> (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) * (\<integral>x. \<bar>g x\<bar> powr q \<partial>M) powr (1/q)"
   proof (cases "(\<integral>x. \<bar>g x\<bar> powr q \<partial>M) = 0")
     case True
     then have "AE x in M. \<bar>g x\<bar> powr q = 0"
       by (subst integral_nonneg_eq_0_iff_AE[symmetric], auto simp add: assms)
     then have *: "AE x in M. f x * g x = 0"
       using \<open>q > 0\<close> by auto
     have "(\<integral>x. \<bar>f x * g x\<bar> \<partial>M) = (\<integral>x. 0 \<partial>M)"
       apply (rule integral_cong_AE) using * by auto
     then show ?thesis by auto
   next
     case False
     moreover have "(\<integral>x. \<bar>g x\<bar> powr q \<partial>M) \<ge> (\<integral>x. 0 \<partial>M)" by (rule integral_mono, auto simp add: assms)
     ultimately have *: "(\<integral>x. \<bar>g x\<bar> powr q \<partial>M) > 0" by (simp add: le_less)
     define I where "I = (\<integral>x. \<bar>g x\<bar> powr q \<partial>M)"
     have [simp]: "I > 0" unfolding I_def using * by auto
     define M2 where "M2 = density M (\<lambda>x. \<bar>g x\<bar> powr q / I)"
     interpret prob_space M2
       apply (standard, unfold M2_def, auto, subst emeasure_density, auto)
       apply (subst divide_ennreal[symmetric], auto, subst nn_integral_divide, auto)
       apply (subst nn_integral_eq_integral, auto simp add: assms, unfold I_def)
       using * by auto
 
     have [simp]: "p \<ge> 1" "p \<ge> 0" using \<open>p > 1\<close> by auto
     have A: "q + (1 - q) * p = 0" using assms by (auto simp add: divide_simps algebra_simps)
     have B: "1 - 1/p = 1/q" using \<open>1/p + 1/q = 1\<close> by auto
     define f2 where "f2 = (\<lambda>x. f x * indicator {y\<in> space M. g y \<noteq> 0} x)"
     have [measurable]: "f2 \<in> borel_measurable M" unfolding f2_def by auto
     define h where "h = (\<lambda>x. \<bar>f2 x\<bar> * \<bar>g x\<bar> powr (1-q))"
     have [measurable]: "h \<in> borel_measurable M" unfolding h_def by auto
     have [measurable]: "h \<in> borel_measurable M2" unfolding M2_def by auto
 
     have Eq: "(\<bar>g x\<bar> powr q / I) *\<^sub>R \<bar>h x\<bar> powr p = \<bar>f2 x\<bar> powr p / I" for x
       apply (insert \<open>I>0\<close>, auto simp add: divide_simps, unfold h_def)
       apply (auto simp add: divide_nonneg_pos divide_simps powr_mult powr_powr powr_add[symmetric] A)
       unfolding f2_def by auto
     have "integrable M2 (\<lambda>x. \<bar>h x\<bar> powr p)"
       unfolding M2_def apply (subst integrable_density, simp, simp, simp add: divide_simps)
       apply (subst Eq, rule integrable_divide, rule Bochner_Integration.integrable_bound[of _ "\<lambda>x. \<bar>f x\<bar> powr p"], unfold f2_def)
       by (unfold indicator_def, auto simp add: \<open>integrable M (\<lambda>x. \<bar>f x\<bar> powr p)\<close>)
     then have "integrable M2 (\<lambda>x. \<bar>h x\<bar>)"
       by (metis bound_L1_Lp(1) \<open>random_variable borel h\<close> \<open>p > 1\<close> integrable_abs le_less)
 
     have "(\<integral>x. \<bar>h x\<bar> powr p \<partial>M2) = (\<integral>x. (\<bar>g x\<bar> powr q / I) *\<^sub>R (\<bar>h x\<bar> powr p) \<partial>M)"
       unfolding M2_def by (rule integral_density[of "\<lambda>x. \<bar>h x\<bar> powr p" M "\<lambda>x. \<bar>g x\<bar> powr q / I"], auto simp add: divide_simps)
     also have "... = (\<integral>x. \<bar>f2 x\<bar> powr p / I \<partial>M)"
       apply (rule Bochner_Integration.integral_cong) using Eq by auto
     also have "... \<le> (\<integral>x. \<bar>f x\<bar> powr p / I \<partial>M)"
       apply (rule integral_mono', rule integrable_divide[OF \<open>integrable M (\<lambda>x. \<bar>f x\<bar> powr p)\<close>])
       unfolding f2_def indicator_def using \<open>I > 0\<close> by (auto simp add: divide_simps)
     finally have C: "(\<integral>x. \<bar>h x\<bar> powr p \<partial>M2) \<le> (\<integral>x. \<bar>f x\<bar> powr p / I \<partial>M)" by simp
 
     have "(\<integral>x. \<bar>f x * g x\<bar> \<partial>M) / I = (\<integral>x. \<bar>f x * g x\<bar> / I \<partial>M)"
       by auto
     also have "... = (\<integral>x. \<bar>f2 x * g x\<bar> / I \<partial>M)"
       by (auto simp add: divide_simps, rule Bochner_Integration.integral_cong, unfold f2_def indicator_def, auto)
     also have "... = (\<integral>x. \<bar>h x\<bar> \<partial>M2)"
       apply (unfold M2_def, subst integral_density, simp, simp, simp add: divide_simps)
       by (rule Bochner_Integration.integral_cong, unfold h_def, auto simp add: divide_simps algebra_simps powr_add[symmetric] abs_mult)
     also have "... \<le> abs (\<integral>x. \<bar>h x\<bar> \<partial>M2)"
       by auto
     also have "... \<le> (\<integral>x. abs(\<bar>h x\<bar>) powr p \<partial>M2) powr (1/p)"
       apply (rule bound_L1_Lp(3)[of p "\<lambda>x. \<bar>h x\<bar>"])
       by (auto simp add: \<open>integrable M2 (\<lambda>x. \<bar>h x\<bar> powr p)\<close>)
     also have "... \<le> (\<integral>x. \<bar>f x\<bar> powr p / I \<partial>M) powr (1/p)"
       by (rule powr_mono2, insert C, auto)
     also have "... \<le> ((\<integral>x. \<bar>f x\<bar> powr p \<partial>M) / I) powr (1/p)"
       apply (rule powr_mono2, auto simp add: divide_simps) using \<open>p \<ge> 0\<close> by auto
     also have "... = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) * I powr(-1/p)"
       by (auto simp add: less_imp_le powr_divide powr_minus_divide)
     finally have "(\<integral>x. \<bar>f x * g x\<bar> \<partial>M) \<le> (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) * I * I powr(-1/p)"
       by (auto simp add: divide_simps algebra_simps)
     also have "... = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) * I powr (1-1/p)"
       by (auto simp add: powr_mult_base less_imp_le)
     also have "... = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) * (\<integral>x. \<bar>g x\<bar> powr q \<partial>M) powr (1/q)"
       unfolding I_def using B by auto
     finally show ?thesis
       by simp
   qed
   have "abs(\<integral>x. f x * g x \<partial>M) \<le> (\<integral>x. \<bar>f x * g x\<bar> \<partial>M)" by auto
   then show "abs(\<integral>x. f x * g x \<partial>M) \<le> (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) * (\<integral>x. \<bar>g x\<bar> powr q \<partial>M) powr (1/q)"
     using * by linarith
 qed
 
 theorem Minkowski_inequality:
   assumes "p \<ge> (1::real)"
       and [measurable, simp]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
           "integrable M (\<lambda>x. \<bar>f x\<bar> powr p)"
           "integrable M (\<lambda>x. \<bar>g x\<bar> powr p)"
   shows "integrable M (\<lambda>x. \<bar>f x + g x\<bar> powr p)"
         "(\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/p)
           \<le> (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) + (\<integral>x. \<bar>g x\<bar> powr p \<partial>M) powr (1/p)"
 proof -
   have *: "\<bar>x + y\<bar> powr p \<le> 2 powr p * (\<bar>x\<bar> powr p + \<bar>y\<bar> powr p)" for x y::real
   proof -
     have "\<bar>x + y\<bar> \<le> \<bar>x\<bar> + \<bar>y\<bar>" by auto
     also have "... \<le> (max \<bar>x\<bar> \<bar>y\<bar>) + max \<bar>x\<bar> \<bar>y\<bar>" by auto
     also have "... = 2 * max \<bar>x\<bar> \<bar>y\<bar>" by auto
     finally have "\<bar>x + y\<bar> powr p \<le> (2 * max \<bar>x\<bar> \<bar>y\<bar>) powr p"
       using powr_mono2 \<open>p \<ge> 1\<close> by auto
     also have "... = 2 powr p * (max \<bar>x\<bar> \<bar>y\<bar>) powr p"
       using powr_mult by auto
     also have "... \<le> 2 powr p * (\<bar>x\<bar> powr p + \<bar>y\<bar> powr p)"
       unfolding max_def by auto
     finally show ?thesis by simp
   qed
   show [simp]: "integrable M (\<lambda>x. \<bar>f x + g x\<bar> powr p)"
     by (rule Bochner_Integration.integrable_bound[of _ "\<lambda>x. 2 powr p * (\<bar>f x\<bar> powr p + \<bar>g x\<bar> powr p)"], auto simp add: *)
 
   show "(\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/p) \<le> (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) + (\<integral>x. \<bar>g x\<bar> powr p \<partial>M) powr (1/p)"
   proof (cases "p=1")
     case True
     then show ?thesis
       apply (auto, subst Bochner_Integration.integral_add[symmetric], insert assms(4) assms(5), simp, simp)
       by (rule integral_mono', auto)
   next
     case False
     then have [simp]: "p > 1" "p \<ge> 1" "p > 0" "p \<noteq> 0" using assms(1) by auto
     define q where "q = conjugate_exponent p"
     have [simp]: "q > 1" "q > 0" "1/p + 1/q = 1" "(p-1) * q = p"
       unfolding q_def using conjugate_exponent_real[OF \<open>p>1\<close>] by auto
     then have [simp]: "(z powr (p-1)) powr q = z powr p" for z
       by (simp add: powr_powr)
     have "(\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) = (\<integral>x. \<bar>f x + g x\<bar> * \<bar>f x + g x\<bar> powr (p-1) \<partial>M)"
       by (subst powr_mult_base, auto)
     also have "... \<le> (\<integral>x. \<bar>f x\<bar> * \<bar>f x + g x\<bar> powr (p-1) + \<bar>g x\<bar> * \<bar>f x + g x\<bar> powr (p-1) \<partial>M)"
       apply (rule integral_mono', rule Bochner_Integration.integrable_add)
       apply (rule Holder_inequality(1)[of p q], auto)
       apply (rule Holder_inequality(1)[of p q], auto)
       by (metis abs_ge_zero abs_triangle_ineq comm_semiring_class.distrib le_less mult_mono' powr_ge_pzero)
     also have "... = (\<integral>x. \<bar>f x\<bar> * \<bar>f x + g x\<bar> powr (p-1) \<partial>M) + (\<integral>x. \<bar>g x\<bar> * \<bar>f x + g x\<bar> powr (p-1) \<partial>M)"
       apply (rule Bochner_Integration.integral_add) by (rule Holder_inequality(1)[of p q], auto)+
     also have "... \<le> abs (\<integral>x. \<bar>f x\<bar> * \<bar>f x + g x\<bar> powr (p-1) \<partial>M) + abs (\<integral>x. \<bar>g x\<bar> * \<bar>f x + g x\<bar> powr (p-1) \<partial>M)"
       by auto
     also have "... \<le> (\<integral>x. abs(\<bar>f x\<bar>) powr p \<partial>M) powr (1/p) * (\<integral>x. abs(\<bar>f x + g x\<bar> powr (p-1)) powr q \<partial>M) powr (1/q)
                       + (\<integral>x. abs(\<bar>g x\<bar>) powr p \<partial>M) powr (1/p) * (\<integral>x. abs(\<bar>f x + g x\<bar> powr (p-1)) powr q \<partial>M) powr (1/q)"
       apply (rule add_mono)
       apply (rule Holder_inequality(3)[of p q], simp, simp, simp, simp, simp, simp, simp)
       apply (rule Holder_inequality(3)[of p q], simp, simp, simp, simp, simp, simp, simp)
       done
     also have "... = (\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/q) *
             ((\<integral>x. abs(\<bar>f x\<bar>) powr p \<partial>M) powr (1/p) + (\<integral>x. abs(\<bar>g x\<bar>) powr p \<partial>M) powr (1/p))"
       by (auto simp add: algebra_simps)
     finally have *: "(\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) \<le> (\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/q) *
         ((\<integral>x. abs(\<bar>f x\<bar>) powr p \<partial>M) powr (1/p) + (\<integral>x. abs(\<bar>g x\<bar>) powr p \<partial>M) powr (1/p))"
       by simp
     show ?thesis
     proof (cases "(\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) = 0")
       case True
       then show ?thesis by auto
     next
       case False
       then have **: "(\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/q) > 0"
         by auto
       have "(\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/q) * (\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/p)
               = (\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M)"
         by (auto simp add: powr_add[symmetric] add.commute)
       then have "(\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/q) * (\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/p) \<le>
               (\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/q) *
               ((\<integral>x. abs(\<bar>f x\<bar>) powr p \<partial>M) powr (1/p) + (\<integral>x. abs(\<bar>g x\<bar>) powr p \<partial>M) powr (1/p))"
         using * by auto
       then show ?thesis using ** by auto
     qed
   qed
 qed
 
 text \<open>When $p<1$, the function $x \mapsto |x|^p$ is not convex any more. Hence, the $L^p$ ``norm''
 is not a norm any more, but a quasinorm. This is proved using a different convexity argument, as
 follows.\<close>
 
 theorem Minkowski_inequality_le_1:
   assumes "p > (0::real)" "p \<le> 1"
       and [measurable, simp]: "f \<in> borel_measurable M" "g \<in> borel_measurable M"
           "integrable M (\<lambda>x. \<bar>f x\<bar> powr p)"
           "integrable M (\<lambda>x. \<bar>g x\<bar> powr p)"
   shows "integrable M (\<lambda>x. \<bar>f x + g x\<bar> powr p)"
         "(\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/p)
           \<le> 2 powr (1/p-1) * (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) + 2 powr (1/p-1) * (\<integral>x. \<bar>g x\<bar> powr p \<partial>M) powr (1/p)"
 proof -
   have *: "\<bar>a + b\<bar> powr p \<le> \<bar>a\<bar> powr p + \<bar>b\<bar> powr p" for a b
     using x_plus_y_p_le_xp_plus_yp[OF \<open>p > 0\<close> \<open>p \<le> 1\<close>, of "\<bar>a\<bar>" "\<bar>b\<bar>"]
     by (auto, meson abs_ge_zero abs_triangle_ineq assms(1) le_less order.trans powr_mono2)
   show "integrable M (\<lambda>x. \<bar>f x + g x\<bar> powr p)"
     by (rule Bochner_Integration.integrable_bound[of _ "\<lambda>x. \<bar>f x\<bar> powr p + \<bar>g x\<bar> powr p"], auto simp add: *)
 
   have "(\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/p) \<le> (\<integral>x. \<bar>f x\<bar> powr p + \<bar>g x\<bar> powr p \<partial>M) powr (1/p)"
     by (rule powr_mono2, simp add: \<open>p > 0\<close> less_imp_le, simp, rule integral_mono', auto simp add: *)
   also have "... = 2 powr (1/p) * (((\<integral>x. \<bar>f x\<bar> powr p \<partial>M) + (\<integral>x. \<bar>g x\<bar> powr p \<partial>M)) / 2) powr (1/p)"
     by (auto simp add: powr_mult[symmetric] add_divide_distrib)
   also have "... \<le> 2 powr (1/p) * (((\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) + (\<integral>x. \<bar>g x\<bar> powr p \<partial>M) powr (1/p)) / 2)"
     apply (rule mult_mono, simp, rule convex_on_mean_ineq[OF convex_powr[of "1/p"]])
     using \<open>p \<le> 1\<close> \<open>p > 0\<close> by auto
   also have "... = 2 powr (1/p - 1) * ((\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) + (\<integral>x. \<bar>g x\<bar> powr p \<partial>M) powr (1/p))"
     by (simp add: powr_diff)
   finally show "(\<integral>x. \<bar>f x + g x\<bar> powr p \<partial>M) powr (1/p)
       \<le> 2 powr (1/p-1) * (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) + 2 powr (1/p-1) * (\<integral>x. \<bar>g x\<bar> powr p \<partial>M) powr (1/p)"
     by (auto simp add: algebra_simps)
 qed
 
 
 section \<open>$L^p$ spaces\<close>
 
 text \<open>We define $L^p$ spaces by giving their defining quasinorm. It is a norm for $p\in [1, \infty]$,
 and a quasinorm for $p \in (0,1)$. The construction of a quasinorm from a formula only makes sense
 if this formula is indeed a quasinorm, i.e., it is homogeneous and satisfies the triangular
 inequality with the given multiplicative defect. Thus, we have to show that this is indeed
 the case to be able to use the definition.\<close>
 
 definition Lp_space::"ennreal \<Rightarrow> 'a measure \<Rightarrow> ('a \<Rightarrow> real) quasinorm"
   where "Lp_space p M = (
     if p = 0 then quasinorm_of (1, (\<lambda>f. if (f \<in> borel_measurable M) then 0 else \<infinity>))
     else if p < \<infinity> then quasinorm_of (
         if p < 1 then 2 powr (1/enn2real p - 1) else 1,
         (\<lambda>f. if (f \<in> borel_measurable M \<and> integrable M (\<lambda>x. \<bar>f x\<bar> powr (enn2real p)))
               then (\<integral>x. \<bar>f x\<bar> powr (enn2real p) \<partial>M) powr (1/(enn2real p))
               else (\<infinity>::ennreal)))
     else quasinorm_of (1, (\<lambda>f. if f \<in> borel_measurable M then esssup M (\<lambda>x. ereal \<bar>f x\<bar>) else (\<infinity>::ennreal))))"
 
 abbreviation "\<LL> == Lp_space"
 
 
 subsection \<open>$L^\infty$\<close>
 
 text \<open>Let us check that, for $L^\infty$, the above definition makes sense.\<close>
 
 lemma L_infinity:
   "eNorm (\<LL> \<infinity> M) f = (if f \<in> borel_measurable M then esssup M (\<lambda>x. ereal \<bar>f x\<bar>) else (\<infinity>::ennreal))"
   "defect (\<LL> \<infinity> M) = 1"
 proof -
   have T: "esssup M (\<lambda>x. ereal \<bar>(f + g) x\<bar>) \<le> e2ennreal (esssup M (\<lambda>x. ereal \<bar>f x\<bar>)) + esssup M (\<lambda>x. ereal \<bar>g x\<bar>)"
     if [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M" for f g
   proof (cases "emeasure M (space M) = 0")
     case True
     then have "e2ennreal (esssup M (\<lambda>x. ereal \<bar>(f + g) x\<bar>)) = 0"
       using esssup_zero_space[OF True] by (simp add: e2ennreal_neg)
     then show ?thesis by simp
   next
     case False
     have *: "esssup M (\<lambda>x. \<bar>h x\<bar>) \<ge> 0" for h::"'a \<Rightarrow> real"
     proof -
       have "esssup M (\<lambda>x. 0) \<le> esssup M (\<lambda>x. \<bar>h x\<bar>)" by (rule esssup_mono, auto)
       then show ?thesis using esssup_const[OF False, of "0::ereal"] by simp
     qed
     have "esssup M (\<lambda>x. ereal \<bar>(f + g) x\<bar>) \<le> esssup M (\<lambda>x. ereal \<bar>f x\<bar> + ereal \<bar>g x\<bar>)"
       by (rule esssup_mono, auto simp add: plus_fun_def)
     also have "... \<le> esssup M (\<lambda>x. ereal \<bar>f x\<bar>) + esssup M (\<lambda>x. ereal \<bar>g x\<bar>)"
       by (rule esssup_add)
     finally show ?thesis
       using * by (simp add: e2ennreal_mono eq_onp_def plus_ennreal.abs_eq)
   qed
 
   have H: "esssup M (\<lambda>x. ereal \<bar>(c *\<^sub>R f) x\<bar>) \<le> ennreal \<bar>c\<bar> * esssup M (\<lambda>x. ereal \<bar>f x\<bar>)" if "c \<noteq> 0" for f c
   proof -
     have "abs c > 0" "ereal \<bar>c\<bar> \<ge> 0" using that by auto
     have *: "esssup M (\<lambda>x. abs(c *\<^sub>R f x)) = abs c * esssup M (\<lambda>x. \<bar>f x\<bar>)"
       apply (subst esssup_cmult[OF \<open>abs c > 0\<close>, of M "\<lambda>x. ereal \<bar>f x\<bar>", symmetric])
       using times_ereal.simps(1) by (auto simp add: abs_mult)
     show ?thesis
       unfolding e2ennreal_mult[OF \<open>ereal \<bar>c\<bar> \<ge> 0\<close>] * scaleR_fun_def
       by simp
   qed
 
   have "esssup M (\<lambda>x. ereal 0) \<le> 0" using esssup_I by auto
   then have Z: "e2ennreal (esssup M (\<lambda>x. ereal 0)) = 0" using e2ennreal_neg by auto
 
   have *: "quasinorm_on (borel_measurable M) 1 (\<lambda>(f::'a\<Rightarrow>real). e2ennreal(esssup M (\<lambda>x. ereal \<bar>f x\<bar>)))"
     apply (rule quasinorm_onI) using T H Z by auto
   have **: "quasinorm_on UNIV 1 (\<lambda>(f::'a\<Rightarrow>real). if f \<in> borel_measurable M then e2ennreal(esssup M (\<lambda>x. ereal \<bar>f x\<bar>)) else \<infinity>)"
     by (rule extend_quasinorm[OF *])
   show "eNorm (\<LL> \<infinity> M) f = (if f \<in> borel_measurable M then e2ennreal(esssup M (\<lambda>x. \<bar>f x\<bar>)) else \<infinity>)"
        "defect (\<LL> \<infinity> M) = 1"
     unfolding Lp_space_def using quasinorm_of[OF **] by auto
 qed
 
 lemma L_infinity_space:
   "space\<^sub>N (\<LL> \<infinity> M) = {f \<in> borel_measurable M. \<exists>C. AE x in M. \<bar>f x\<bar> \<le> C}"
 proof (auto simp del: infinity_ennreal_def)
   fix f assume H: "f \<in> space\<^sub>N (\<LL> \<infinity> M)"
   then show "f \<in> borel_measurable M"
     unfolding space\<^sub>N_def using L_infinity(1)[of M] top.not_eq_extremum by fastforce
   then have *: "esssup M (\<lambda>x. \<bar>f x\<bar>) < \<infinity>"
     using H unfolding space\<^sub>N_def L_infinity(1)[of M] by (auto simp add: e2ennreal_infty)
   define C where "C = real_of_ereal(esssup M (\<lambda>x. \<bar>f x\<bar>))"
   have "AE x in M. ereal \<bar>f x\<bar> \<le> ereal C"
   proof (cases "emeasure M (space M) = 0")
     case True
     then show ?thesis using emeasure_0_AE by simp
   next
     case False
     then have "esssup M (\<lambda>x. \<bar>f x\<bar>) \<ge> 0"
       using esssup_mono[of "\<lambda>x. 0" M "(\<lambda>x. \<bar>f x\<bar>)"] esssup_const[OF False, of "0::ereal"] by auto
     then have "esssup M (\<lambda>x. \<bar>f x\<bar>) = ereal C" unfolding C_def using * ereal_real by auto
     then show ?thesis using esssup_AE[of "(\<lambda>x. ereal \<bar>f x\<bar>)" M] by simp
   qed
   then have "AE x in M. \<bar>f x\<bar> \<le> C" by auto
   then show "\<exists>C. AE x in M. \<bar>f x\<bar> \<le> C" by blast
 next
   fix f::"'a \<Rightarrow> real" and C::real
   assume H: "f \<in> borel_measurable M" "AE x in M. \<bar>f x\<bar> \<le> C"
   then have "esssup M (\<lambda>x. \<bar>f x\<bar>) \<le> C" using esssup_I by auto
   then have "eNorm (\<LL> \<infinity> M) f \<le> C" unfolding L_infinity(1) using H(1)
     by auto (metis e2ennreal_ereal e2ennreal_mono)
   then show "f \<in> space\<^sub>N (\<LL> \<infinity> M)"
     using spaceN_iff le_less_trans by fastforce
 qed
 
 lemma L_infinity_zero_space:
   "zero_space\<^sub>N (\<LL> \<infinity> M) = {f \<in> borel_measurable M. AE x in M. f x = 0}"
 proof (auto simp del: infinity_ennreal_def)
   fix f assume H: "f \<in> zero_space\<^sub>N (\<LL> \<infinity> M)"
   then show "f \<in> borel_measurable M"
     unfolding zero_space\<^sub>N_def using L_infinity(1)[of M] top.not_eq_extremum by fastforce
   then have *: "e2ennreal(esssup M (\<lambda>x. \<bar>f x\<bar>)) = 0"
     using H unfolding zero_space\<^sub>N_def using L_infinity(1)[of M] e2ennreal_infty by auto
   then have "esssup M (\<lambda>x. \<bar>f x\<bar>) \<le> 0"
     by (metis e2ennreal_infty e2ennreal_mult ennreal_top_neq_zero ereal_mult_infty leI linear mult_zero_left)
   then have "f x = 0" if "ereal \<bar>f x\<bar> \<le> esssup M (\<lambda>x. \<bar>f x\<bar>)" for x
     using that order.trans by fastforce
   then show "AE x in M. f x = 0" using esssup_AE[of "\<lambda>x. ereal \<bar>f x\<bar>" M] by auto
 next
   fix f::"'a \<Rightarrow> real"
   assume H: "f \<in> borel_measurable M" "AE x in M. f x = 0"
   then have "esssup M (\<lambda>x. \<bar>f x\<bar>) \<le> 0" using esssup_I by auto
   then have "eNorm (\<LL> \<infinity> M) f = 0" unfolding L_infinity(1) using H(1)
     by (simp add: e2ennreal_neg)
   then show "f \<in> zero_space\<^sub>N (\<LL> \<infinity> M)"
     using zero_spaceN_iff by auto
 qed
 
 lemma L_infinity_AE_ebound:
   "AE x in M. ennreal \<bar>f x\<bar> \<le> eNorm (\<LL> \<infinity> M) f"
 proof (cases "f \<in> borel_measurable M")
   case False
   then have "eNorm (\<LL> \<infinity> M) f = \<infinity>"
     unfolding L_infinity(1) by auto
   then show ?thesis by simp
 next
   case True
   then have "ennreal \<bar>f x\<bar> \<le> eNorm (\<LL> \<infinity> M) f" if "\<bar>f x\<bar> \<le> esssup M (\<lambda>x. \<bar>f x\<bar>)" for x
     unfolding L_infinity(1) using that e2ennreal_mono
     by fastforce
   then show ?thesis using esssup_AE[of "\<lambda>x. ereal \<bar>f x\<bar>"] by force
 qed
 
 lemma L_infinity_AE_bound:
   assumes "f \<in> space\<^sub>N (\<LL> \<infinity> M)"
   shows "AE x in M. \<bar>f x\<bar> \<le> Norm (\<LL> \<infinity> M) f"
 using L_infinity_AE_ebound[of f M] unfolding eNorm_Norm[OF assms] by (simp)
 
 text \<open>In the next lemma, the assumption $C \geq 0$ that might seem useless is in fact
 necessary for the second statement when the space has zero measure. Indeed, any function is
 then almost surely bounded by any constant!\<close>
 
 lemma L_infinity_I:
   assumes "f \<in> borel_measurable M"
           "AE x in M. \<bar>f x\<bar> \<le> C"
           "C \<ge> 0"
   shows "f \<in> space\<^sub>N (\<LL> \<infinity> M)"
         "Norm (\<LL> \<infinity> M) f \<le> C"
 proof -
   show "f \<in> space\<^sub>N (\<LL> \<infinity> M)"
     using L_infinity_space assms(1) assms(2) by force
   have "esssup M (\<lambda>x. \<bar>f x\<bar>) \<le> C" using assms(1) assms(2) esssup_I by auto
   then have "eNorm (\<LL> \<infinity> M) f \<le> ereal C"
     unfolding L_infinity(1) using assms(1) e2ennreal_mono by force
   then have "ennreal (Norm (\<LL> \<infinity> M) f) \<le> ennreal C"
     using eNorm_Norm[OF \<open>f \<in> space\<^sub>N (\<LL> \<infinity> M)\<close>] assms(3) by auto
   then show "Norm (\<LL> \<infinity> M) f \<le> C" using assms(3) by auto
 qed
 
 lemma L_infinity_I':
   assumes [measurable]: "f \<in> borel_measurable M"
       and "AE x in M. ennreal \<bar>f x\<bar> \<le> C"
   shows "eNorm (\<LL> \<infinity> M) f \<le> C"
 proof -
   have "esssup M (\<lambda>x. \<bar>f x\<bar>) \<le> enn2ereal C"
     apply (rule esssup_I, auto) using assms(2) less_eq_ennreal.rep_eq by auto
   then show ?thesis unfolding L_infinity using assms apply auto
     using e2ennreal_mono by fastforce
 qed
 
 lemma L_infinity_pos_measure:
   assumes [measurable]: "f \<in> borel_measurable M"
       and "eNorm (\<LL> \<infinity> M) f > (C::real)"
   shows "emeasure M {x \<in> space M. \<bar>f x\<bar> > C} > 0"
 proof -
   have *: "esssup M (\<lambda>x. ereal(\<bar>f x\<bar>)) > ereal C" using \<open>eNorm (\<LL> \<infinity> M) f > C\<close> unfolding L_infinity
   proof (auto)
     assume a1: "ennreal C < e2ennreal (esssup M (\<lambda>x. ereal \<bar>f x\<bar>))"
     have "\<not> e2ennreal (esssup M (\<lambda>a. ereal \<bar>f a\<bar>)) \<le> e2ennreal (ereal C)" if "\<not> C < 0"
       using a1 that by (metis (no_types) e2ennreal_enn2ereal enn2ereal_ennreal leD leI)
     then have "e2ennreal (esssup M (\<lambda>a. ereal \<bar>f a\<bar>)) \<le> e2ennreal (ereal C) \<longrightarrow> (\<exists>e\<le>esssup M (\<lambda>a. ereal \<bar>f a\<bar>). ereal C < e)"
       using a1 e2ennreal_neg by fastforce
     then show ?thesis
       by (meson e2ennreal_mono leI less_le_trans)
   qed
   have "emeasure M {x \<in> space M. ereal(\<bar>f x\<bar>) > C} > 0"
     by (rule esssup_pos_measure[OF _ *], auto)
   then show ?thesis by auto
 qed
 
 lemma L_infinity_tendsto_AE:
   assumes "tendsto_in\<^sub>N (\<LL> \<infinity> M) f g"
           "\<And>n. f n \<in> space\<^sub>N (\<LL> \<infinity> M)"
           "g \<in> space\<^sub>N (\<LL> \<infinity> M)"
   shows "AE x in M. (\<lambda>n. f n x) \<longlonglongrightarrow> g x"
 proof -
   have *: "AE x in M. \<bar>(f n - g) x\<bar> \<le> Norm (\<LL> \<infinity> M) (f n - g)" for n
     apply (rule L_infinity_AE_bound) using assms spaceN_diff by blast
   have "AE x in M. \<forall>n. \<bar>(f n - g) x\<bar> \<le> Norm (\<LL> \<infinity> M) (f n - g)"
     apply (subst AE_all_countable) using * by auto
   moreover have "(\<lambda>n. f n x) \<longlonglongrightarrow> g x" if "\<forall>n. \<bar>(f n - g) x\<bar> \<le> Norm (\<LL> \<infinity> M) (f n - g)" for x
   proof -
     have "(\<lambda>n. \<bar>(f n - g) x\<bar>) \<longlonglongrightarrow> 0"
       apply (rule tendsto_sandwich[of "\<lambda>n. 0" _ _ "\<lambda>n. Norm (\<LL> \<infinity> M) (f n - g)"])
       using that \<open>tendsto_in\<^sub>N (\<LL> \<infinity> M) f g\<close> unfolding tendsto_in\<^sub>N_def by auto
     then have "(\<lambda>n. \<bar>f n x - g x\<bar>) \<longlonglongrightarrow> 0" by auto
     then show ?thesis
       by (simp add: \<open>(\<lambda>n. \<bar>f n x - g x\<bar>) \<longlonglongrightarrow> 0\<close> LIM_zero_cancel tendsto_rabs_zero_cancel)
   qed
   ultimately show ?thesis by auto
 qed
 
 text \<open>As an illustration of the mechanism of spaces inclusion, let us show that bounded
 continuous functions belong to $L^\infty$.\<close>
 
 lemma bcontfun_subset_L_infinity:
   assumes "sets M = sets borel"
   shows "space\<^sub>N bcontfun\<^sub>N \<subseteq> space\<^sub>N (\<LL> \<infinity> M)"
         "\<And>f. f \<in> space\<^sub>N bcontfun\<^sub>N \<Longrightarrow> Norm (\<LL> \<infinity> M) f \<le> Norm bcontfun\<^sub>N f"
         "\<And>f. eNorm (\<LL> \<infinity> M) f \<le> eNorm bcontfun\<^sub>N f"
         "bcontfun\<^sub>N \<subseteq>\<^sub>N \<LL> \<infinity> M"
 proof -
   have *: "f \<in> space\<^sub>N (\<LL> \<infinity> M) \<and> Norm (\<LL> \<infinity> M) f \<le> Norm bcontfun\<^sub>N f" if "f \<in> space\<^sub>N bcontfun\<^sub>N" for f
   proof -
     have H: "continuous_on UNIV f" "\<And>x. abs(f x) \<le> Norm bcontfun\<^sub>N f"
       using bcontfun\<^sub>ND[OF \<open>f \<in> space\<^sub>N bcontfun\<^sub>N\<close>] by auto
     then have "f \<in> borel_measurable borel" using borel_measurable_continuous_onI by simp
     then have "f \<in> borel_measurable M" using assms by auto
     have *: "AE x in M. \<bar>f x\<bar> \<le> Norm bcontfun\<^sub>N f" using H(2) by auto
     show ?thesis using L_infinity_I[OF \<open>f \<in> borel_measurable M\<close> * Norm_nonneg] by auto
   qed
   show "space\<^sub>N bcontfun\<^sub>N \<subseteq> space\<^sub>N (\<LL> \<infinity> M)"
        "\<And>f. f \<in> space\<^sub>N bcontfun\<^sub>N \<Longrightarrow> Norm (\<LL> \<infinity> M) f \<le> Norm bcontfun\<^sub>N f"
     using * by auto
   show **: "bcontfun\<^sub>N \<subseteq>\<^sub>N \<LL> \<infinity> M"
     apply (rule quasinorm_subsetI'[of _ _ 1]) using * by auto
   have "eNorm (\<LL> \<infinity> M) f \<le> ennreal 1 * eNorm bcontfun\<^sub>N f" for f
     apply (rule quasinorm_subset_Norm_eNorm) using * ** by auto
   then show "eNorm (\<LL> \<infinity> M) f \<le> eNorm bcontfun\<^sub>N f" for f by simp
 qed
 
 
 subsection \<open>$L^p$ for $0 < p < \infty$\<close>
 
 lemma Lp:
   assumes "p \<ge> (1::real)"
   shows "eNorm (\<LL> p M) f = (if (f \<in> borel_measurable M \<and> integrable M (\<lambda>x. \<bar>f x\<bar> powr p))
                             then (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)
                             else (\<infinity>::ennreal))"
         "defect (\<LL> p M) = 1"
 proof -
   define F where "F = {f \<in> borel_measurable M. integrable M (\<lambda>x. \<bar>f x\<bar> powr p)}"
   have *: "quasinorm_on F 1 (\<lambda>(f::'a\<Rightarrow>real). (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p))"
   proof (rule quasinorm_onI)
     fix f g assume "f \<in> F" "g \<in> F"
     then show "f + g \<in> F"
       unfolding F_def plus_fun_def apply (auto) by (rule Minkowski_inequality(1), auto simp add: \<open>p \<ge> 1\<close>)
     show "ennreal ((\<integral>x. \<bar>(f + g) x\<bar> powr p \<partial>M) powr (1/p))
           \<le> ennreal 1 * (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) + ennreal 1 * (\<integral>x. \<bar>g x\<bar> powr p \<partial>M) powr (1/p)"
       apply (auto, subst ennreal_plus[symmetric], simp, simp, rule ennreal_leI)
       unfolding plus_fun_def apply (rule Minkowski_inequality(2)[of p f M g], auto simp add: \<open>p \<ge> 1\<close>)
       using \<open>f \<in> F\<close> \<open>g \<in> F\<close> unfolding F_def by auto
   next
     fix f and c::real assume "f \<in> F"
     show "c *\<^sub>R f \<in> F" using \<open>f \<in> F\<close> unfolding scaleR_fun_def F_def by (auto simp add: abs_mult powr_mult)
     show "(\<integral>x. \<bar>(c *\<^sub>R f) x\<bar> powr p \<partial>M) powr (1/p) \<le> ennreal(abs(c)) * (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
       apply (rule eq_refl, subst ennreal_mult[symmetric], simp, simp, rule ennreal_cong)
       apply (unfold scaleR_fun_def, simp add: abs_mult powr_mult powr_powr) using \<open>p \<ge> 1\<close> by auto
   next
     show "0 \<in> F" unfolding zero_fun_def F_def by auto
   qed (auto)
 
   have "p \<ge> 0" using \<open>p \<ge> 1\<close> by auto
   have **: "\<LL> p M = quasinorm_of (1,
               (\<lambda>f. if (f \<in> borel_measurable M \<and> integrable M (\<lambda>x. \<bar>f x\<bar> powr p))
               then (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)
               else (\<infinity>::ennreal)))"
     unfolding Lp_space_def using enn2real_ennreal[OF \<open>p \<ge> 0\<close>] \<open>p \<ge> 1\<close> apply auto
     using enn2real_ennreal[OF \<open>p \<ge> 0\<close>] by presburger
   show "eNorm (\<LL> p M) f = (if (f \<in> borel_measurable M \<and> integrable M (\<lambda>x. \<bar>f x\<bar> powr p))
                             then (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)
                             else (\<infinity>::ennreal))"
       "defect (\<LL> p M) = 1"
     unfolding ** using quasinorm_of[OF extend_quasinorm[OF *]] unfolding F_def by auto
 qed
 
 lemma Lp_le_1:
   assumes "p > 0" "p \<le> (1::real)"
   shows "eNorm (\<LL> p M) f = (if (f \<in> borel_measurable M \<and> integrable M (\<lambda>x. \<bar>f x\<bar> powr p))
                             then (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)
                             else (\<infinity>::ennreal))"
         "defect (\<LL> p M) = 2 powr (1/p - 1)"
 proof -
   define F where "F = {f \<in> borel_measurable M. integrable M (\<lambda>x. \<bar>f x\<bar> powr p)}"
   have *: "quasinorm_on F (2 powr (1/p-1)) (\<lambda>(f::'a\<Rightarrow>real). (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p))"
   proof (rule quasinorm_onI)
     fix f g assume "f \<in> F" "g \<in> F"
     then show "f + g \<in> F"
       unfolding F_def plus_fun_def apply (auto) by (rule Minkowski_inequality_le_1(1), auto simp add: \<open>p > 0\<close> \<open>p \<le> 1\<close>)
     show "ennreal ((\<integral>x. \<bar>(f + g) x\<bar> powr p \<partial>M) powr (1/p))
           \<le> ennreal (2 powr (1/p-1)) * (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) + ennreal (2 powr (1/p-1)) * (\<integral>x. \<bar>g x\<bar> powr p \<partial>M) powr (1/p)"
       apply (subst ennreal_mult[symmetric], auto)+
       apply (subst ennreal_plus[symmetric], simp, simp)
       apply (rule ennreal_leI)
       unfolding plus_fun_def apply (rule Minkowski_inequality_le_1(2)[of p f M g], auto simp add: \<open>p > 0\<close> \<open>p \<le> 1\<close>)
       using \<open>f \<in> F\<close> \<open>g \<in> F\<close> unfolding F_def by auto
   next
     fix f and c::real assume "f \<in> F"
     show "c *\<^sub>R f \<in> F" using \<open>f \<in> F\<close> unfolding scaleR_fun_def F_def by (auto simp add: abs_mult powr_mult)
     show "(\<integral>x. \<bar>(c *\<^sub>R f) x\<bar> powr p \<partial>M) powr (1/p) \<le> ennreal(abs(c)) * (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
       apply (rule eq_refl, subst ennreal_mult[symmetric], simp, simp, rule ennreal_cong)
       apply (unfold scaleR_fun_def, simp add: abs_mult powr_mult powr_powr) using \<open>p > 0\<close> by auto
   next
     show "0 \<in> F" unfolding zero_fun_def F_def by auto
     show "1 \<le> 2 powr (1 / p - 1)" using \<open>p > 0\<close> \<open>p \<le> 1\<close> by (auto simp add: ge_one_powr_ge_zero)
   qed (auto)
 
   have "p \<ge> 0" using \<open>p > 0\<close> by auto
   have **: "\<LL> p M = quasinorm_of (2 powr (1/p-1),
               (\<lambda>f. if (f \<in> borel_measurable M \<and> integrable M (\<lambda>x. \<bar>f x\<bar> powr p))
               then (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)
               else (\<infinity>::ennreal)))"
     unfolding Lp_space_def using \<open>p > 0\<close> \<open>p \<le> 1\<close> using enn2real_ennreal[OF \<open>p \<ge> 0\<close>] apply auto
     by (insert enn2real_ennreal[OF \<open>p \<ge> 0\<close>], presburger)+
   show "eNorm (\<LL> p M) f = (if (f \<in> borel_measurable M \<and> integrable M (\<lambda>x. \<bar>f x\<bar> powr p))
                             then (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)
                             else (\<infinity>::ennreal))"
       "defect (\<LL> p M) = 2 powr (1/p-1)"
     unfolding ** using quasinorm_of[OF extend_quasinorm[OF *]] unfolding F_def by auto
 qed
 
 lemma Lp_space:
   assumes "p > (0::real)"
   shows "space\<^sub>N (\<LL> p M) = {f \<in> borel_measurable M. integrable M (\<lambda>x. \<bar>f x\<bar> powr p)}"
 apply (auto simp add: spaceN_iff)
 using Lp(1) Lp_le_1(1) \<open>p > 0\<close> apply (metis infinity_ennreal_def less_le not_less)
 using Lp(1) Lp_le_1(1) \<open>p > 0\<close> apply (metis infinity_ennreal_def less_le not_less)
 using Lp(1) Lp_le_1(1) \<open>p > 0\<close> by (metis ennreal_neq_top linear top.not_eq_extremum)
 
 lemma Lp_I:
   assumes "p > (0::real)"
           "f \<in> borel_measurable M" "integrable M (\<lambda>x. \<bar>f x\<bar> powr p)"
   shows "f \<in> space\<^sub>N (\<LL> p M)"
         "Norm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
         "eNorm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
 proof -
   have *: "eNorm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
     by (cases "p \<le> 1", insert assms, auto simp add: Lp_le_1(1) Lp(1))
   then show **: "f \<in> space\<^sub>N (\<LL> p M)" unfolding space\<^sub>N_def by auto
   show "Norm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)" using * unfolding Norm_def by auto
   then show "eNorm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)" using eNorm_Norm[OF **] by auto
 qed
 
 lemma Lp_D:
   assumes "p>0" "f \<in> space\<^sub>N (\<LL> p M)"
   shows "f \<in> borel_measurable M"
         "integrable M (\<lambda>x. \<bar>f x\<bar> powr p)"
         "Norm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
         "eNorm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
 proof -
   show *: "f \<in> borel_measurable M"
           "integrable M (\<lambda>x. \<bar>f x\<bar> powr p)"
     using Lp_space[OF \<open>p > 0\<close>] assms(2) by auto
   then show "Norm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
             "eNorm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
     using Lp_I[OF \<open>p > 0\<close>] by auto
 qed
 
 lemma Lp_Norm:
   assumes "p > (0::real)"
           "f \<in> borel_measurable M"
   shows "Norm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
         "(Norm (\<LL> p M) f) powr p = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M)"
 proof -
   show *: "Norm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
   proof (cases "integrable M (\<lambda>x. \<bar>f x\<bar> powr p)")
     case True
     then show ?thesis using Lp_I[OF assms True] by auto
   next
     case False
     then have "f \<notin> space\<^sub>N (\<LL> p M)" using Lp_space[OF \<open>p > 0\<close>, of M] by auto
     then have *: "Norm (\<LL> p M) f = 0" using eNorm_Norm' by auto
     have "(\<integral>x. \<bar>f x\<bar> powr p \<partial>M) = 0" using False by (simp add: not_integrable_integral_eq)
     then have "(\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p) = 0" by auto
     then show ?thesis using * by auto
   qed
   then show "(Norm (\<LL> p M) f) powr p = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M)"
     unfolding * using powr_powr \<open>p > 0\<close> by auto
 qed
 
 lemma Lp_zero_space:
   assumes "p > (0::real)"
   shows "zero_space\<^sub>N (\<LL> p M) = {f \<in> borel_measurable M. AE x in M. f x = 0}"
 proof (auto)
   fix f assume H: "f \<in> zero_space\<^sub>N (\<LL> p M)"
   then have *: "f \<in> {f \<in> borel_measurable M. integrable M (\<lambda>x. \<bar>f x\<bar> powr p)}"
     using Lp_space[OF assms] zero_spaceN_subset_spaceN by auto
   then show "f \<in> borel_measurable M" by auto
   have "eNorm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
     by (cases "p \<le> 1", insert * \<open>p > 0\<close>, auto simp add: Lp_le_1(1) Lp(1))
   then have "(\<integral>x. \<bar>f x\<bar> powr p \<partial>M) = 0" using H unfolding zero_space\<^sub>N_def by auto
   then have "AE x in M. \<bar>f x\<bar> powr p = 0"
     by (subst integral_nonneg_eq_0_iff_AE[symmetric], insert *, auto)
   then show "AE x in M. f x = 0" by auto
 next
   fix f::"'a \<Rightarrow> real"
   assume H [measurable]: "f \<in> borel_measurable M" "AE x in M. f x = 0"
   then have *: "AE x in M. \<bar>f x\<bar> powr p = 0" by auto
   have "integrable M (\<lambda>x. \<bar>f x\<bar> powr p)"
     using integrable_cong_AE[OF _ _ *] by auto
   have **: "(\<integral>x. \<bar>f x\<bar> powr p \<partial>M) = 0"
     using integral_cong_AE[OF _ _ *] by auto
   have "eNorm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> powr p \<partial>M) powr (1/p)"
     by (cases "p \<le> 1", insert H(1) \<open>integrable M (\<lambda>x. \<bar>f x\<bar> powr p)\<close> \<open>p > 0\<close>, auto simp add: Lp_le_1(1) Lp(1))
   then have "eNorm (\<LL> p M) f = 0" using ** by simp
   then show "f \<in> zero_space\<^sub>N (\<LL> p M)"
     using zero_spaceN_iff by auto
 qed
 
 lemma Lp_tendsto_AE_subseq:
   assumes "p>(0::real)"
           "tendsto_in\<^sub>N (\<LL> p M) f g"
           "\<And>n. f n \<in> space\<^sub>N (\<LL> p M)"
           "g \<in> space\<^sub>N (\<LL> p M)"
   shows "\<exists>r. strict_mono r \<and> (AE x in M. (\<lambda>n. f (r n) x) \<longlonglongrightarrow> g x)"
 proof -
   have "f n - g \<in> space\<^sub>N (\<LL> p M)" for n
     using spaceN_diff[OF \<open>\<And>n. f n \<in> space\<^sub>N (\<LL> p M)\<close> \<open>g \<in> space\<^sub>N (\<LL> p M)\<close>] by simp
   have int: "integrable M (\<lambda>x. \<bar>f n x - g x\<bar> powr p)" for n
     using Lp_D(2)[OF \<open>p > 0\<close> \<open>f n - g \<in> space\<^sub>N (\<LL> p M)\<close>] by auto
 
   have "(\<lambda>n. Norm (\<LL> p M) (f n - g)) \<longlonglongrightarrow> 0"
     using \<open>tendsto_in\<^sub>N (\<LL> p M) f g\<close> unfolding tendsto_in\<^sub>N_def by auto
   then have *: "(\<lambda>n. (\<integral>x. \<bar>f n x - g x\<bar> powr p \<partial>M) powr (1/p)) \<longlonglongrightarrow> 0"
     using Lp_D(3)[OF \<open>p > 0\<close> \<open>\<And>n. f n - g \<in> space\<^sub>N (\<LL> p M)\<close>] by auto
   have "(\<lambda>n. ((\<integral>x. \<bar>f n x - g x\<bar> powr p \<partial>M) powr (1/p)) powr p) \<longlonglongrightarrow> 0"
     apply (rule tendsto_zero_powrI[of _ _ _ p]) using \<open>p > 0\<close> * by auto
   then have **: "(\<lambda>n. (\<integral>x. \<bar>f n x - g x\<bar> powr p \<partial>M)) \<longlonglongrightarrow> 0"
     using powr_powr \<open>p > 0\<close> by auto
   have "\<exists>r. strict_mono r \<and> (AE x in M. (\<lambda>n. \<bar>f (r n) x - g x\<bar> powr p) \<longlonglongrightarrow> 0)"
     apply (rule tendsto_L1_AE_subseq) using int ** by auto
   then obtain r where "strict_mono r" "AE x in M. (\<lambda>n. \<bar>f (r n) x - g x\<bar> powr p) \<longlonglongrightarrow> 0"
     by blast
   moreover have "(\<lambda>n. f (r n) x) \<longlonglongrightarrow> g x" if "(\<lambda>n. \<bar>f (r n) x - g x\<bar> powr p) \<longlonglongrightarrow> 0" for x
   proof -
     have "(\<lambda>n. (\<bar>f (r n) x - g x\<bar> powr p) powr (1/p)) \<longlonglongrightarrow> 0"
       apply (rule tendsto_zero_powrI[of _ _ _ "1/p"]) using \<open>p > 0\<close> that by auto
     then have "(\<lambda>n. \<bar>f (r n) x - g x\<bar>) \<longlonglongrightarrow> 0"
       using powr_powr \<open>p > 0\<close> by auto
     show ?thesis
       by (simp add: \<open>(\<lambda>n. \<bar>f (r n) x - g x\<bar>) \<longlonglongrightarrow> 0\<close> Limits.LIM_zero_cancel tendsto_rabs_zero_cancel)
   qed
   ultimately have "AE x in M. (\<lambda>n. f (r n) x) \<longlonglongrightarrow> g x" by auto
   then show ?thesis using \<open>strict_mono r\<close> by auto
 qed
 
 subsection \<open>Specialization to $L^1$\<close>
 
 lemma L1_space:
   "space\<^sub>N (\<LL> 1 M) = {f. integrable M f}"
 unfolding one_ereal_def using Lp_space[of 1 M] integrable_abs_iff by auto
 
 lemma L1_I:
   assumes "integrable M f"
   shows "f \<in> space\<^sub>N (\<LL> 1 M)"
         "Norm (\<LL> 1 M) f = (\<integral>x. \<bar>f x\<bar> \<partial>M)"
         "eNorm (\<LL> 1 M) f = (\<integral>x. \<bar>f x\<bar> \<partial>M)"
 unfolding one_ereal_def using Lp_I[of 1, OF _ borel_measurable_integrable[OF assms]] assms powr_to_1 by auto
 
 lemma L1_D:
   assumes "f \<in> space\<^sub>N (\<LL> 1 M)"
   shows "f \<in> borel_measurable M"
         "integrable M f"
         "Norm (\<LL> 1 M) f = (\<integral>x. \<bar>f x\<bar> \<partial>M)"
         "eNorm (\<LL> 1 M) f = (\<integral>x. \<bar>f x\<bar> \<partial>M)"
   using assms by (auto simp add: L1_space L1_I)
 
 lemma L1_int_ineq:
   "abs(\<integral>x. f x \<partial>M) \<le> Norm (\<LL> 1 M) f"
 proof (cases "integrable M f")
   case True
   then show ?thesis using L1_I(2)[OF True] by auto
 next
   case False
   then have "(\<integral>x. f x \<partial>M) = 0" by (simp add: not_integrable_integral_eq)
   then show ?thesis using Norm_nonneg by auto
 qed
 
 text \<open>In $L^1$, one can give a direct formula for the eNorm of a measurable function, using a
 nonnegative integral. The same formula holds in $L^p$ for $p > 0$, with additional powers $p$ and
 $1/p$, but one can not write it down since \verb+powr+ is not defined on \verb+ennreal+.\<close>
 
 lemma L1_Norm:
   assumes [measurable]: "f \<in> borel_measurable M"
   shows "Norm (\<LL> 1 M) f = (\<integral>x. \<bar>f x\<bar> \<partial>M)"
         "eNorm (\<LL> 1 M) f = (\<integral>\<^sup>+x. \<bar>f x\<bar> \<partial>M)"
 proof -
   show *: "Norm (\<LL> 1 M) f = (\<integral>x. \<bar>f x\<bar> \<partial>M)"
     using Lp_Norm[of 1, OF _ assms] unfolding one_ereal_def by auto
   show "eNorm (\<LL> 1 M) f = (\<integral>\<^sup>+x. \<bar>f x\<bar> \<partial>M)"
   proof (cases "integrable M f")
     case True
     then have "f \<in> space\<^sub>N (\<LL> 1 M)" using L1_space by auto
     then have "eNorm (\<LL> 1 M) f = ennreal (Norm (\<LL> 1 M) f)"
       using eNorm_Norm by auto
     then show ?thesis
       by (metis (mono_tags) * AE_I2 True abs_ge_zero integrable_abs nn_integral_eq_integral)
   next
     case False
     then have "eNorm (\<LL> 1 M) f = \<infinity>" using L1_space space\<^sub>N_def
       by (metis ennreal_add_eq_top infinity_ennreal_def le_iff_add le_less_linear mem_Collect_eq)
     moreover have "(\<integral>\<^sup>+x. \<bar>f x\<bar> \<partial>M) = \<infinity>"
       apply (rule nn_integral_nonneg_infinite) using False by (auto simp add: integrable_abs_iff)
     ultimately show ?thesis by simp
   qed
 qed
 
 lemma L1_indicator:
   assumes [measurable]: "A \<in> sets M"
   shows "eNorm (\<LL> 1 M) (indicator A) = emeasure M A"
 by (subst L1_Norm, auto, metis assms ennreal_indicator nn_integral_cong nn_integral_indicator)
 
 lemma L1_indicator':
   assumes [measurable]: "A \<in> sets M"
       and "emeasure M A \<noteq> \<infinity>"
   shows "indicator A \<in> space\<^sub>N (\<LL> 1 M)"
         "Norm (\<LL> 1 M) (indicator A) = measure M A"
 unfolding space\<^sub>N_def Norm_def using L1_indicator[OF \<open>A \<in> sets M\<close>] \<open>emeasure M A \<noteq> \<infinity>\<close>
 by (auto simp add: top.not_eq_extremum Sigma_Algebra.measure_def)
 
 
 subsection \<open>$L^0$\<close>
 
 text \<open>We have defined $L^p$ for all exponents $p$, although it does not really make sense for $p = 0$.
 We have chosen a definition in this case (the space of all measurable functions) so that many
 statements are true for all exponents. In this paragraph, we show the consistency of this definition.\<close>
 
 lemma L_zero:
   "eNorm (\<LL> 0 M) f = (if f \<in> borel_measurable M then 0 else \<infinity>)"
   "defect (\<LL> 0 M) = 1"
 proof -
   have *: "quasinorm_on UNIV 1 (\<lambda>(f::'a\<Rightarrow>real). (if f \<in> borel_measurable M then 0 else \<infinity>))"
     by (rule extend_quasinorm, rule quasinorm_onI, auto)
   show "eNorm (\<LL> 0 M) f = (if f \<in> borel_measurable M then 0 else \<infinity>)"
        "defect (\<LL> 0 M) = 1"
     using quasinorm_of[OF *] unfolding Lp_space_def by auto
 qed
 
 lemma L_zero_space [simp]:
   "space\<^sub>N (\<LL> 0 M) = borel_measurable M"
   "zero_space\<^sub>N (\<LL> 0 M) = borel_measurable M"
 apply (auto simp add: spaceN_iff zero_spaceN_iff L_zero(1))
 using top.not_eq_extremum by force+
 
 subsection \<open>Basic results on $L^p$ for general $p$\<close>
 
 lemma Lp_measurable_subset:
   "space\<^sub>N (\<LL> p M) \<subseteq> borel_measurable M"
 proof (cases rule: Lp_cases[of p])
   case zero
   then show ?thesis using L_zero_space by auto
 next
   case (real_pos p2)
   then show ?thesis using Lp_space[OF \<open>p2 > 0\<close>] by auto
 next
   case PInf
   then show ?thesis using L_infinity_space by auto
 qed
 
 lemma Lp_measurable:
   assumes "f \<in> space\<^sub>N (\<LL> p M)"
   shows "f \<in> borel_measurable M"
 using assms Lp_measurable_subset by auto
 
 lemma Lp_infinity_zero_space:
   assumes "p > (0::ennreal)"
   shows "zero_space\<^sub>N (\<LL> p M) = {f \<in> borel_measurable M. AE x in M. f x = 0}"
 proof (cases rule: Lp_cases[of p])
   case PInf
   then show ?thesis using L_infinity_zero_space by auto
 next
   case (real_pos p2)
   then show ?thesis using Lp_zero_space[OF \<open>p2 > 0\<close>] unfolding \<open>p = ennreal p2\<close> by auto
 next
   case zero
   then have False using assms by auto
   then show ?thesis by simp
 qed
 
 lemma (in prob_space) Lp_subset_Lq:
   assumes "p \<le> q"
   shows "\<And>f. eNorm (\<LL> p M) f \<le> eNorm (\<LL> q M) f"
         "\<LL> q M \<subseteq>\<^sub>N \<LL> p M"
         "space\<^sub>N (\<LL> q M) \<subseteq> space\<^sub>N (\<LL> p M)"
         "\<And>f. f \<in> space\<^sub>N (\<LL> q M) \<Longrightarrow> Norm (\<LL> p M) f \<le> Norm (\<LL> q M) f"
 proof -
   show "eNorm (\<LL> p M) f \<le> eNorm (\<LL> q M) f" for f
   proof (cases "eNorm (\<LL> q M) f < \<infinity>")
     case True
     then have "f \<in> space\<^sub>N (\<LL> q M)" using spaceN_iff by auto
     then have f_meas [measurable]: "f \<in> borel_measurable M" using Lp_measurable by auto
     consider "p = 0" | "p = q" | "p > 0 \<and> p < \<infinity> \<and> q = \<infinity>" | "p > 0 \<and> p < q \<and> q < \<infinity>"
       using \<open>p \<le> q\<close> apply (simp add: top.not_eq_extremum)
       using not_less_iff_gr_or_eq order.order_iff_strict by fastforce
     then show ?thesis
     proof (cases)
       case 1
       then show ?thesis by (simp add: L_zero(1))
     next
       case 2
       then show ?thesis by auto
     next
       case 3
       then have "q = \<infinity>" by simp
       obtain p2 where "p = ennreal p2" "p2 > 0"
         using 3 enn2real_positive_iff[of p] by (cases p) auto
       have *: "AE x in M. \<bar>f x\<bar> \<le> Norm (\<LL> \<infinity> M) f"
         using L_infinity_AE_bound \<open>f \<in> space\<^sub>N (\<LL> q M)\<close> \<open>q = \<infinity>\<close> by auto
       have **: "integrable M (\<lambda>x. \<bar>f x\<bar> powr p2)"
         apply (rule Bochner_Integration.integrable_bound[of _ "\<lambda>x. (Norm (\<LL> \<infinity> M) f) powr p2"], auto)
         using * powr_mono2 \<open>p2 > 0\<close> by force
       then have "eNorm (\<LL> p2 M) f = (\<integral>x. \<bar>f x\<bar> powr p2 \<partial>M) powr (1/p2)"
         using Lp_I(3)[OF \<open>p2 > 0\<close> f_meas] by simp
       also have "... \<le> (\<integral>x. (Norm (\<LL> \<infinity> M) f) powr p2 \<partial>M) powr (1/p2)"
         apply (rule ennreal_leI, rule powr_mono2, simp add: \<open>p2 > 0\<close> less_imp_le, simp)
         apply (rule integral_mono_AE, auto simp add: **)
         using * powr_mono2 \<open>p2 > 0\<close> by force
       also have "... = Norm (\<LL> \<infinity> M) f"
         using \<open>p2 > 0\<close> by (auto simp add: prob_space powr_powr)
       finally show ?thesis
         using \<open>p = ennreal p2\<close> \<open>q = \<infinity>\<close> eNorm_Norm[OF \<open>f \<in> space\<^sub>N (\<LL> q M)\<close>] by auto
     next
       case 4
       then have "0 < p" "p < \<infinity>" by auto
       then obtain p2 where "p = ennreal p2" "p2 > 0"
         using enn2real_positive_iff[of p] by (cases p) auto
       have "0 < q" "q < \<infinity>" using 4 by auto
       then obtain q2 where "q = ennreal q2" "q2 > 0"
         using enn2real_positive_iff[of q] by (cases q) auto
       have "p2 < q2" using 4 \<open>p = ennreal p2\<close> \<open>q = ennreal q2\<close>
         using ennreal_less_iff by auto
       define r2 where "r2 = q2 / p2"
       have "r2 \<ge> 1" unfolding r2_def using \<open>p2 < q2\<close> \<open>p2 > 0\<close> by auto
       have *: "abs (\<bar>z\<bar> powr p2) powr r2 = \<bar>z\<bar> powr q2" for z::real
         unfolding r2_def using \<open>p2 > 0\<close> by (simp add: powr_powr)
       have I: "integrable M (\<lambda>x. abs(\<bar>f x\<bar> powr p2) powr r2)"
         unfolding * using \<open>f \<in> space\<^sub>N (\<LL> q M)\<close> \<open>q = ennreal q2\<close> Lp_D(2)[OF \<open>q2 > 0\<close>] by auto
       have J: "integrable M (\<lambda>x. \<bar>f x\<bar> powr p2)"
         by (rule bound_L1_Lp(1)[OF \<open>r2 \<ge> 1\<close> _ I], auto)
       have "f \<in> space\<^sub>N (\<LL> p2 M)"
         by (rule Lp_I(1)[OF \<open>p2 > 0\<close> _ J], simp)
       have "(\<integral>x. \<bar>f x\<bar> powr p2 \<partial>M) powr (1/p2) = abs(\<integral>x. \<bar>f x\<bar> powr p2 \<partial>M) powr (1/p2)"
         by auto
       also have "... \<le> ((\<integral>x. abs (\<bar>f x\<bar> powr p2) powr r2 \<partial>M) powr (1/r2)) powr (1/p2)"
         apply (subst powr_mono2, simp add: \<open>p2 > 0\<close> less_imp_le, simp)
         apply (rule bound_L1_Lp, simp add: \<open>r2 \<ge> 1\<close>, simp)
         unfolding * using \<open>f \<in> space\<^sub>N (\<LL> q M)\<close> \<open>q = ennreal q2\<close> Lp_D(2)[OF \<open>q2 > 0\<close>] by auto
       also have "... = (\<integral>x. \<bar>f x\<bar> powr q2 \<partial>M) powr (1/q2)"
         unfolding * using \<open>p2 > 0\<close> by (simp add: powr_powr r2_def)
       finally show ?thesis
         using \<open>f \<in> space\<^sub>N (\<LL> q M)\<close> Lp_D(4)[OF \<open>q2 > 0\<close>] ennreal_leI
         unfolding \<open>p = ennreal p2\<close> \<open>q = ennreal q2\<close> Lp_D(4)[OF \<open>p2 > 0\<close> \<open>f \<in> space\<^sub>N (\<LL> p2 M)\<close>] by force
     qed
   next
     case False
     then have "eNorm (\<LL> q M) f = \<infinity>"
       using top.not_eq_extremum by fastforce
     then show ?thesis by auto
   qed
   then show "\<LL> q M \<subseteq>\<^sub>N \<LL> p M" using quasinorm_subsetI[of _ _ 1] by auto
   then show "space\<^sub>N (\<LL> q M) \<subseteq> space\<^sub>N (\<LL> p M)" using quasinorm_subset_space by auto
   then show "Norm (\<LL> p M) f \<le> Norm (\<LL> q M) f" if "f \<in> space\<^sub>N (\<LL> q M)" for f
     using eNorm_Norm that \<open>eNorm (\<LL> p M) f \<le> eNorm (\<LL> q M) f\<close> ennreal_le_iff Norm_nonneg
     by (metis rev_subsetD)
 qed
 
 proposition Lp_domination:
   assumes [measurable]: "g \<in> borel_measurable M"
       and "f \<in> space\<^sub>N (\<LL> p M)"
           "AE x in M. \<bar>g x\<bar> \<le> \<bar>f x\<bar>"
   shows "g \<in> space\<^sub>N (\<LL> p M)"
         "Norm (\<LL> p M) g \<le> Norm (\<LL> p M) f"
 proof -
   have [measurable]: "f \<in> borel_measurable M" using Lp_measurable[OF assms(2)] by simp
   have "g \<in> space\<^sub>N (\<LL> p M) \<and> Norm (\<LL> p M) g \<le> Norm (\<LL> p M) f"
   proof (cases rule: Lp_cases[of p])
     case zero
     then have "Norm (\<LL> p M) g = 0"
       unfolding Norm_def using L_zero(1)[of M] by auto
     then have "Norm (\<LL> p M) g \<le> Norm (\<LL> p M) f" using Norm_nonneg by auto
     then show ?thesis unfolding \<open>p = 0\<close> L_zero_space by auto
   next
     case (real_pos p2)
     have *: "integrable M (\<lambda>x. \<bar>f x\<bar> powr p2)"
       using \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> unfolding \<open>p = ennreal p2\<close> using Lp_D(2) \<open>p2 > 0\<close> by auto
     have **: "integrable M (\<lambda>x. \<bar>g x\<bar> powr p2)"
       apply (rule Bochner_Integration.integrable_bound[of _ "\<lambda>x. \<bar>f x\<bar> powr p2"]) using * apply auto
       using assms(3) powr_mono2 \<open>p2 > 0\<close> by (auto simp add: less_imp_le)
     then have "g \<in> space\<^sub>N (\<LL> p M)"
       unfolding \<open>p = ennreal p2\<close> using Lp_space[OF \<open>p2 > 0\<close>, of M] by auto
     have "Norm (\<LL> p M) g = (\<integral>x. \<bar>g x\<bar> powr p2 \<partial>M) powr (1/p2)"
       unfolding \<open>p = ennreal p2\<close> by (rule Lp_I(2)[OF \<open>p2 > 0\<close> _ **], simp)
     also have "... \<le> (\<integral>x. \<bar>f x\<bar> powr p2 \<partial>M) powr (1/p2)"
       apply (rule powr_mono2, simp add: \<open>p2 > 0\<close> less_imp_le, simp)
       apply (rule integral_mono_AE, auto simp add: * **)
       using \<open>p2 > 0\<close> less_imp_le powr_mono2 assms(3) by auto
     also have "... = Norm (\<LL> p M) f"
       unfolding \<open>p = ennreal p2\<close> by (rule Lp_I(2)[OF \<open>p2 > 0\<close> _ *, symmetric], simp)
     finally show ?thesis using \<open>g \<in> space\<^sub>N (\<LL> p M)\<close> by auto
   next
     case PInf
     have "AE x in M. \<bar>f x\<bar> \<le> Norm (\<LL> p M) f"
       using \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> L_infinity_AE_bound unfolding \<open>p = \<infinity>\<close> by auto
     then have *: "AE x in M. \<bar>g x\<bar> \<le> Norm (\<LL> p M) f"
       using assms(3) by auto
     show ?thesis
       using L_infinity_I[OF assms(1) *] Norm_nonneg \<open>p = \<infinity>\<close> by auto
   qed
   then show "g \<in> space\<^sub>N (\<LL> p M)" "Norm (\<LL> p M) g \<le> Norm (\<LL> p M) f"
     by auto
 qed
 
 lemma Lp_Banach_lattice:
   assumes "f \<in> space\<^sub>N (\<LL> p M)"
   shows "(\<lambda>x. \<bar>f x\<bar>) \<in> space\<^sub>N (\<LL> p M)"
         "Norm (\<LL> p M) (\<lambda>x. \<bar>f x\<bar>) = Norm (\<LL> p M) f"
 proof -
   have [measurable]: "f \<in> borel_measurable M" using Lp_measurable[OF assms] by simp
   show "(\<lambda>x. \<bar>f x\<bar>) \<in> space\<^sub>N (\<LL> p M)"
     by (rule Lp_domination(1)[OF _ assms], auto)
   have "Norm (\<LL> p M) (\<lambda>x. \<bar>f x\<bar>) \<le> Norm (\<LL> p M) f"
     by (rule Lp_domination[OF _ assms], auto)
   moreover have "Norm (\<LL> p M) f \<le> Norm (\<LL> p M) (\<lambda>x. \<bar>f x\<bar>)"
     by (rule Lp_domination[OF _ \<open>(\<lambda>x. \<bar>f x\<bar>) \<in> space\<^sub>N (\<LL> p M)\<close>], auto)
   finally show "Norm (\<LL> p M) (\<lambda>x. \<bar>f x\<bar>) = Norm (\<LL> p M) f" by auto
 qed
 
 lemma Lp_bounded_bounded_support:
   assumes [measurable]: "f \<in> borel_measurable M"
       and "AE x in M. \<bar>f x\<bar> \<le> C"
           "emeasure M {x \<in> space M. f x \<noteq> 0} \<noteq> \<infinity>"
   shows "f \<in> space\<^sub>N(\<LL> p M)"
 proof (cases rule: Lp_cases[of p])
   case zero
   then show ?thesis using L_zero_space assms by blast
 next
   case PInf
   then show ?thesis using L_infinity_space assms by blast
 next
   case (real_pos p2)
   have *: "integrable M (\<lambda>x. \<bar>f x\<bar> powr p2)"
     apply (rule integrableI_bounded_set[of "{x \<in> space M. f x \<noteq> 0}" _ _ "C powr p2"])
     using assms powr_mono2[OF less_imp_le[OF \<open>p2 > 0\<close>]] by (auto simp add: top.not_eq_extremum)
   show ?thesis
     unfolding \<open>p = ennreal p2\<close> apply (rule Lp_I[OF \<open>p2 > 0\<close>]) using * by auto
 qed
 
 
 subsection \<open>$L^p$ versions of the main theorems in integration theory\<close>
 
 text \<open>The space $L^p$ is stable under almost sure convergence, for sequence with bounded norm.
 This is a version of Fatou's lemma (and it indeed follows from this lemma in the only
 nontrivial situation where $p \in (0, +\infty)$.\<close>
 
 proposition Lp_AE_limit:
   assumes [measurable]: "g \<in> borel_measurable M"
       and "AE x in M. (\<lambda>n. f n x) \<longlonglongrightarrow> g x"
   shows "eNorm (\<LL> p M) g \<le> liminf (\<lambda>n. eNorm (\<LL> p M) (f n))"
 proof (cases "liminf (\<lambda>n. eNorm (\<LL> p M) (f n)) = \<infinity>")
   case True
   then show ?thesis by auto
 next
   case False
   define le where "le = liminf (\<lambda>n. eNorm (\<LL> p M) (f n))"
   then have "le < \<infinity>" using False by (simp add: top.not_eq_extremum)
   obtain r0 where r0: "strict_mono r0" "(\<lambda>n. eNorm (\<LL> p M) (f (r0 n))) \<longlonglongrightarrow> le"
-    using liminf_subseq_lim unfolding comp_def le_def by force
+    using liminf_subseq_lim[of "\<lambda>n. eNorm (\<LL> p M) (f n)"]
+    unfolding comp_def le_def
+    by blast
   then have "eventually (\<lambda>n. eNorm (\<LL> p M) (f (r0 n)) < \<infinity>) sequentially"
     using False unfolding order_tendsto_iff le_def by (simp add: top.not_eq_extremum)
   then obtain N where N: "\<And>n. n \<ge> N \<Longrightarrow> eNorm (\<LL> p M) (f (r0 n)) < \<infinity>"
     unfolding eventually_sequentially by blast
   define r where "r = (\<lambda>n. r0 (n + N))"
   have "strict_mono r" unfolding r_def using \<open>strict_mono r0\<close> 
     by (simp add: strict_mono_Suc_iff)
   have *: "(\<lambda>n. eNorm (\<LL> p M) (f (r n))) \<longlonglongrightarrow> le"
     unfolding r_def using LIMSEQ_ignore_initial_segment[OF r0(2), of N].
   have "f (r n) \<in> space\<^sub>N (\<LL> p M)" for n
     using N spaceN_iff unfolding r_def by force
   then have [measurable]: "f (r n) \<in> borel_measurable M" for n
     using Lp_measurable by auto
   define l where "l = enn2real le"
   have "l \<ge> 0" unfolding l_def by auto
   have "le = ennreal l" using \<open>le < \<infinity>\<close> unfolding l_def by auto
   have [tendsto_intros]: "(\<lambda>n. Norm (\<LL> p M) (f (r n))) \<longlonglongrightarrow> l"
     apply (rule tendsto_ennrealD)
     using * \<open>le < \<infinity>\<close> unfolding eNorm_Norm[OF \<open>\<And>n. f (r n) \<in> space\<^sub>N (\<LL> p M)\<close>] l_def by auto
 
   show ?thesis
   proof (cases rule: Lp_cases[of p])
     case zero
     then have "eNorm (\<LL> p M) g = 0"
       using assms(1) by (simp add: L_zero(1))
     then show ?thesis by auto
   next
     case (real_pos p2)
     then have "f (r n) \<in> space\<^sub>N (\<LL> p2 M)" for n
       using \<open>\<And>n. f (r n) \<in> space\<^sub>N(\<LL> p M)\<close> by auto
     have "liminf (\<lambda>n. ennreal(\<bar>f (r n) x\<bar> powr p2)) = \<bar>g x\<bar> powr p2" if "(\<lambda>n. f n x) \<longlonglongrightarrow> g x" for x
       apply (rule lim_imp_Liminf, auto intro!: tendsto_intros simp add: \<open>p2 > 0\<close>)
       using LIMSEQ_subseq_LIMSEQ[OF that \<open>strict_mono r\<close>] unfolding comp_def by auto
     then have *: "AE x in M. liminf (\<lambda>n. ennreal(\<bar>f (r n) x\<bar> powr p2)) = \<bar>g x\<bar> powr p2"
       using \<open>AE x in M. (\<lambda>n. f n x) \<longlonglongrightarrow> g x\<close> by auto
 
     have "(\<integral>\<^sup>+x. ennreal(\<bar>f (r n) x\<bar> powr p2) \<partial>M) = ennreal((Norm (\<LL> p M) (f (r n))) powr p2)" for n
     proof -
       have "(\<integral>\<^sup>+x. ennreal(\<bar>f (r n) x\<bar> powr p2) \<partial>M) = ennreal (\<integral>x. \<bar>f (r n) x\<bar> powr p2 \<partial>M)"
         by (rule nn_integral_eq_integral, auto simp add: Lp_D(2)[OF \<open>p2 > 0\<close> \<open>f (r n) \<in> space\<^sub>N (\<LL> p2 M)\<close>])
       also have "... = ennreal((Norm (\<LL> p2 M) (f (r n))) powr p2)"
         unfolding Lp_D(3)[OF \<open>p2 > 0\<close> \<open>f (r n) \<in> space\<^sub>N (\<LL> p2 M)\<close>] using powr_powr \<open>p2 > 0\<close> by auto
       finally show ?thesis using \<open>p = ennreal p2\<close> by simp
     qed
     moreover have "(\<lambda>n. ennreal((Norm (\<LL> p M) (f (r n))) powr p2)) \<longlonglongrightarrow> ennreal(l powr p2)"
       by (auto intro!:tendsto_intros simp add: \<open>p2 > 0\<close>)
     ultimately have **: "liminf (\<lambda>n. (\<integral>\<^sup>+x. ennreal(\<bar>f (r n) x\<bar> powr p2) \<partial>M)) = ennreal(l powr p2)"
       using lim_imp_Liminf by force
 
     have "(\<integral>\<^sup>+x. \<bar>g x\<bar> powr p2 \<partial>M) = (\<integral>\<^sup>+x. liminf (\<lambda>n. ennreal(\<bar>f (r n) x\<bar> powr p2)) \<partial>M)"
       apply (rule nn_integral_cong_AE) using * by auto
     also have "... \<le> liminf (\<lambda>n. \<integral>\<^sup>+x. ennreal(\<bar>f (r n) x\<bar> powr p2) \<partial>M)"
       by (rule nn_integral_liminf, auto)
     finally have "(\<integral>\<^sup>+x. \<bar>g x\<bar> powr p2 \<partial>M) \<le> ennreal(l powr p2)" using ** by auto
     then have "(\<integral>\<^sup>+x. \<bar>g x\<bar> powr p2 \<partial>M) < \<infinity>" using le_less_trans by fastforce
     then have intg: "integrable M (\<lambda>x. \<bar>g x\<bar> powr p2)"
       apply (intro integrableI_nonneg) by auto
     then have "g \<in> space\<^sub>N (\<LL> p2 M)" using Lp_I(1)[OF \<open>p2 > 0\<close>, of _ M] by fastforce
     have "ennreal((Norm (\<LL> p2 M) g) powr p2) = ennreal(\<integral>x. \<bar>g x\<bar> powr p2 \<partial>M)"
       unfolding Lp_D(3)[OF \<open>p2 > 0\<close> \<open>g \<in> space\<^sub>N (\<LL> p2 M)\<close>] using powr_powr \<open>p2 > 0\<close> by auto
     also have "... = (\<integral>\<^sup>+x. \<bar>g x\<bar> powr p2 \<partial>M)"
       by (rule nn_integral_eq_integral[symmetric], auto simp add: intg)
     finally have "ennreal((Norm (\<LL> p2 M) g) powr p2) \<le> ennreal(l powr p2)"
       using \<open>(\<integral>\<^sup>+x. \<bar>g x\<bar> powr p2 \<partial>M) \<le> ennreal(l powr p2)\<close> by auto
     then have "((Norm (\<LL> p2 M) g) powr p2) powr (1/p2) \<le> (l powr p2) powr (1/p2)"
       using ennreal_le_iff \<open>l \<ge> 0\<close> \<open>p2 > 0\<close> powr_mono2 by auto
     then have "Norm (\<LL> p2 M) g \<le> l"
       using \<open>p2 > 0\<close> \<open>l \<ge> 0\<close> by (auto simp add: powr_powr)
     then have "eNorm (\<LL> p2 M) g \<le> le"
       unfolding eNorm_Norm[OF \<open>g \<in> space\<^sub>N (\<LL> p2 M)\<close>] \<open>le = ennreal l\<close> using ennreal_leI by auto
     then show ?thesis unfolding le_def \<open>p = ennreal p2\<close> by simp
   next
     case PInf
     then have "AE x in M. \<forall>n. \<bar>f (r n) x\<bar> \<le> Norm (\<LL> \<infinity> M) (f (r n))"
       apply (subst AE_all_countable) using L_infinity_AE_bound \<open>\<And>n. f (r n) \<in> space\<^sub>N (\<LL> p M)\<close> by blast
     moreover have "\<bar>g x\<bar> \<le> l" if "\<forall>n. \<bar>f (r n) x\<bar> \<le> Norm (\<LL> \<infinity> M) (f (r n))" "(\<lambda>n. f n x) \<longlonglongrightarrow> g x" for x
     proof -
       have "(\<lambda>n. f (r n) x) \<longlonglongrightarrow> g x"
         using that LIMSEQ_subseq_LIMSEQ[OF _ \<open>strict_mono r\<close>] unfolding comp_def by auto
       then have *: "(\<lambda>n. \<bar>f (r n) x\<bar>) \<longlonglongrightarrow> \<bar>g x\<bar>"
         by (auto intro!:tendsto_intros)
       show ?thesis
         apply (rule LIMSEQ_le[OF *]) using that(1) \<open>(\<lambda>n. Norm (\<LL> p M) (f (r n))) \<longlonglongrightarrow> l\<close> unfolding PInf by auto
     qed
     ultimately have "AE x in M. \<bar>g x\<bar> \<le> l" using \<open>AE x in M. (\<lambda>n. f n x) \<longlonglongrightarrow> g x\<close> by auto
     then have "g \<in> space\<^sub>N (\<LL> \<infinity> M)" "Norm (\<LL> \<infinity> M) g \<le> l"
       using L_infinity_I[OF \<open>g \<in> borel_measurable M\<close> _ \<open>l \<ge> 0\<close>] by auto
     then have "eNorm (\<LL> \<infinity> M) g \<le> le"
       unfolding eNorm_Norm[OF \<open>g \<in> space\<^sub>N (\<LL> \<infinity> M)\<close>] \<open>le = ennreal l\<close> using ennreal_leI by auto
     then show ?thesis unfolding le_def \<open>p = \<infinity>\<close> by simp
   qed
 qed
 
 lemma Lp_AE_limit':
   assumes "g \<in> borel_measurable M"
           "\<And>n. f n \<in> space\<^sub>N (\<LL> p M)"
           "AE x in M. (\<lambda>n. f n x) \<longlonglongrightarrow> g x"
           "(\<lambda>n. Norm (\<LL> p M) (f n)) \<longlonglongrightarrow> l"
   shows "g \<in> space\<^sub>N (\<LL> p M)"
         "Norm (\<LL> p M) g \<le> l"
 proof -
   have "l \<ge> 0" by (rule LIMSEQ_le_const[OF \<open>(\<lambda>n. Norm (\<LL> p M) (f n)) \<longlonglongrightarrow> l\<close>], auto)
   have "(\<lambda>n. eNorm (\<LL> p M) (f n)) \<longlonglongrightarrow> ennreal l"
     unfolding eNorm_Norm[OF \<open>\<And>n. f n \<in> space\<^sub>N (\<LL> p M)\<close>] using \<open>(\<lambda>n. Norm (\<LL> p M) (f n)) \<longlonglongrightarrow> l\<close> by auto
   then have *: "ennreal l = liminf (\<lambda>n. eNorm (\<LL> p M) (f n))"
     using lim_imp_Liminf[symmetric] trivial_limit_sequentially by blast
   have "eNorm (\<LL> p M) g \<le> ennreal l"
     unfolding * apply (rule Lp_AE_limit) using assms by auto
   then have "eNorm (\<LL> p M) g < \<infinity>" using le_less_trans by fastforce
   then show "g \<in> space\<^sub>N (\<LL> p M)" using spaceN_iff by auto
   show "Norm (\<LL> p M) g \<le> l"
     using \<open>eNorm (\<LL> p M) g \<le> ennreal l\<close> ennreal_le_iff[OF \<open>l \<ge> 0\<close>]
     unfolding eNorm_Norm[OF \<open>g \<in> space\<^sub>N (\<LL> p M)\<close>] by auto
 qed
 
 lemma Lp_AE_limit'':
   assumes "g \<in> borel_measurable M"
           "\<And>n. f n \<in> space\<^sub>N (\<LL> p M)"
           "AE x in M. (\<lambda>n. f n x) \<longlonglongrightarrow> g x"
           "\<And>n. Norm (\<LL> p M) (f n) \<le> C"
   shows "g \<in> space\<^sub>N (\<LL> p M)"
         "Norm (\<LL> p M) g \<le> C"
 proof -
   have "C \<ge> 0" by (rule order_trans[OF Norm_nonneg[of "\<LL> p M" "f 0"] \<open>Norm (\<LL> p M) (f 0) \<le> C\<close>])
   have *: "liminf (\<lambda>n. ennreal C) = ennreal C"
     using Liminf_const trivial_limit_at_top_linorder by blast
   have "eNorm (\<LL> p M) (f n) \<le> ennreal C" for n
     unfolding eNorm_Norm[OF \<open>f n \<in> space\<^sub>N (\<LL> p M)\<close>]
     using \<open>Norm (\<LL> p M) (f n) \<le> C\<close> by (auto simp add: ennreal_leI)
   then have "liminf (\<lambda>n. eNorm (\<LL> p M) (f n)) \<le> ennreal C"
     using Liminf_mono[of "(\<lambda>n. eNorm (\<LL> p M) (f n))" "\<lambda>_. C" sequentially] * by auto
   then have "eNorm (\<LL> p M) g \<le> ennreal C" using
     Lp_AE_limit[OF \<open>g \<in> borel_measurable M\<close> \<open>AE x in M. (\<lambda>n. f n x) \<longlonglongrightarrow> g x\<close>, of p] by auto
   then have "eNorm (\<LL> p M) g < \<infinity>" using le_less_trans by fastforce
   then show "g \<in> space\<^sub>N (\<LL> p M)" using spaceN_iff by auto
   show "Norm (\<LL> p M) g \<le> C"
     using \<open>eNorm (\<LL> p M) g \<le> ennreal C\<close> ennreal_le_iff[OF \<open>C \<ge> 0\<close>]
     unfolding eNorm_Norm[OF \<open>g \<in> space\<^sub>N (\<LL> p M)\<close>] by auto
 qed
 
 text \<open>We give the version of Lebesgue dominated convergence theorem in the setting of
 $L^p$ spaces.\<close>
 
 proposition Lp_domination_limit:
   fixes p::real
   assumes [measurable]: "g \<in> borel_measurable M"
           "\<And>n. f n \<in> borel_measurable M"
       and "m \<in> space\<^sub>N (\<LL> p M)"
           "AE x in M. (\<lambda>n. f n x) \<longlonglongrightarrow> g x"
           "\<And>n. AE x in M. \<bar>f n x\<bar> \<le> m x"
   shows "g \<in> space\<^sub>N (\<LL> p M)"
         "tendsto_in\<^sub>N (\<LL> p M) f g"
 proof -
   have [measurable]: "m \<in> borel_measurable M" using Lp_measurable[OF \<open>m \<in> space\<^sub>N (\<LL> p M)\<close>] by auto
   have "f n \<in> space\<^sub>N(\<LL> p M)" for n
     apply (rule Lp_domination[OF _ \<open>m \<in> space\<^sub>N (\<LL> p M)\<close>]) using \<open>AE x in M. \<bar>f n x\<bar> \<le> m x\<close> by auto
 
   have "AE x in M. \<forall>n. \<bar>f n x\<bar> \<le> m x"
     apply (subst AE_all_countable) using \<open>\<And>n. AE x in M. \<bar>f n x\<bar> \<le> m x\<close> by auto
   moreover have "\<bar>g x\<bar> \<le> m x" if "\<forall>n. \<bar>f n x\<bar> \<le> m x" "(\<lambda>n. f n x) \<longlonglongrightarrow> g x" for x
     apply (rule LIMSEQ_le_const2[of "\<lambda>n. \<bar>f n x\<bar>"]) using that by (auto intro!:tendsto_intros)
   ultimately have *: "AE x in M. \<bar>g x\<bar> \<le> m x" using \<open>AE x in M. (\<lambda>n. f n x) \<longlonglongrightarrow> g x\<close> by auto
   show "g \<in> space\<^sub>N(\<LL> p M)"
     apply (rule Lp_domination[OF _ \<open>m \<in> space\<^sub>N (\<LL> p M)\<close>]) using * by auto
 
   have "(\<lambda>n. Norm (\<LL> p M) (f n - g)) \<longlonglongrightarrow> 0"
   proof (cases "p \<le> 0")
     case True
     then have "ennreal p = 0" by (simp add: ennreal_eq_0_iff)
     then show ?thesis unfolding Norm_def by (auto simp add: L_zero(1))
   next
     case False
     then have "p > 0" by auto
     have "(\<lambda>n. (\<integral>x. \<bar>f n x - g x\<bar> powr p \<partial>M)) \<longlonglongrightarrow> (\<integral>x. \<bar>0\<bar> powr p \<partial>M)"
     proof (rule integral_dominated_convergence[of _ _ _ "(\<lambda>x. \<bar>2 * m x\<bar> powr p)"], auto)
       show "integrable M (\<lambda>x. \<bar>2 * m x\<bar> powr p)"
         unfolding abs_mult apply (subst powr_mult)
         using Lp_D(2)[OF \<open>p > 0\<close> \<open>m \<in> space\<^sub>N (\<LL> p M)\<close>] by auto
       have "(\<lambda>n. \<bar>f n x - g x\<bar> powr p) \<longlonglongrightarrow> \<bar>0\<bar> powr p" if "(\<lambda>n. f n x) \<longlonglongrightarrow> g x" for x
         apply (rule tendsto_powr') using \<open>p > 0\<close> that apply (auto)
         using Lim_null tendsto_rabs_zero_iff by fastforce
       then show "AE x in M. (\<lambda>n. \<bar>f n x - g x\<bar> powr p) \<longlonglongrightarrow> 0"
         using \<open>AE x in M. (\<lambda>n. f n x) \<longlonglongrightarrow> g x\<close> by auto
       have "\<bar>f n x - g x\<bar> powr p \<le> \<bar>2 * m x\<bar> powr p" if "\<bar>f n x\<bar> \<le> m x" "\<bar>g x\<bar> \<le> m x" for n x
         using powr_mono2 \<open>p > 0\<close> that by auto
       then show "AE x in M. \<bar>f n x - g x\<bar> powr p \<le> \<bar>2 * m x\<bar> powr p" for n
         using \<open>AE x in M. \<bar>f n x\<bar> \<le> m x\<close> \<open>AE x in M. \<bar>g x\<bar> \<le> m x\<close> by auto
     qed
     then have "(\<lambda>n. (Norm (\<LL> p M) (f n - g)) powr p) \<longlonglongrightarrow> (Norm (\<LL> p M) 0) powr p"
       unfolding Lp_D[OF \<open>p > 0\<close> spaceN_diff[OF \<open>\<And>n. f n \<in> space\<^sub>N(\<LL> p M)\<close> \<open>g \<in> space\<^sub>N(\<LL> p M)\<close>]]
       using \<open>p > 0\<close> by (auto simp add: powr_powr)
     then have "(\<lambda>n. ((Norm (\<LL> p M) (f n - g)) powr p) powr (1/p)) \<longlonglongrightarrow> ((Norm (\<LL> p M) 0) powr p) powr (1/p)"
       by (rule tendsto_powr', auto simp add: \<open>p > 0\<close>)
     then show ?thesis using powr_powr \<open>p > 0\<close> by auto
   qed
   then show "tendsto_in\<^sub>N (\<LL> p M) f g"
     unfolding tendsto_in\<^sub>N_def by auto
 qed
 
 text \<open>We give the version of the monotone convergence theorem in the setting of
 $L^p$ spaces.\<close>
 
 proposition Lp_monotone_limit:
   fixes f::"nat \<Rightarrow> 'a \<Rightarrow> real"
   assumes "p > (0::ennreal)"
           "AE x in M. incseq (\<lambda>n. f n x)"
           "\<And>n. Norm (\<LL> p M) (f n) \<le> C"
           "\<And>n. f n \<in> space\<^sub>N (\<LL> p M)"
   shows "AE x in M. convergent (\<lambda>n. f n x)"
         "(\<lambda>x. lim (\<lambda>n. f n x)) \<in> space\<^sub>N (\<LL> p M)"
         "Norm (\<LL> p M) (\<lambda>x. lim (\<lambda>n. f n x)) \<le> C"
 proof -
   have [measurable]: "f n \<in> borel_measurable M" for n using Lp_measurable[OF assms(4)].
   show "AE x in M. convergent (\<lambda>n. f n x)"
   proof (cases rule: Lp_cases[of p])
     case PInf
     have "AE x in M. \<bar>f n x\<bar> \<le> C" for n
       using L_infinity_AE_bound[of "f n" M] \<open>Norm (\<LL> p M) (f n) \<le> C\<close> \<open>f n \<in> space\<^sub>N (\<LL> p M)\<close>
       unfolding \<open>p=\<infinity>\<close> by auto
     then have *: "AE x in M. \<forall>n. \<bar>f n x\<bar> \<le> C"
       by (subst AE_all_countable, auto)
     have "(\<lambda>n. f n x) \<longlonglongrightarrow> (SUP n. f n x)" if "incseq (\<lambda>n. f n x)" "\<And>n. \<bar>f n x\<bar> \<le> C" for x
       apply (rule LIMSEQ_incseq_SUP[OF _ \<open>incseq (\<lambda>n. f n x)\<close>]) using that(2) abs_le_D1 by fastforce
     then have "convergent (\<lambda>n. f n x)" if "incseq (\<lambda>n. f n x)" "\<And>n. \<bar>f n x\<bar> \<le> C" for x
       unfolding convergent_def using that by auto
     then show ?thesis using \<open>AE x in M. incseq (\<lambda>n. f n x)\<close> * by auto
   next
     case (real_pos p2)
     define g where "g = (\<lambda>n. f n - f 0)"
     have "AE x in M. incseq (\<lambda>n. g n x)"
       unfolding g_def using \<open>AE x in M. incseq (\<lambda>n. f n x)\<close> by (simp add: incseq_def)
     have "g n \<in> space\<^sub>N (\<LL> p2 M)" for n
       unfolding g_def using \<open>\<And>n. f n \<in> space\<^sub>N (\<LL> p M)\<close> unfolding \<open>p = ennreal p2\<close> by auto
     then have [measurable]: "g n \<in> borel_measurable M" for n using Lp_measurable by auto
     define D where "D = defect (\<LL> p2 M) * C + defect (\<LL> p2 M) * C"
     have "Norm (\<LL> p2 M) (g n) \<le> D" for n
     proof -
       have "f n \<in> space\<^sub>N (\<LL> p2 M)" using \<open>f n \<in> space\<^sub>N (\<LL> p M)\<close> unfolding \<open>p = ennreal p2\<close> by auto
       have "Norm (\<LL> p2 M) (g n) \<le> defect (\<LL> p2 M) * Norm (\<LL> p2 M) (f n) + defect (\<LL> p2 M) * Norm (\<LL> p2 M) (f 0)"
         unfolding g_def using Norm_triangular_ineq_diff[OF \<open>f n \<in> space\<^sub>N (\<LL> p2 M)\<close>] by auto
       also have "... \<le> D"
         unfolding D_def apply(rule add_mono)
         using mult_left_mono defect_ge_1[of "\<LL> p2 M"] \<open>\<And>n. Norm (\<LL> p M) (f n) \<le> C\<close> unfolding \<open>p = ennreal p2\<close> by auto
       finally show ?thesis by simp
     qed
     have g_bound: "(\<integral>\<^sup>+x. \<bar>g n x\<bar> powr p2 \<partial>M) \<le> ennreal(D powr p2)" for n
     proof -
       have "(\<integral>\<^sup>+x. \<bar>g n x\<bar> powr p2 \<partial>M) = ennreal(\<integral>x. \<bar>g n x\<bar> powr p2 \<partial>M)"
         apply (rule nn_integral_eq_integral) using Lp_D(2)[OF \<open>p2 > 0\<close> \<open>g n \<in> space\<^sub>N (\<LL> p2 M)\<close>] by auto
       also have "... = ennreal((Norm (\<LL> p2 M) (g n)) powr p2)"
         apply (subst Lp_Norm(2)[OF \<open>p2 > 0\<close>, of "g n", symmetric]) by auto
       also have "... \<le> ennreal(D powr p2)"
         by (auto intro!: powr_mono2 simp add: less_imp_le[OF \<open>p2 > 0\<close>] \<open>Norm (\<LL> p2 M) (g n) \<le> D\<close>)
       finally show ?thesis by simp
     qed
     have "\<forall>n. g n x \<ge> 0" if "incseq (\<lambda>n. f n x)" for x
       unfolding g_def using that by (auto simp add: incseq_def)
     then have "AE x in M. \<forall>n. g n x \<ge> 0" using \<open>AE x in M. incseq (\<lambda>n. f n x)\<close> by auto
 
     define h where "h = (\<lambda>n x. ennreal(\<bar>g n x\<bar> powr p2))"
     have [measurable]: "h n \<in> borel_measurable M" for n unfolding h_def by auto
     define H where "H = (\<lambda>x. (SUP n. h n x))"
     have [measurable]: "H \<in> borel_measurable M" unfolding H_def by auto
     have "\<And>n. h n x \<le> h (Suc n) x" if "\<forall>n. g n x \<ge> 0" "incseq (\<lambda>n. g n x)" for x
       unfolding h_def apply (auto intro!:powr_mono2)
       apply (auto simp add: less_imp_le[OF \<open>p2 > 0\<close>]) using that incseq_SucD by auto
     then have *: "AE x in M. h n x \<le> h (Suc n) x" for n
       using \<open>AE x in M. \<forall>n. g n x \<ge> 0\<close> \<open>AE x in M. incseq (\<lambda>n. g n x)\<close> by auto
     have "(\<integral>\<^sup>+x. H x \<partial>M) = (SUP n. \<integral>\<^sup>+x. h n x \<partial>M)"
       unfolding H_def by (rule nn_integral_monotone_convergence_SUP_AE, auto simp add: *)
     also have "... \<le> ennreal(D powr p2)"
       unfolding H_def h_def using g_bound by (simp add: SUP_least)
     finally have "(\<integral>\<^sup>+x. H x \<partial>M) < \<infinity>" by (simp add: le_less_trans)
     then have "AE x in M. H x \<noteq> \<infinity>"
       by (metis (mono_tags, lifting) \<open>H \<in> borel_measurable M\<close> infinity_ennreal_def nn_integral_noteq_infinite top.not_eq_extremum)
 
     have "convergent (\<lambda>n. f n x)" if "H x \<noteq> \<infinity>" "incseq (\<lambda>n. f n x)" for x
     proof -
       define A where "A = enn2real(H x)"
       then have "H x = ennreal A" using \<open>H x \<noteq> \<infinity>\<close> by (simp add: ennreal_enn2real_if)
       have "f n x \<le> f 0 x + A powr (1/p2)" for n
       proof -
         have "ennreal(\<bar>g n x\<bar> powr p2) \<le> ennreal A"
           unfolding \<open>H x = ennreal A\<close>[symmetric] H_def h_def by (meson SUP_upper2 UNIV_I order_refl)
         then have "\<bar>g n x\<bar> powr p2 \<le> A"
           by (subst ennreal_le_iff[symmetric], auto simp add: A_def)
         have "\<bar>g n x\<bar> = (\<bar>g n x\<bar> powr p2) powr (1/p2)"
           using \<open>p2 > 0\<close> by (simp add: powr_powr)
         also have "... \<le> A powr (1/p2)"
           apply (rule powr_mono2) using \<open>p2 > 0\<close> \<open>\<bar>g n x\<bar> powr p2 \<le> A\<close> by auto
         finally have "\<bar>g n x\<bar> \<le> A powr (1/p2)" by simp
         then show ?thesis unfolding g_def by auto
       qed
       then show "convergent (\<lambda>n. f n x)"
         using LIMSEQ_incseq_SUP[OF _ \<open>incseq (\<lambda>n. f n x)\<close>] convergent_def by (metis bdd_aboveI2)
     qed
     then show "AE x in M. convergent (\<lambda>n. f n x)"
       using \<open>AE x in M. H x \<noteq> \<infinity>\<close> \<open>AE x in M. incseq (\<lambda>n. f n x)\<close> by auto
   qed (insert \<open>p>0\<close>, simp)
   then have lim: "AE x in M. (\<lambda>n. f n x) \<longlonglongrightarrow> lim (\<lambda>n. f n x)"
     using convergent_LIMSEQ_iff by auto
   show "(\<lambda>x. lim (\<lambda>n. f n x)) \<in> space\<^sub>N (\<LL> p M)"
     apply (rule Lp_AE_limit''[of _ _ f, OF _ \<open>\<And>n. f n \<in> space\<^sub>N (\<LL> p M)\<close> lim \<open>\<And>n. Norm (\<LL> p M) (f n) \<le> C\<close>])
     by auto
   show "Norm (\<LL> p M) (\<lambda>x. lim (\<lambda>n. f n x)) \<le> C"
     apply (rule Lp_AE_limit''[of _ _ f, OF _ \<open>\<And>n. f n \<in> space\<^sub>N (\<LL> p M)\<close> lim \<open>\<And>n. Norm (\<LL> p M) (f n) \<le> C\<close>])
     by auto
 qed
 
 
 subsection \<open>Completeness of $L^p$\<close>
 
 text \<open>We prove the completeness of $L^p$.\<close>
 
 theorem Lp_complete:
   "complete\<^sub>N (\<LL> p M)"
 proof (cases rule: Lp_cases[of p])
   case zero
   show ?thesis
   proof (rule complete\<^sub>N_I)
     fix u assume "\<forall>(n::nat). u n \<in> space\<^sub>N (\<LL> p M)"
     then have "tendsto_in\<^sub>N (\<LL> p M) u 0"
       unfolding tendsto_in\<^sub>N_def Norm_def \<open>p = 0\<close> L_zero(1) L_zero_space by auto
     then show "\<exists>x\<in>space\<^sub>N (\<LL> p M). tendsto_in\<^sub>N (\<LL> p M) u x"
       by auto
   qed
 next
   case (real_pos p2)
   show ?thesis
   proof (rule complete\<^sub>N_I'[of "\<lambda>n. (1/2)^n * (1/(defect (\<LL> p M))^(Suc n))"], unfold \<open>p = ennreal p2\<close>)
     show "0 < (1/2) ^ n * (1 / defect (\<LL> (ennreal p2) M) ^ Suc n)" for n
       using defect_ge_1[of "\<LL> (ennreal p2) M"] by (auto simp add: divide_simps)
 
     fix u assume "\<forall>(n::nat). u n \<in> space\<^sub>N (\<LL> p2 M)" "\<forall>n. Norm (\<LL> p2 M) (u n) \<le> (1/2)^n * (1/(defect (\<LL> p2 M))^(Suc n))"
     then have H: "\<And>n. u n \<in> space\<^sub>N (\<LL> p2 M)"
                  "\<And>n. Norm (\<LL> p2 M) (u n) \<le> (1/2) ^ n * (1/(defect (\<LL> p2 M))^(Suc n))"
       unfolding \<open>p = ennreal p2\<close> by auto
     have [measurable]: "u n \<in> borel_measurable M" for n using Lp_measurable[OF H(1)].
 
     define w where "w = (\<lambda>N x. (\<Sum>n\<in>{..<N}. \<bar>u n x\<bar>))"
     have w2: "w = (\<lambda>N. sum (\<lambda>n x. \<bar>u n x\<bar>) {..<N})" unfolding w_def apply (rule ext)+
       by (metis (mono_tags, lifting) sum.cong fun_sum_apply)
     have "incseq (\<lambda>N. w N x)" for x unfolding w2 by (rule incseq_SucI, auto)
     then have wN_inc: "AE x in M. incseq (\<lambda>N. w N x)" by simp
 
     have abs_u_space: "(\<lambda>x. \<bar>u n x\<bar>) \<in> space\<^sub>N (\<LL> p2 M)" for n
       by (rule Lp_Banach_lattice[OF \<open>u n \<in> space\<^sub>N (\<LL> p2 M)\<close>])
     then have wN_space: "w N \<in> space\<^sub>N (\<LL> p2 M)" for N unfolding w2 using H(1) by auto
     have abs_u_Norm: "Norm (\<LL> p2 M) (\<lambda>x. \<bar>u n x\<bar>) \<le> (1/2) ^ n * (1/(defect (\<LL> p2 M))^(Suc n))" for n
       using Lp_Banach_lattice(2)[OF \<open>u n \<in> space\<^sub>N (\<LL> p2 M)\<close>] H(2) by auto
 
     have wN_Norm: "Norm (\<LL> p2 M) (w N) \<le> 2" for N
     proof -
       have *: "(defect (\<LL> p2 M))^(Suc n) \<ge> 0" "(defect (\<LL> p2 M))^(Suc n) > 0" for n
         using defect_ge_1[of "\<LL> p2 M"] by auto
       have "Norm (\<LL> p2 M) (w N) \<le> (\<Sum>n<N. (defect (\<LL> p2 M))^(Suc n) * Norm (\<LL> p2 M) (\<lambda>x. \<bar>u n x\<bar>))"
         unfolding w2 lessThan_Suc_atMost[symmetric] by (rule Norm_sum, simp add: abs_u_space)
       also have "... \<le> (\<Sum>n<N. (defect (\<LL> p2 M))^(Suc n) * ((1/2) ^ n * (1/(defect (\<LL> p2 M))^(Suc n))))"
         apply (rule sum_mono, rule mult_left_mono) using abs_u_Norm * by auto
       also have "... = (\<Sum>n<N. (1/2) ^ n)"
         using *(2) defect_ge_1[of "\<LL> p2 M"] by (auto simp add: algebra_simps)
       also have "... \<le> (\<Sum>n. (1/2) ^ n)"
         unfolding lessThan_Suc_atMost[symmetric] by (rule sum_le_suminf, rule summable_geometric[of "1/2"], auto)
       also have "... = 2" using suminf_geometric[of "1/2"] by auto
       finally show ?thesis by simp
     qed
 
     have "AE x in M. convergent (\<lambda>N. w N x)"
       apply (rule Lp_monotone_limit[OF \<open>p > 0\<close>, of _ _ 2], unfold \<open>p = ennreal p2\<close>)
       using wN_inc wN_Norm wN_space by auto
     define m where "m = (\<lambda>x. lim (\<lambda>N. w N x))"
     have m_space: "m \<in> space\<^sub>N (\<LL> p2 M)"
       unfolding m_def \<open>p = ennreal p2\<close>[symmetric] apply (rule Lp_monotone_limit[OF \<open>p > 0\<close>, of _ _ 2], unfold \<open>p = ennreal p2\<close>)
       using wN_inc wN_Norm wN_space by auto
 
     define v where "v = (\<lambda>x. (\<Sum>n. u n x))"
     have v_meas: "v \<in> borel_measurable M" unfolding v_def by auto
     have u_meas: "\<And>n. (sum u {0..<n}) \<in> borel_measurable M" by auto
     {
       fix x assume "convergent (\<lambda>N. w N x)"
       then have S: "summable (\<lambda>n. \<bar>u n x\<bar>)" unfolding w_def using summable_iff_convergent by auto
       then have "m x = (\<Sum>n. \<bar>u n x\<bar>)" unfolding m_def w_def by (metis suminf_eq_lim)
 
       have "summable (\<lambda>n. u n x)" using S by (rule summable_rabs_cancel)
       then have *: "(\<lambda>n. (sum u {..<n}) x) \<longlonglongrightarrow> v x"
         unfolding v_def fun_sum_apply by (metis convergent_LIMSEQ_iff suminf_eq_lim summable_iff_convergent)
       have "\<bar>(sum u {..<n}) x\<bar> \<le> m x" for n
       proof -
         have "\<bar>(sum u {..<n}) x\<bar> \<le> (\<Sum>i\<in>{..<n}. \<bar>u i x\<bar>)"
           unfolding fun_sum_apply by auto
         also have "... \<le> (\<Sum>i. \<bar>u i x\<bar>)"
           apply (rule sum_le_suminf) using S by auto
         finally show ?thesis using \<open>m x = (\<Sum>n. \<bar>u n x\<bar>)\<close> by simp
       qed
       then have "(\<forall>n. \<bar>(sum u {0..<n}) x\<bar> \<le> m x) \<and> (\<lambda>n. (sum u {0..<n}) x) \<longlonglongrightarrow> v x"
         unfolding atLeast0LessThan using * by auto
     }
     then have m_bound: "\<And>n. AE x in M. \<bar>(sum u {0..<n}) x\<bar> \<le> m x"
           and u_conv: "AE x in M. (\<lambda>n. (sum u {0..<n}) x) \<longlonglongrightarrow> v x"
       using \<open>AE x in M. convergent (\<lambda>N. w N x)\<close> by auto
 
     have "tendsto_in\<^sub>N (\<LL> p2 M) (\<lambda>n. sum u {0..<n}) v"
       by (rule Lp_domination_limit[OF v_meas u_meas m_space u_conv m_bound])
     moreover have "v \<in> space\<^sub>N (\<LL> p2 M)"
       by (rule Lp_domination_limit[OF v_meas u_meas m_space u_conv m_bound])
     ultimately show "\<exists>v \<in> space\<^sub>N (\<LL> p2 M). tendsto_in\<^sub>N (\<LL> p2 M) (\<lambda>n. sum u {0..<n}) v"
       by auto
   qed
 next
   case PInf
   show ?thesis
   proof (rule complete\<^sub>N_I'[of "\<lambda>n. (1/2)^n"])
     fix u assume "\<forall>(n::nat). u n \<in> space\<^sub>N (\<LL> p M)" "\<forall>n. Norm (\<LL> p M) (u n) \<le> (1/2) ^ n"
     then have H: "\<And>n. u n \<in> space\<^sub>N (\<LL> \<infinity> M)" "\<And>n. Norm (\<LL> \<infinity> M) (u n) \<le> (1/2) ^ n" using PInf by auto
     have [measurable]: "u n \<in> borel_measurable M" for n using Lp_measurable[OF H(1)] by auto
     define v where "v = (\<lambda>x. \<Sum>n. u n x)"
     have [measurable]: "v \<in> borel_measurable M" unfolding v_def by auto
     define w where "w = (\<lambda>N x. (\<Sum>n\<in>{0..<N}. u n x))"
     have [measurable]: "w N \<in> borel_measurable M" for N unfolding w_def by auto
 
     have "AE x in M. \<bar>u n x\<bar> \<le> (1/2)^n" for n
       using L_infinity_AE_bound[OF H(1), of n] H(2)[of n] by auto
     then have "AE x in M. \<forall>n. \<bar>u n x\<bar> \<le> (1/2)^n"
       by (subst AE_all_countable, auto)
     moreover have "\<bar>w N x - v x\<bar> \<le> (1/2)^N * 2" if "\<forall>n. \<bar>u n x\<bar> \<le> (1/2)^n" for N x
     proof -
       have *: "\<And>n. \<bar>u n x\<bar> \<le> (1/2)^n" using that by auto
       have **: "summable (\<lambda>n. \<bar>u n x\<bar>)"
         apply (rule summable_norm_cancel, rule summable_comparison_test'[OF summable_geometric[of "1/2"]])
         using * by auto
       have "\<bar>w N x - v x\<bar> = \<bar>(\<Sum>n. u (n + N) x)\<bar>"
         unfolding v_def w_def
         apply (subst suminf_split_initial_segment[OF summable_rabs_cancel[OF \<open>summable (\<lambda>n. \<bar>u n x\<bar>)\<close>], of "N"])
         by (simp add: lessThan_atLeast0)
       also have "... \<le> (\<Sum>n. \<bar>u (n + N) x\<bar>)"
         apply (rule summable_rabs, subst summable_iff_shift) using ** by auto
       also have "... \<le> (\<Sum>n. (1/2)^(n + N))"
       proof (rule suminf_le)
         show "\<And>n. \<bar>u (n + N) x\<bar> \<le> (1/2) ^ (n + N)"
           using *[of "_ + N"] by simp
         show "summable (\<lambda>n. \<bar>u (n + N) x\<bar>)"
           using ** by (subst summable_iff_shift) simp
         show "summable (\<lambda>n. (1/2::real) ^ (n + N))"
           using summable_geometric [of "1/2"] by (subst summable_iff_shift) simp
       qed
       also have "... = (1/2)^N * (\<Sum>n. (1/2)^n)"
         by (subst power_add, subst suminf_mult2[symmetric], auto simp add: summable_geometric[of "1/2"])
       also have "... = (1/2)^N * 2"
         by (subst suminf_geometric, auto)
       finally show ?thesis by simp
     qed
     ultimately have *: "AE x in M. \<bar>w N x - v x\<bar> \<le> (1/2)^N * 2" for N by auto
 
     have **: "w N - v \<in> space\<^sub>N (\<LL> \<infinity> M)" "Norm (\<LL> \<infinity> M) (w N - v) \<le> (1/2)^N * 2" for N
       unfolding fun_diff_def using L_infinity_I[OF _ *] by auto
     have l: "(\<lambda>N. ((1/2)^N) * (2::real)) \<longlonglongrightarrow> 0 * 2"
       by (rule tendsto_mult, auto simp add: LIMSEQ_realpow_zero[of "1/2"])
     have "tendsto_in\<^sub>N (\<LL> \<infinity> M) w v" unfolding tendsto_in\<^sub>N_def
       apply (rule tendsto_sandwich[of "\<lambda>_. 0" _ _ "\<lambda>n. (1/2)^n * 2"]) using l **(2) by auto
     have "v = - (w 0 - v)" unfolding w_def by auto
     then have "v \<in> space\<^sub>N (\<LL> \<infinity> M)" using **(1)[of 0] spaceN_add spaceN_diff by fastforce
     then show "\<exists>v \<in> space\<^sub>N (\<LL> p M). tendsto_in\<^sub>N (\<LL> p M) (\<lambda>n. sum u {0..<n}) v"
       using \<open>tendsto_in\<^sub>N (\<LL> \<infinity> M) w v\<close> unfolding \<open>p = \<infinity>\<close> w_def fun_sum_apply[symmetric] by auto
   qed (simp)
 qed
 
 
 subsection \<open>Multiplication of functions, duality\<close>
 
 text \<open>The next theorem asserts that the multiplication of two functions in $L^p$ and $L^q$ belongs to
 $L^r$, where $r$ is determined by the equality $1/r = 1/p + 1/q$. This is essentially a case by case
 analysis, depending on the kind of $L^p$ space we are considering. The only nontrivial case is
 when $p$, $q$ (and $r$) are finite and nonzero. In this case, it reduces to H\"older inequality.\<close>
 
 theorem Lp_Lq_mult:
   fixes p q r::ennreal
   assumes "1/p + 1/q = 1/r"
       and "f \<in> space\<^sub>N (\<LL> p M)" "g \<in> space\<^sub>N (\<LL> q M)"
   shows "(\<lambda>x. f x * g x) \<in> space\<^sub>N (\<LL> r M)"
         "Norm (\<LL> r M) (\<lambda>x. f x * g x) \<le> Norm (\<LL> p M) f * Norm (\<LL> q M) g"
 proof -
   have [measurable]: "f \<in> borel_measurable M" "g \<in> borel_measurable M" using Lp_measurable assms by auto
   have "(\<lambda>x. f x * g x) \<in> space\<^sub>N (\<LL> r M) \<and> Norm (\<LL> r M) (\<lambda>x. f x * g x) \<le> Norm (\<LL> p M) f * Norm (\<LL> q M) g"
   proof (cases rule: Lp_cases[of r])
     case zero
     have *: "(\<lambda>x. f x * g x) \<in> borel_measurable M" by auto
     then have "Norm (\<LL> r M) (\<lambda>x. f x * g x) = 0" using L_zero[of M] unfolding Norm_def zero by auto
     then have "Norm (\<LL> r M) (\<lambda>x. f x * g x) \<le> Norm (\<LL> p M) f * Norm (\<LL> q M) g"
       using Norm_nonneg by auto
     then show ?thesis unfolding zero using * L_zero_space[of M] by auto
   next
     case (real_pos r2)
     have "p > 0" "q > 0" using \<open>1/p + 1/q = 1/r\<close> \<open>r > 0\<close>
       by (metis ennreal_add_eq_top ennreal_divide_eq_top_iff ennreal_top_neq_one gr_zeroI zero_neq_one)+
     consider "p = \<infinity>" | "q = \<infinity>" | "p < \<infinity> \<and> q < \<infinity>" using top.not_eq_extremum by force
     then show ?thesis
     proof (cases)
       case 1
       then have "q = r" using \<open>1/p + 1/q = 1/r\<close>
         by (metis ennreal_divide_top infinity_ennreal_def one_divide_one_divide_ennreal semiring_normalization_rules(5))
       have "AE x in M. \<bar>f x\<bar> \<le> Norm (\<LL> p M) f"
         using \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> L_infinity_AE_bound unfolding \<open>p = \<infinity>\<close> by auto
       then have *: "AE x in M. \<bar>f x * g x\<bar> \<le> \<bar>Norm (\<LL> p M) f * g x\<bar>"
         unfolding abs_mult using Norm_nonneg[of "\<LL> p M" f] mult_right_mono by fastforce
       have **: "(\<lambda>x. Norm (\<LL> p M) f * g x) \<in> space\<^sub>N (\<LL> r M)"
         using spaceN_cmult[OF \<open>g \<in> space\<^sub>N (\<LL> q M)\<close>] unfolding \<open>q = r\<close> scaleR_fun_def by simp
       have ***: "Norm (\<LL> r M) (\<lambda>x. Norm (\<LL> p M) f * g x) = Norm (\<LL> p M) f * Norm (\<LL> q M) g"
         using Norm_cmult[of "\<LL> r M"] unfolding \<open>q = r\<close> scaleR_fun_def by auto
       then show ?thesis
         using Lp_domination[of "\<lambda>x. f x * g x" M "\<lambda>x. Norm (\<LL> p M) f * g x" r] unfolding \<open>q = r\<close>
         using * ** *** by auto
     next
       case 2
       then have "p = r" using \<open>1/p + 1/q = 1/r\<close>
         by (metis add.right_neutral ennreal_divide_top infinity_ennreal_def one_divide_one_divide_ennreal)
       have "AE x in M. \<bar>g x\<bar> \<le> Norm (\<LL> q M) g"
         using \<open>g \<in> space\<^sub>N (\<LL> q M)\<close> L_infinity_AE_bound unfolding \<open>q = \<infinity>\<close> by auto
       then have *: "AE x in M. \<bar>f x * g x\<bar> \<le> \<bar>Norm (\<LL> q M) g * f x\<bar>"
         apply (simp only: mult.commute[of "Norm (\<LL> q M) g" _])
         unfolding abs_mult using mult_left_mono Norm_nonneg[of "\<LL> q M" g] by fastforce
       have **: "(\<lambda>x. Norm (\<LL> q M) g * f x) \<in> space\<^sub>N (\<LL> r M)"
         using spaceN_cmult[OF \<open>f \<in> space\<^sub>N (\<LL> p M)\<close>] unfolding \<open>p = r\<close> scaleR_fun_def by simp
       have ***: "Norm (\<LL> r M) (\<lambda>x. Norm (\<LL> q M) g * f x) = Norm (\<LL> p M) f * Norm (\<LL> q M) g"
         using Norm_cmult[of "\<LL> r M"] unfolding \<open>p = r\<close> scaleR_fun_def by auto
       then show ?thesis
         using Lp_domination[of "\<lambda>x. f x * g x" M "\<lambda>x. Norm (\<LL> q M) g * f x" r] unfolding \<open>p = r\<close>
         using * ** *** by auto
     next
       case 3
       obtain p2 where "p = ennreal p2" "p2 > 0"
         using enn2real_positive_iff[of p] 3 \<open>p > 0\<close> by (cases p) auto
       obtain q2 where "q = ennreal q2" "q2 > 0"
         using enn2real_positive_iff[of q] 3 \<open>q > 0\<close> by (cases q) auto
 
       have "ennreal(1/r2) = 1/r"
         using \<open>r = ennreal r2\<close> \<open>r2 > 0\<close> divide_ennreal zero_le_one by fastforce
       also have "... = 1/p + 1/q" using assms by auto
       also have "... = ennreal(1/p2 + 1/q2)" using \<open>p = ennreal p2\<close> \<open>p2 > 0\<close> \<open>q = ennreal q2\<close> \<open>q2 > 0\<close>
         apply (simp only: divide_ennreal ennreal_1[symmetric]) using ennreal_plus[of "1/p2" "1/q2", symmetric] by auto
       finally have *: "1/r2 = 1/p2 + 1/q2"
         using ennreal_inj \<open>p2 > 0\<close> \<open>q2 > 0\<close> \<open>r2 > 0\<close> by (metis divide_pos_pos ennreal_less_zero_iff le_less zero_less_one)
 
       define P where "P = p2 / r2"
       define Q where "Q = q2 / r2"
       have [simp]: "P > 0" "Q > 0" and "1/P + 1/Q = 1"
         using \<open>p2 > 0\<close> \<open>q2 > 0\<close> \<open>r2 > 0\<close> * unfolding P_def Q_def by (auto simp add: divide_simps algebra_simps)
       have Pa: "(\<bar>z\<bar> powr r2) powr P = \<bar>z\<bar> powr p2" for z
         unfolding P_def powr_powr using \<open>r2 > 0\<close> by auto
       have Qa: "(\<bar>z\<bar> powr r2) powr Q = \<bar>z\<bar> powr q2" for z
         unfolding Q_def powr_powr using \<open>r2 > 0\<close> by auto
 
       have *: "integrable M (\<lambda>x. \<bar>f x\<bar> powr r2 * \<bar>g x\<bar> powr r2)"
         apply (rule Holder_inequality[OF \<open>P>0\<close> \<open>Q>0\<close> \<open>1/P + 1/Q = 1\<close>], auto simp add: Pa Qa)
         using \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> unfolding \<open>p = ennreal p2\<close> using Lp_space[OF \<open>p2 > 0\<close>] apply auto
         using \<open>g \<in> space\<^sub>N (\<LL> q M)\<close> unfolding \<open>q = ennreal q2\<close> using Lp_space[OF \<open>q2 > 0\<close>] by auto
       have "(\<lambda>x. f x * g x) \<in> space\<^sub>N (\<LL> r M)"
         unfolding \<open>r = ennreal r2\<close> using Lp_space[OF \<open>r2 > 0\<close>, of M] by (auto simp add: * abs_mult powr_mult)
       have "Norm (\<LL> r M) (\<lambda>x. f x * g x) = (\<integral>x. \<bar>f x * g x\<bar> powr r2 \<partial>M) powr (1/r2)"
         unfolding \<open>r = ennreal r2\<close> using Lp_Norm[OF \<open>r2 > 0\<close>, of _ M] by auto
       also have "... = abs (\<integral>x. \<bar>f x\<bar> powr r2 * \<bar>g x\<bar> powr r2 \<partial>M) powr (1/r2)"
         by (auto simp add: powr_mult abs_mult)
       also have "... \<le> ((\<integral>x. \<bar> \<bar>f x\<bar> powr r2 \<bar> powr P \<partial>M) powr (1/P) * (\<integral>x. \<bar> \<bar>g x\<bar> powr r2 \<bar> powr Q \<partial>M) powr (1/Q)) powr (1/r2)"
         apply (rule powr_mono2, simp add: \<open>r2 > 0\<close> less_imp_le, simp)
         apply (rule Holder_inequality[OF \<open>P>0\<close> \<open>Q>0\<close> \<open>1/P + 1/Q = 1\<close>], auto simp add: Pa Qa)
         using \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> unfolding \<open>p = ennreal p2\<close> using Lp_space[OF \<open>p2 > 0\<close>] apply auto
         using \<open>g \<in> space\<^sub>N (\<LL> q M)\<close> unfolding \<open>q = ennreal q2\<close> using Lp_space[OF \<open>q2 > 0\<close>] by auto
       also have "... = (\<integral>x. \<bar>f x\<bar> powr p2 \<partial>M) powr (1/p2) * (\<integral>x. \<bar>g x\<bar> powr q2 \<partial>M) powr (1/q2)"
         apply (auto simp add: powr_mult powr_powr) unfolding P_def Q_def using \<open>r2 > 0\<close> by auto
       also have "... = Norm (\<LL> p M) f * Norm (\<LL> q M) g"
         unfolding \<open>p = ennreal p2\<close> \<open>q = ennreal q2\<close>
         using Lp_Norm[OF \<open>p2 > 0\<close>, of _ M] Lp_Norm[OF \<open>q2 > 0\<close>, of _ M] by auto
       finally show ?thesis using \<open>(\<lambda>x. f x * g x) \<in> space\<^sub>N (\<LL> r M)\<close> by auto
     qed
   next
     case PInf
     then have "p = \<infinity>" "q = r" using \<open>1/p + 1/q = 1/r\<close>
       by (metis add_eq_0_iff_both_eq_0 ennreal_divide_eq_0_iff infinity_ennreal_def not_one_le_zero order.order_iff_strict)+
     have "AE x in M. \<bar>f x\<bar> \<le> Norm (\<LL> p M) f"
       using \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> L_infinity_AE_bound unfolding \<open>p = \<infinity>\<close> by auto
     then have *: "AE x in M. \<bar>f x * g x\<bar> \<le> \<bar>Norm (\<LL> p M) f * g x\<bar>"
       unfolding abs_mult using Norm_nonneg[of "\<LL> p M" f] mult_right_mono by fastforce
     have **: "(\<lambda>x. Norm (\<LL> p M) f * g x) \<in> space\<^sub>N (\<LL> r M)"
       using spaceN_cmult[OF \<open>g \<in> space\<^sub>N (\<LL> q M)\<close>] unfolding \<open>q = r\<close> scaleR_fun_def by simp
     have ***: "Norm (\<LL> r M) (\<lambda>x. Norm (\<LL> p M) f * g x) = Norm (\<LL> p M) f * Norm (\<LL> q M) g"
       using Norm_cmult[of "\<LL> r M"] unfolding \<open>q = r\<close> scaleR_fun_def by auto
     then show ?thesis
       using Lp_domination[of "\<lambda>x. f x * g x" M "\<lambda>x. Norm (\<LL> p M) f * g x" r] unfolding \<open>q = r\<close>
       using * ** *** by auto
   qed
   then show "(\<lambda>x. f x * g x) \<in> space\<^sub>N (\<LL> r M)"
             "Norm (\<LL> r M) (\<lambda>x. f x * g x) \<le> Norm (\<LL> p M) f * Norm (\<LL> q M) g"
     by auto
 qed
 
 text \<open>The previous theorem admits an eNorm version in which one does not assume a priori
 that the functions under consideration belong to $L^p$ or $L^q$.\<close>
 
 theorem Lp_Lq_emult:
   fixes p q r::ennreal
   assumes "1/p + 1/q = 1/r"
           "f \<in> borel_measurable M" "g \<in> borel_measurable M"
   shows "eNorm (\<LL> r M) (\<lambda>x. f x * g x) \<le> eNorm (\<LL> p M) f * eNorm (\<LL> q M) g"
 proof (cases "r = 0")
   case True
   then have "eNorm (\<LL> r M) (\<lambda>x. f x * g x) = 0"
     using assms by (simp add: L_zero(1))
   then show ?thesis by auto
 next
   case False
   then have "r > 0" using not_gr_zero by blast
   then have "p > 0" "q > 0" using \<open>1/p + 1/q = 1/r\<close>
     by (metis ennreal_add_eq_top ennreal_divide_eq_top_iff ennreal_top_neq_one gr_zeroI zero_neq_one)+
   then have Z: "zero_space\<^sub>N (\<LL> p M) = {f \<in> borel_measurable M. AE x in M. f x = 0}"
                "zero_space\<^sub>N (\<LL> q M) = {f \<in> borel_measurable M. AE x in M. f x = 0}"
                "zero_space\<^sub>N (\<LL> r M) = {f \<in> borel_measurable M. AE x in M. f x = 0}"
     using \<open>r > 0\<close> Lp_infinity_zero_space by auto
   have [measurable]: "(\<lambda>x. f x * g x) \<in> borel_measurable M" using assms by auto
   consider "eNorm (\<LL> p M) f = 0 \<or> eNorm (\<LL> q M) g = 0"
          | "(eNorm (\<LL> p M) f > 0 \<and> eNorm (\<LL> q M) g = \<infinity>) \<or> (eNorm (\<LL> p M) f = \<infinity> \<and> eNorm (\<LL> q M) g > 0)"
          | "eNorm (\<LL> p M) f < \<infinity> \<and> eNorm (\<LL> q M) g < \<infinity>"
     using less_top by fastforce
   then show ?thesis
   proof (cases)
     case 1
     then have "(AE x in M. f x = 0) \<or> (AE x in M. g x = 0)" using Z unfolding zero_space\<^sub>N_def by auto
     then have "AE x in M. f x * g x = 0" by auto
     then have "eNorm (\<LL> r M) (\<lambda>x. f x * g x) = 0" using Z unfolding zero_space\<^sub>N_def by auto
     then show ?thesis by simp
   next
     case 2
     then have "eNorm (\<LL> p M) f * eNorm (\<LL> q M) g = \<infinity>" using ennreal_mult_eq_top_iff by force
     then show ?thesis by auto
   next
     case 3
     then have *: "f \<in> space\<^sub>N (\<LL> p M)" "g \<in> space\<^sub>N (\<LL> q M)" unfolding space\<^sub>N_def by auto
     then have "(\<lambda>x. f x * g x) \<in> space\<^sub>N (\<LL> r M)" using Lp_Lq_mult(1)[OF assms(1)] by auto
     then show ?thesis
       using Lp_Lq_mult(2)[OF assms(1) *] by (simp add: eNorm_Norm * ennreal_mult'[symmetric])
   qed
 qed
 
 lemma Lp_Lq_duality_bound:
   fixes p q::ennreal
   assumes "1/p + 1/q = 1"
           "f \<in> space\<^sub>N (\<LL> p M)"
           "g \<in> space\<^sub>N (\<LL> q M)"
   shows "integrable M (\<lambda>x. f x * g x)"
         "abs(\<integral>x. f x * g x \<partial>M) \<le> Norm (\<LL> p M) f * Norm (\<LL> q M) g"
 proof -
   have "(\<lambda>x. f x * g x) \<in> space\<^sub>N (\<LL> 1 M)"
     apply (rule Lp_Lq_mult[OF _ \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> \<open>g \<in> space\<^sub>N (\<LL> q M)\<close>])
     using \<open>1/p + 1/q = 1\<close> by auto
   then show "integrable M (\<lambda>x. f x * g x)" using L1_space by auto
 
   have "abs(\<integral>x. f x * g x \<partial>M) \<le> Norm (\<LL> 1 M) (\<lambda>x. f x * g x)" using L1_int_ineq by auto
   also have "... \<le> Norm (\<LL> p M) f * Norm (\<LL> q M) g"
     apply (rule Lp_Lq_mult[OF _ \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> \<open>g \<in> space\<^sub>N (\<LL> q M)\<close>])
     using \<open>1/p + 1/q = 1\<close> by auto
   finally show "abs(\<integral>x. f x * g x \<partial>M) \<le> Norm (\<LL> p M) f * Norm (\<LL> q M) g" by simp
 qed
 
 text \<open>The next theorem asserts that the norm of an $L^p$ function $f$ can be obtained by estimating
 the integrals of $fg$ over all $L^q$ functions $g$, where $1/p + 1/q = 1$. When $p = \infty$, it is
 necessary to assume that the space is sigma-finite: for instance, if the space is one single atom
 of infinite mass, then there is no nonzero $L^1$ function, so taking for $f$ the constant function
 equal to $1$, it has $L^\infty$ norm equal to $1$, but $\int fg = 0$ for all $L^1$ function $g$.\<close>
 
 theorem Lp_Lq_duality:
   fixes p q::ennreal
   assumes "f \<in> space\<^sub>N (\<LL> p M)"
           "1/p + 1/q = 1"
           "p = \<infinity> \<Longrightarrow> sigma_finite_measure M"
   shows "bdd_above ((\<lambda>g. (\<integral>x. f x * g x \<partial>M))`{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1})"
         "Norm (\<LL> p M) f = (SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. (\<integral>x. f x * g x \<partial>M))"
 proof -
   have [measurable]: "f \<in> borel_measurable M" using Lp_measurable[OF assms(1)] by auto
   have B: "(\<integral>x. f x * g x \<partial>M) \<le> Norm (\<LL> p M) f" if "g \<in> {g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}" for g
   proof -
     have g: "g \<in> space\<^sub>N (\<LL> q M)" "Norm (\<LL> q M) g \<le> 1" using that by auto
     have "(\<integral>x. f x * g x \<partial>M) \<le> abs(\<integral>x. f x * g x \<partial>M)" by auto
     also have "... \<le> Norm (\<LL> p M) f * Norm (\<LL> q M) g"
       using Lp_Lq_duality_bound(2)[OF \<open>1/p + 1/q = 1\<close> \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> g(1)] by auto
     also have "... \<le> Norm (\<LL> p M) f"
       using g(2) Norm_nonneg[of "\<LL> p M" f] mult_left_le by blast
     finally show "(\<integral>x. f x * g x \<partial>M) \<le> Norm (\<LL> p M) f" by simp
   qed
   then show "bdd_above ((\<lambda>g. (\<integral>x. f x * g x \<partial>M))`{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1})"
     by (meson bdd_aboveI2)
 
   show "Norm (\<LL> p M) f = (SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. (\<integral>x. f x * g x \<partial>M))"
   proof (rule antisym)
     show "(SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. \<integral>x. f x * g x \<partial>M) \<le> Norm (\<LL> p M) f"
       by (rule cSUP_least, auto, rule exI[of _ 0], auto simp add: B)
 
     have "p \<ge> 1" using conjugate_exponent_ennrealI(1)[OF \<open>1/p + 1/q = 1\<close>] by simp
     show "Norm (\<LL> p M) f \<le> (SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. (\<integral>x. f x * g x \<partial>M))"
     using \<open>p \<ge> 1\<close> proof (cases rule: Lp_cases_1_PInf)
       case PInf
       then have "f \<in> space\<^sub>N (\<LL> \<infinity> M)"
         using \<open>f \<in> space\<^sub>N(\<LL> p M)\<close> by simp
       have "q = 1" using \<open>1/p + 1/q = 1\<close> \<open>p = \<infinity>\<close> by (simp add: divide_eq_1_ennreal)
       have "c \<le> (SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. (\<integral>x. f x * g x \<partial>M))" if "c < Norm (\<LL> p M) f" for c
       proof (cases "c < 0")
         case True
         then have "c \<le> (\<integral>x. f x * 0 x \<partial>M)" by auto
         also have "... \<le> (SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. (\<integral>x. f x * g x \<partial>M))"
           apply (rule cSUP_upper, auto simp add: zero_fun_def[symmetric]) using B by (meson bdd_aboveI2)
         finally show ?thesis by simp
       next
         case False
         then have "ennreal c < eNorm (\<LL> \<infinity> M) f"
           using eNorm_Norm[OF \<open>f \<in> space\<^sub>N (\<LL> p M)\<close>] that ennreal_less_iff unfolding \<open>p = \<infinity>\<close> by auto
         then have *: "emeasure M {x \<in> space M. \<bar>f x\<bar> > c} > 0" using L_infinity_pos_measure[of f M c] by auto
         obtain A where [measurable]: "\<And>(n::nat). A n \<in> sets M" and "(\<Union>i. A i) = space M" "\<And>i. emeasure M (A i) \<noteq> \<infinity>"
           using sigma_finite_measure.sigma_finite[OF \<open>p = \<infinity> \<Longrightarrow> sigma_finite_measure M\<close>[OF \<open>p = \<infinity>\<close>]] by (metis UNIV_I sets_range)
         define Y where "Y = (\<lambda>n::nat. {x \<in> A n. \<bar>f x\<bar> > c})"
         have [measurable]: "Y n \<in> sets M" for n unfolding Y_def by auto
         have "{x \<in> space M. \<bar>f x\<bar> > c} = (\<Union>n. Y n)" unfolding Y_def using \<open>(\<Union>i. A i) = space M\<close> by auto
         then have "emeasure M (\<Union>n. Y n) > 0" using * by auto
         then obtain n where "emeasure M (Y n) > 0"
           using emeasure_pos_unionE[of Y, OF \<open>\<And>n. Y n \<in> sets M\<close>] by auto
         have "emeasure M (Y n) \<le> emeasure M (A n)" apply (rule emeasure_mono) unfolding Y_def by auto
         then have "emeasure M (Y n) \<noteq> \<infinity>" using \<open>emeasure M (A n) \<noteq> \<infinity>\<close>
           by (metis infinity_ennreal_def neq_top_trans)
         then have "measure M (Y n) > 0" using \<open>emeasure M (Y n) > 0\<close> unfolding measure_def
           by (simp add: enn2real_positive_iff top.not_eq_extremum)
         have "\<bar>f x\<bar> \<ge> c" if "x \<in> Y n" for x using that less_imp_le unfolding Y_def by auto
 
         define g where "g = (\<lambda>x. indicator (Y n) x * sgn(f x)) /\<^sub>R measure M (Y n)"
         have "g \<in> space\<^sub>N (\<LL> 1 M)"
           apply (rule Lp_domination[of _ _ "indicator (Y n) /\<^sub>R measure M (Y n)"]) unfolding g_def
           using L1_indicator'[OF \<open>Y n \<in> sets M\<close> \<open>emeasure M (Y n) \<noteq> \<infinity>\<close>] by (auto simp add: abs_mult indicator_def abs_sgn_eq)
         have "Norm (\<LL> 1 M) g = Norm (\<LL> 1 M) (\<lambda>x. indicator (Y n) x * sgn(f x)) / abs(measure M (Y n))"
           unfolding g_def Norm_cmult by (simp add: divide_inverse)
         also have "... \<le> Norm (\<LL> 1 M) (indicator (Y n)) / abs(measure M (Y n))"
           using \<open>measure M (Y n) > 0\<close> apply (auto simp add: divide_simps) apply (rule Lp_domination)
           using L1_indicator'[OF \<open>Y n \<in> sets M\<close> \<open>emeasure M (Y n) \<noteq> \<infinity>\<close>] by (auto simp add: abs_mult indicator_def abs_sgn_eq)
         also have "... = measure M (Y n) / abs(measure M (Y n))"
           using L1_indicator'[OF \<open>Y n \<in> sets M\<close> \<open>emeasure M (Y n) \<noteq> \<infinity>\<close>] by (auto simp add: abs_mult indicator_def abs_sgn_eq)
         also have "... = 1" using \<open>measure M (Y n) > 0\<close> by auto
         finally have "Norm (\<LL> 1 M) g \<le> 1" by simp
 
         have "c * measure M (Y n) = (\<integral>x. c * indicator (Y n) x \<partial>M)"
           using \<open>measure M (Y n) > 0\<close> \<open>emeasure M (Y n) \<noteq> \<infinity>\<close> by auto
         also have "... \<le> (\<integral>x. \<bar>f x\<bar> * indicator (Y n) x \<partial>M)"
           apply (rule integral_mono)
           using \<open>emeasure M (Y n) \<noteq> \<infinity>\<close> \<open>0 < Sigma_Algebra.measure M (Y n)\<close> not_integrable_integral_eq apply fastforce
           apply (rule Bochner_Integration.integrable_bound[of _ "\<lambda>x. Norm (\<LL> \<infinity> M) f * indicator (Y n) x"])
           using \<open>emeasure M (Y n) \<noteq> \<infinity>\<close> \<open>0 < Sigma_Algebra.measure M (Y n)\<close> not_integrable_integral_eq apply fastforce
           using L_infinity_AE_bound[OF \<open>f \<in> space\<^sub>N (\<LL> \<infinity> M)\<close>] by (auto simp add: indicator_def Y_def)
         finally have "c \<le> (\<integral>x. \<bar>f x\<bar> * indicator (Y n) x \<partial>M) / measure M (Y n)"
           using \<open>measure M (Y n) > 0\<close> by (auto simp add: divide_simps)
         also have "... = (\<integral>x. f x * indicator (Y n) x * sgn(f x) / measure M (Y n) \<partial>M)"
           using \<open>measure M (Y n) > 0\<close> by (simp add: abs_sgn mult.commute mult.left_commute)
         also have "... = (\<integral>x. f x * g x \<partial>M)"
           unfolding divide_inverse g_def divideR_apply by (auto simp add: algebra_simps)
         also have "... \<le> (SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. (\<integral>x. f x * g x \<partial>M))"
           unfolding \<open>q = 1\<close> apply (rule cSUP_upper, auto)
           using \<open>g \<in> space\<^sub>N (\<LL> 1 M)\<close> \<open>Norm (\<LL> 1 M) g \<le> 1\<close> apply auto using B \<open>p = \<infinity>\<close> \<open>q = 1\<close> by (meson bdd_aboveI2)
         finally show ?thesis by simp
       qed
       then show ?thesis using dense_le by auto
     next
       case one
       then have "q = \<infinity>" using \<open>1/p + 1/q = 1\<close> by simp
       define g where "g = (\<lambda>x. sgn (f x))"
       have [measurable]: "g \<in> space\<^sub>N (\<LL> \<infinity> M)"
         apply (rule L_infinity_I[of g M 1]) unfolding g_def by (auto simp add: abs_sgn_eq)
       have "Norm (\<LL> \<infinity> M) g \<le> 1"
         apply (rule L_infinity_I[of g M 1]) unfolding g_def by (auto simp add: abs_sgn_eq)
       have "Norm (\<LL> p M) f = (\<integral>x. \<bar>f x\<bar> \<partial>M)"
         unfolding \<open>p = 1\<close> apply (rule L1_D(3)) using \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> unfolding \<open>p = 1\<close> by auto
       also have "... = (\<integral>x. f x * g x \<partial>M)"
         unfolding g_def by (simp add: abs_sgn)
       also have "... \<le> (SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. (\<integral>x. f x * g x \<partial>M))"
         unfolding \<open>q = \<infinity>\<close> apply (rule cSUP_upper, auto)
         using \<open>g \<in> space\<^sub>N (\<LL> \<infinity> M)\<close> \<open>Norm (\<LL> \<infinity> M) g \<le> 1\<close> apply auto
         using B \<open>q = \<infinity>\<close> by fastforce
       finally show ?thesis by simp
     next
       case (gr p2)
       then have "p2 > 0" by simp
       have "f \<in> space\<^sub>N (\<LL> p2 M)" using \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> \<open>p = ennreal p2\<close> by auto
       define q2 where "q2 = conjugate_exponent p2"
       have "q2 > 1" "q2 > 0" using conjugate_exponent_real(2)[OF \<open>p2 > 1\<close>] unfolding q2_def by auto
       have "q = ennreal q2"
         unfolding q2_def conjugate_exponent_real_ennreal[OF \<open>p2 > 1\<close>, symmetric] \<open>p = ennreal p2\<close>[symmetric]
         using conjugate_exponent_ennreal_iff[OF \<open>p \<ge> 1\<close>] \<open>1/p + 1/q = 1\<close> by auto
 
       show ?thesis
       proof (cases "Norm (\<LL> p M) f = 0")
         case True
         then have "Norm (\<LL> p M) f \<le> (\<integral>x. f x * 0 x \<partial>M)" by auto
         also have "... \<le> (SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. (\<integral>x. f x * g x \<partial>M))"
           apply (rule cSUP_upper, auto simp add: zero_fun_def[symmetric]) using B by (meson bdd_aboveI2)
         finally show ?thesis by simp
       next
         case False
         then have "Norm (\<LL> p2 M) f > 0"
           unfolding \<open>p = ennreal p2\<close> using Norm_nonneg[of "\<LL> p2 M" f] by linarith
 
         define h where "h = (\<lambda>x. sgn(f x) * \<bar>f x\<bar> powr (p2 - 1))"
         have [measurable]: "h \<in> borel_measurable M" unfolding h_def by auto
         have "(\<integral>\<^sup>+x. \<bar>h x\<bar> powr q2 \<partial>M) = (\<integral>\<^sup>+x. (\<bar>f x\<bar> powr (p2 - 1)) powr q2 \<partial>M)"
           unfolding h_def by (rule nn_integral_cong, auto simp add: abs_mult abs_sgn_eq)
         also have "... = (\<integral>\<^sup>+x. \<bar>f x\<bar> powr p2 \<partial>M)"
           unfolding powr_powr q2_def using conjugate_exponent_real(4)[OF \<open>p2 > 1\<close>] by auto
         also have "... = (Norm (\<LL> p2 M) f) powr p2"
           apply (subst Lp_Norm(2), auto simp add: \<open>p2 > 0\<close>)
           by (rule nn_integral_eq_integral, auto simp add: Lp_D(2)[OF \<open>p2 > 0\<close> \<open>f \<in> space\<^sub>N (\<LL> p2 M)\<close>])
         finally have *: "(\<integral>\<^sup>+x. \<bar>h x\<bar> powr q2 \<partial>M) = (Norm (\<LL> p2 M) f) powr p2" by simp
         have "integrable M (\<lambda>x. \<bar>h x\<bar> powr q2)"
           apply (rule integrableI_bounded, auto) using * by auto
         then have "(\<integral>x. \<bar>h x\<bar> powr q2 \<partial>M) = (\<integral>\<^sup>+x. \<bar>h x\<bar> powr q2 \<partial>M)"
           by (rule nn_integral_eq_integral[symmetric], auto)
         then have **: "(\<integral>x. \<bar>h x\<bar> powr q2 \<partial>M) = (Norm (\<LL> p2 M) f) powr p2" using * by auto
 
         define g where "g = (\<lambda>x. h x / (Norm (\<LL> p2 M) f) powr (p2 / q2))"
         have [measurable]: "g \<in> borel_measurable M" unfolding g_def by auto
         have intg: "integrable M (\<lambda>x. \<bar>g x\<bar> powr q2)"
           unfolding g_def using \<open>Norm (\<LL> p2 M) f > 0\<close> \<open>q2 > 1\<close> apply (simp add: abs_mult powr_divide powr_powr)
           using \<open>integrable M (\<lambda>x. \<bar>h x\<bar> powr q2)\<close> integrable_divide_zero by blast
         have "g \<in> space\<^sub>N (\<LL> q2 M)" by (rule Lp_I(1)[OF \<open>q2 > 0\<close> _ intg], auto)
         have "(\<integral>x. \<bar>g x\<bar> powr q2 \<partial>M) = 1"
           unfolding g_def using \<open>Norm (\<LL> p2 M) f > 0\<close> \<open>q2 > 1\<close> by (simp add: abs_mult powr_divide powr_powr **)
         then have "Norm (\<LL> q2 M) g = 1"
           apply (subst Lp_D[OF \<open>q2 > 0\<close>]) using \<open>g \<in> space\<^sub>N (\<LL> q2 M)\<close> by auto
 
         have "(\<integral>x. f x * g x \<partial>M) = (\<integral>x. f x * sgn(f x) * \<bar>f x\<bar> powr (p2 - 1) / (Norm (\<LL> p2 M) f) powr (p2 / q2) \<partial>M)"
           unfolding g_def h_def by (simp add: mult.assoc)
         also have "... = (\<integral>x. \<bar>f x\<bar> * \<bar>f x\<bar> powr (p2-1) \<partial>M) / (Norm (\<LL> p2 M) f) powr (p2 / q2)"
           by (auto simp add: abs_sgn)
         also have "... = (\<integral>x. \<bar>f x\<bar> powr p2 \<partial>M) / (Norm (\<LL> p2 M) f) powr (p2 / q2)"
           by (subst powr_mult_base, auto)
         also have "... = (Norm (\<LL> p2 M) f) powr p2 / (Norm (\<LL> p2 M) f) powr (p2 / q2)"
           by (subst Lp_Norm(2)[OF \<open>p2 > 0\<close>], auto)
         also have "... = (Norm (\<LL> p2 M) f) powr (p2 - p2/q2)"
           by (simp add: powr_diff [symmetric] )
         also have "... = Norm (\<LL> p2 M) f"
           unfolding q2_def using conjugate_exponent_real(5)[OF \<open>p2 > 1\<close>] by auto
         finally have "Norm (\<LL> p M) f = (\<integral>x. f x * g x \<partial>M)"
           unfolding \<open>p = ennreal p2\<close> by simp
         also have "... \<le> (SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. (\<integral>x. f x * g x \<partial>M))"
           unfolding \<open>q = ennreal q2\<close> apply (rule cSUP_upper, auto)
           using \<open>g \<in> space\<^sub>N (\<LL> q2 M)\<close> \<open>Norm (\<LL> q2 M) g = 1\<close> apply auto
           using B \<open>q = ennreal q2\<close> by fastforce
         finally show ?thesis by simp
       qed
     qed
   qed
 qed
 
 text \<open>The previous theorem admits a version in which one does not assume a priori that the
 function under consideration belongs to $L^p$. This gives an efficient criterion to check
 if a function is indeed in $L^p$. In this case, it is always necessary to assume that the
 measure is sigma-finite.
 
 Note that, in the statement, the Bochner integral $\int fg$ vanishes by definition if
 $fg$ is not integrable. Hence, the statement really says that the eNorm can be estimated
 using functions $g$ for which $fg$ is integrable. It is precisely the construction of such
 functions $g$ that requires the space to be sigma-finite.\<close>
 
 theorem Lp_Lq_duality':
   fixes p q::ennreal
   assumes "1/p + 1/q = 1"
           "sigma_finite_measure M"
       and [measurable]: "f \<in> borel_measurable M"
   shows "eNorm (\<LL> p M) f = (SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. ennreal(\<integral>x. f x * g x \<partial>M))"
 proof (cases "eNorm (\<LL> p M) f \<noteq> \<infinity>")
   case True
   then have "f \<in> space\<^sub>N (\<LL> p M)" unfolding space\<^sub>N_def by (simp add: top.not_eq_extremum)
   show ?thesis
     unfolding eNorm_Norm[OF \<open>f \<in> space\<^sub>N (\<LL> p M)\<close>] Lp_Lq_duality[OF \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> \<open>1/p + 1/q = 1\<close> \<open>sigma_finite_measure M\<close>]
     apply (rule SUP_real_ennreal[symmetric], auto, rule exI[of _ 0], auto)
     by (rule Lp_Lq_duality[OF \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> \<open>1/p + 1/q = 1\<close> \<open>sigma_finite_measure M\<close>])
 next
   case False
   have B: "\<exists>g \<in> {g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. (\<integral>x. f x * g x \<partial>M) \<ge> C" if "C < \<infinity>" for C::ennreal
   proof -
     obtain Cr where "C = ennreal Cr" "Cr \<ge> 0" using \<open>C < \<infinity>\<close> ennreal_cases less_irrefl by auto
     obtain A where A: "\<And>n::nat. A n \<in> sets M" "incseq A" "(\<Union>n. A n) = space M"
             "\<And>n. emeasure M (A n) \<noteq> \<infinity>"
       using sigma_finite_measure.sigma_finite_incseq[OF \<open>sigma_finite_measure M\<close>] by (metis range_subsetD)
     define Y where "Y = (\<lambda>n. {x \<in> A n. \<bar>f x\<bar> \<le> n})"
     have [measurable]: "\<And>n. Y n \<in> sets M" unfolding Y_def using \<open>\<And>n::nat. A n \<in> sets M\<close> by auto
     have "incseq Y"
       apply (rule incseq_SucI) unfolding Y_def using incseq_SucD[OF \<open>incseq A\<close>] by auto
     have *: "\<exists>N. \<forall>n \<ge> N. f x * indicator (Y n) x = f x" if "x \<in> space M" for x
     proof -
       obtain n0 where n0: "x \<in> A n0" using \<open>x \<in> space M\<close> \<open>(\<Union>n. A n) = space M\<close> by auto
       obtain n1::nat where n1: "\<bar>f x\<bar> \<le> n1" using real_arch_simple by blast
       have "x \<in> Y (max n0 n1)"
         unfolding Y_def using n1 apply auto
         using n0 \<open>incseq A\<close> incseq_def max.cobounded1 by blast
       then have *: "x \<in> Y n" if "n \<ge> max n0 n1" for n
         using \<open>incseq Y\<close> that incseq_def by blast
       show ?thesis by (rule exI[of _ "max n0 n1"], auto simp add: *)
     qed
     have *: "(\<lambda>n. f x * indicator (Y n) x) \<longlonglongrightarrow> f x" if "x \<in> space M" for x
       using *[OF that] unfolding eventually_sequentially[symmetric] by (simp add: tendsto_eventually)
     have "liminf (\<lambda>n. eNorm (\<LL> p M) (\<lambda>x. f x * indicator (Y n) x)) \<ge> eNorm (\<LL> p M) f"
       apply (rule Lp_AE_limit) using * by auto
     then have "liminf (\<lambda>n. eNorm (\<LL> p M) (\<lambda>x. f x * indicator (Y n) x)) > Cr" using False neq_top_trans by force
     then have "limsup (\<lambda>n. eNorm (\<LL> p M) (\<lambda>x. f x * indicator (Y n) x)) > Cr"
       using Liminf_le_Limsup less_le_trans trivial_limit_sequentially by blast
     then obtain n where n: "eNorm (\<LL> p M) (\<lambda>x. f x * indicator (Y n) x) > Cr"
       using Limsup_obtain by blast
 
     have "(\<lambda>x. f x * indicator (Y n) x) \<in> space\<^sub>N (\<LL> p M)"
       apply (rule Lp_bounded_bounded_support[of _ _ n], auto)
       unfolding Y_def indicator_def apply auto
       by (metis (mono_tags, lifting) A(1) A(4) emeasure_mono infinity_ennreal_def mem_Collect_eq neq_top_trans subsetI)
     have "Norm (\<LL> p M) (\<lambda>x. f x * indicator (Y n) x) > Cr"
       using n unfolding eNorm_Norm[OF \<open>(\<lambda>x. f x * indicator (Y n) x) \<in> space\<^sub>N (\<LL> p M)\<close>]
       by (meson ennreal_leI not_le)
     then have "(SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. (\<integral>x. f x * indicator (Y n) x * g x \<partial>M)) > Cr"
       using Lp_Lq_duality(2)[OF \<open>(\<lambda>x. f x * indicator (Y n) x) \<in> space\<^sub>N (\<LL> p M)\<close> \<open>1/p + 1/q = 1\<close> \<open>sigma_finite_measure M\<close>]
       by auto
     then have "\<exists>g \<in> {g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. (\<integral>x. f x * indicator (Y n) x * g x \<partial>M) > Cr"
       apply (subst less_cSUP_iff[symmetric])
       using Lp_Lq_duality(1)[OF \<open>(\<lambda>x. f x * indicator (Y n) x) \<in> space\<^sub>N (\<LL> p M)\<close> \<open>1/p + 1/q = 1\<close> \<open>sigma_finite_measure M\<close>] apply auto
       by (rule exI[of _ 0], auto)
     then obtain g where g: "g \<in> space\<^sub>N (\<LL> q M)" "Norm (\<LL> q M) g \<le> 1" "(\<integral>x. f x * indicator (Y n) x * g x \<partial>M) > Cr"
       by auto
     then have [measurable]: "g \<in> borel_measurable M" using Lp_measurable by auto
     define h where "h = (\<lambda>x. indicator (Y n) x * g x)"
     have "Norm (\<LL> q M) h \<le> Norm (\<LL> q M) g"
       apply (rule Lp_domination[of _ _ g]) unfolding h_def indicator_def using \<open>g \<in> space\<^sub>N (\<LL> q M)\<close> by auto
     then have a: "Norm (\<LL> q M) h \<le> 1" using \<open>Norm (\<LL> q M) g \<le> 1\<close> by auto
     have b: "h \<in> space\<^sub>N (\<LL> q M)"
       apply (rule Lp_domination[of _ _ g]) unfolding h_def indicator_def using \<open>g \<in> space\<^sub>N (\<LL> q M)\<close> by auto
     have "(\<integral>x. f x * h x \<partial>M) > Cr" unfolding h_def using g(3) by (auto simp add: mult.assoc)
     then have "(\<integral>x. f x * h x \<partial>M) > C"
       unfolding \<open>C = ennreal Cr\<close> using \<open>Cr \<ge> 0\<close> by (simp add: ennreal_less_iff)
     then show ?thesis using a b by auto
   qed
   have "(SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. ennreal(\<integral>x. f x * g x \<partial>M)) \<ge> \<infinity>"
     apply (rule dense_le) using B by (meson SUP_upper2)
   then show ?thesis using False neq_top_trans by force
 qed
 
 
 subsection \<open>Conditional expectations and $L^p$\<close>
 
 text \<open>The $L^p$ space with respect to a subalgebra is included in the whole $L^p$ space.\<close>
 
 lemma Lp_subalgebra:
   assumes "subalgebra M F"
   shows "\<And>f. eNorm (\<LL> p M) f \<le> eNorm (\<LL> p (restr_to_subalg M F)) f"
         "(\<LL> p (restr_to_subalg M F)) \<subseteq>\<^sub>N \<LL> p M"
         "space\<^sub>N ((\<LL> p (restr_to_subalg M F))) \<subseteq> space\<^sub>N (\<LL> p M)"
         "\<And>f. f \<in> space\<^sub>N ((\<LL> p (restr_to_subalg M F))) \<Longrightarrow> Norm (\<LL> p M) f = Norm (\<LL> p (restr_to_subalg M F)) f"
 proof -
   have *: "f \<in> space\<^sub>N (\<LL> p M) \<and> Norm (\<LL> p M) f = Norm (\<LL> p (restr_to_subalg M F)) f"
        if "f \<in> space\<^sub>N (\<LL> p (restr_to_subalg M F))" for f
   proof -
     have [measurable]: "f \<in> borel_measurable (restr_to_subalg M F)" using that Lp_measurable by auto
     then have [measurable]: "f \<in> borel_measurable M"
       using assms measurable_from_subalg measurable_in_subalg' by blast
     show ?thesis
     proof (cases rule: Lp_cases[of p])
       case zero
       then show ?thesis using that unfolding \<open>p = 0\<close> L_zero_space Norm_def L_zero by auto
     next
       case PInf
       have [measurable]: "f \<in> borel_measurable (restr_to_subalg M F)" using that Lp_measurable by auto
       then have [measurable]: "f \<in> borel_measurable F" using assms measurable_in_subalg' by blast
       then have [measurable]: "f \<in> borel_measurable M" using assms measurable_from_subalg by blast
       have "AE x in (restr_to_subalg M F). \<bar>f x\<bar> \<le> Norm (\<LL> \<infinity> (restr_to_subalg M F)) f"
         using L_infinity_AE_bound that unfolding \<open>p = \<infinity>\<close> by auto
       then have a: "AE x in M. \<bar>f x\<bar> \<le> Norm (\<LL> \<infinity> (restr_to_subalg M F)) f"
         using assms AE_restr_to_subalg by blast
       have *: "f \<in> space\<^sub>N (\<LL> \<infinity> M)" "Norm (\<LL> \<infinity> M) f \<le> Norm (\<LL> \<infinity> (restr_to_subalg M F)) f"
         using L_infinity_I[OF \<open>f \<in> borel_measurable M\<close> a] by auto
       then have b: "AE x in M. \<bar>f x\<bar> \<le> Norm (\<LL> \<infinity> M) f"
         using L_infinity_AE_bound by auto
       have c: "AE x in (restr_to_subalg M F). \<bar>f x\<bar> \<le> Norm (\<LL> \<infinity> M) f"
         apply (rule AE_restr_to_subalg2[OF assms]) using b by auto
       have "Norm (\<LL> \<infinity> (restr_to_subalg M F)) f \<le> Norm (\<LL> \<infinity> M) f"
         using L_infinity_I[OF \<open>f \<in> borel_measurable (restr_to_subalg M F)\<close> c] by auto
       then show ?thesis using * unfolding \<open>p = \<infinity>\<close> by auto
     next
       case (real_pos p2)
       then have a [measurable]: "f \<in> space\<^sub>N (\<LL> p2 (restr_to_subalg M F))"
         using that unfolding \<open>p = ennreal p2\<close> by auto
       then have b [measurable]: "f \<in> space\<^sub>N (\<LL> p2 M)"
         unfolding Lp_space[OF \<open>p2 > 0\<close>] using integrable_from_subalg[OF assms] by auto
       show ?thesis
         unfolding \<open>p = ennreal p2\<close> Lp_D[OF \<open>p2 > 0\<close> a] Lp_D[OF \<open>p2 > 0\<close> b]
         using integral_subalgebra2[OF assms, symmetric, of f] apply (auto simp add: b)
         by (metis (mono_tags, lifting) \<open>integrable (restr_to_subalg M F) (\<lambda>x. \<bar>f x\<bar> powr p2)\<close> assms integrableD(1) integral_subalgebra2 measurable_in_subalg')
     qed
   qed
   show "space\<^sub>N ((\<LL> p (restr_to_subalg M F))) \<subseteq> space\<^sub>N (\<LL> p M)" using * by auto
   show "Norm (\<LL> p M) f = Norm (\<LL> p (restr_to_subalg M F)) f" if "f \<in> space\<^sub>N ((\<LL> p (restr_to_subalg M F)))" for f
     using * that by auto
   show "eNorm (\<LL> p M) f \<le> eNorm (\<LL> p (restr_to_subalg M F)) f" for f
     by (metis "*" eNorm_Norm eq_iff infinity_ennreal_def less_imp_le spaceN_iff top.not_eq_extremum)
   then show "(\<LL> p (restr_to_subalg M F)) \<subseteq>\<^sub>N \<LL> p M"
     by (metis ennreal_1 mult.left_neutral quasinorm_subsetI)
 qed
 
 text \<open>For $p \geq 1$, the conditional expectation of an $L^p$ function still belongs to $L^p$,
 with an $L^p$ norm which is bounded by the norm of the original function. This is wrong for
 $p < 1$. One can prove this separating the cases and using the conditional version of Jensen's
 inequality, but it is much more efficient to do it with duality arguments, as follows.\<close>
 
 proposition Lp_real_cond_exp:
   assumes [simp]: "subalgebra M F"
       and "p \<ge> (1::ennreal)"
           "sigma_finite_measure (restr_to_subalg M F)"
           "f \<in> space\<^sub>N (\<LL> p M)"
   shows "real_cond_exp M F f \<in> space\<^sub>N (\<LL> p (restr_to_subalg M F))"
         "Norm (\<LL> p (restr_to_subalg M F)) (real_cond_exp M F f) \<le> Norm (\<LL> p M) f"
 proof -
   have [measurable]: "f \<in> borel_measurable M" using Lp_measurable assms by auto
   define q where "q = conjugate_exponent p"
   have "1/p + 1/q = 1" unfolding q_def using conjugate_exponent_ennreal[OF \<open>p \<ge> 1\<close>] by simp
   have "eNorm (\<LL> p (restr_to_subalg M F)) (real_cond_exp M F f)
     = (SUP g\<in>{g \<in> space\<^sub>N (\<LL> q (restr_to_subalg M F)). Norm (\<LL> q (restr_to_subalg M F)) g \<le> 1}. ennreal(\<integral>x. (real_cond_exp M F f) x * g x \<partial>(restr_to_subalg M F)))"
     by (rule Lp_Lq_duality'[OF \<open>1/p + 1/q = 1\<close> \<open>sigma_finite_measure (restr_to_subalg M F)\<close>], simp)
   also have "... \<le> (SUP g\<in>{g \<in> space\<^sub>N (\<LL> q M). Norm (\<LL> q M) g \<le> 1}. ennreal(\<integral>x. f x * g x \<partial>M))"
   proof (rule SUP_mono, auto)
     fix g assume H: "g \<in> space\<^sub>N (\<LL> q (restr_to_subalg M F))"
                     "Norm (\<LL> q (restr_to_subalg M F)) g \<le> 1"
     then have H2: "g \<in> space\<^sub>N (\<LL> q M)" "Norm (\<LL> q M) g \<le> 1"
       using Lp_subalgebra[OF \<open>subalgebra M F\<close>] by (auto simp add: subset_iff)
     have [measurable]: "g \<in> borel_measurable M" "g \<in> borel_measurable F"
       using Lp_measurable[OF H(1)] Lp_measurable[OF H2(1)] by auto
     have int: "integrable M (\<lambda>x. f x * g x)"
       using Lp_Lq_duality_bound(1)[OF \<open>1/p + 1/q = 1\<close> \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> H2(1)].
     have "(\<integral>x. (real_cond_exp M F f) x * g x \<partial>(restr_to_subalg M F)) = (\<integral>x. g x * (real_cond_exp M F f) x \<partial>M)"
       by (subst mult.commute, rule integral_subalgebra2[OF \<open>subalgebra M F\<close>], auto)
     also have "... = (\<integral>x. g x * f x \<partial>M)"
       apply (rule sigma_finite_subalgebra.real_cond_exp_intg, auto simp add: int mult.commute)
       unfolding sigma_finite_subalgebra_def using assms by auto
     finally have "ennreal (\<integral>x. (real_cond_exp M F f) x * g x \<partial>(restr_to_subalg M F)) \<le> ennreal (\<integral>x. f x * g x \<partial>M)"
       by (auto intro!: ennreal_leI simp add: mult.commute)
     then show "\<exists>m. m \<in> space\<^sub>N (\<LL> q M) \<and> Norm (\<LL> q M) m \<le> 1
         \<and> ennreal (LINT x|restr_to_subalg M F. real_cond_exp M F f x * g x) \<le> ennreal (LINT x|M. f x * m x)"
       using H2 by blast
   qed
   also have "... = eNorm (\<LL> p M) f"
     apply (rule Lp_Lq_duality'[OF \<open>1/p + 1/q = 1\<close>, symmetric], auto intro!: sigma_finite_subalgebra_is_sigma_finite[of _ F])
     unfolding sigma_finite_subalgebra_def using assms by auto
   finally have *: "eNorm (\<LL> p (restr_to_subalg M F)) (real_cond_exp M F f) \<le> eNorm (\<LL> p M) f"
     by simp
   then show a: "real_cond_exp M F f \<in> space\<^sub>N (\<LL> p (restr_to_subalg M F))"
     apply (subst spaceN_iff) using \<open>f \<in> space\<^sub>N (\<LL> p M)\<close> by (simp add: space\<^sub>N_def)
   show "Norm (\<LL> p (restr_to_subalg M F)) (real_cond_exp M F f) \<le> Norm (\<LL> p M) f"
     using * unfolding eNorm_Norm[OF \<open>f \<in> space\<^sub>N (\<LL> p M)\<close>] eNorm_Norm[OF a] by simp
 qed
 
 lemma Lp_real_cond_exp_eNorm:
   assumes [simp]: "subalgebra M F"
       and "p \<ge> (1::ennreal)"
           "sigma_finite_measure (restr_to_subalg M F)"
   shows "eNorm (\<LL> p (restr_to_subalg M F)) (real_cond_exp M F f) \<le> eNorm (\<LL> p M) f"
 proof (cases "eNorm (\<LL> p M) f = \<infinity>")
   case False
   then have *: "f \<in> space\<^sub>N (\<LL> p M)"
     unfolding spaceN_iff by (simp add: top.not_eq_extremum)
   show ?thesis
     using Lp_real_cond_exp[OF assms \<open>f \<in> space\<^sub>N (\<LL> p M)\<close>] by (subst eNorm_Norm, auto simp: \<open>f \<in> space\<^sub>N (\<LL> p M)\<close>)+
 qed (simp)
 
 end
diff --git a/thys/Markov_Models/ex/PGCL.thy b/thys/Markov_Models/ex/PGCL.thy
--- a/thys/Markov_Models/ex/PGCL.thy
+++ b/thys/Markov_Models/ex/PGCL.thy
@@ -1,262 +1,262 @@
 (* Author: Johannes Hölzl <hoelzl@in.tum.de> *)
 
 section \<open>Probabilistic Guarded Command Language (pGCL)\<close>
 
 theory PGCL
   imports "../Markov_Decision_Process"
 begin
 
 subsection \<open>Syntax\<close>
 
 datatype 's pgcl =
     Skip
   | Abort
   | Assign "'s \<Rightarrow> 's"
   | Seq "'s pgcl" "'s pgcl"
   | Par "'s pgcl" "'s pgcl"
   | If "'s \<Rightarrow> bool" "'s pgcl" "'s pgcl"
   | Prob "bool pmf" "'s pgcl" "'s pgcl"
   | While "'s \<Rightarrow> bool" "'s pgcl"
 
 subsection \<open>Denotational Semantics\<close>
 
 primrec wp :: "'s pgcl \<Rightarrow> ('s \<Rightarrow> ennreal) \<Rightarrow> ('s \<Rightarrow> ennreal)" where
   "wp Skip f          = f"
 | "wp Abort f         = (\<lambda>_. 0)"
 | "wp (Assign u) f    = f \<circ> u"
 | "wp (Seq c\<^sub>1 c\<^sub>2) f    = wp c\<^sub>1 (wp c\<^sub>2 f)"
 | "wp (If b c\<^sub>1 c\<^sub>2) f   = (\<lambda>s. if b s then wp c\<^sub>1 f s else wp c\<^sub>2 f s)"
 | "wp (Par c\<^sub>1 c\<^sub>2) f    = wp c\<^sub>1 f \<sqinter> wp c\<^sub>2 f"
 | "wp (Prob p c\<^sub>1 c\<^sub>2) f = (\<lambda>s. pmf p True * wp c\<^sub>1 f s + pmf p False * wp c\<^sub>2 f s)"
 | "wp (While b c) f   = lfp (\<lambda>X s. if b s then wp c X s else f s)"
 
 lemma wp_mono: "mono (wp c)"
   by (induction c)
-     (auto simp: mono_def le_fun_def intro: order_trans le_infI1 le_infI2
+     (auto simp: monotone_def le_fun_def intro: order_trans le_infI1 le_infI2
            intro!: add_mono mult_left_mono lfp_mono[THEN le_funD])
 
 abbreviation det :: "'s pgcl \<Rightarrow> 's \<Rightarrow> ('s pgcl \<times> 's) pmf set" ("\<lless> _, _ \<ggreater>") where
   "det c s \<equiv> {return_pmf (c, s)}"
 
 subsection \<open>Operational Semantics\<close>
 
 fun step :: "('s pgcl \<times> 's) \<Rightarrow> ('s pgcl \<times> 's) pmf set" where
   "step (Skip, s)        = \<lless>Skip, s\<ggreater>"
 | "step (Abort, s)       = \<lless>Abort, s\<ggreater>"
 | "step (Assign u, s)    = \<lless>Skip, u s\<ggreater>"
 | "step (Seq c\<^sub>1 c\<^sub>2, s)    = (map_pmf (\<lambda>(p1', s'). (if p1' = Skip then c\<^sub>2 else Seq p1' c\<^sub>2, s'))) ` step (c\<^sub>1, s)"
 | "step (If b c\<^sub>1 c\<^sub>2, s)   = (if b s then \<lless>c\<^sub>1, s\<ggreater> else \<lless>c\<^sub>2, s\<ggreater>)"
 | "step (Par c\<^sub>1 c\<^sub>2, s)    = \<lless>c\<^sub>1, s\<ggreater> \<union> \<lless>c\<^sub>2, s\<ggreater>"
 | "step (Prob p c\<^sub>1 c\<^sub>2, s) = {map_pmf (\<lambda>b. if b then (c\<^sub>1, s) else (c\<^sub>2, s)) p}"
 | "step (While b c, s)   = (if b s then \<lless>Seq c (While b c), s\<ggreater> else \<lless>Skip, s\<ggreater>)"
 
 lemma step_finite: "finite (step x)"
   by (induction x rule: step.induct) simp_all
 
 lemma step_non_empty: "step x \<noteq> {}"
   by (induction x rule: step.induct) simp_all
 
 interpretation step: Markov_Decision_Process step
   proof qed (rule step_non_empty)
 
 definition rF :: "('s \<Rightarrow> ennreal) \<Rightarrow> (('s pgcl \<times> 's) stream \<Rightarrow> ennreal) \<Rightarrow> ('s pgcl \<times> 's) stream \<Rightarrow> ennreal" where
   "rF f F \<omega> = (if fst (shd \<omega>) = Skip then f (snd (shd \<omega>)) else F (stl \<omega>))"
 
 abbreviation r :: "('s \<Rightarrow> ennreal) \<Rightarrow> ('s pgcl \<times> 's) stream \<Rightarrow> ennreal" where
   "r f \<equiv> lfp (rF f)"
 
 lemma continuous_rF: "sup_continuous (rF f)"
   unfolding rF_def[abs_def]
   by (auto simp: sup_continuous_def fun_eq_iff SUP_sup_distrib [symmetric] image_comp
            split: prod.splits pgcl.splits)
 
 lemma mono_rF: "mono (rF f)"
   using continuous_rF by (rule sup_continuous_mono)
 
 lemma r_unfold: "r f \<omega> = (if fst (shd \<omega>) = Skip then f (snd (shd \<omega>)) else r f (stl \<omega>))"
   by (subst lfp_unfold[OF mono_rF]) (simp add: rF_def)
 
 lemma mono_r: "F \<le> G \<Longrightarrow> r F \<omega> \<le> r G \<omega>"
   by (rule le_funD[of _ _ \<omega>], rule lfp_mono)
      (auto intro!: lfp_mono simp: rF_def le_fun_def max.coboundedI2)
 
 lemma measurable_rF:
   assumes F[measurable]: "F \<in> borel_measurable step.St"
   shows "rF f F \<in> borel_measurable step.St"
   unfolding rF_def[abs_def]
   apply measurable
   apply (rule measurable_compose[OF measurable_shd])
   apply measurable []
   apply (rule measurable_compose[OF measurable_stl])
   apply measurable []
   apply (rule predE)
   apply (rule measurable_compose[OF measurable_shd])
   apply measurable
   done
 
 lemma measurable_r[measurable]: "r f \<in> borel_measurable step.St"
   using continuous_rF measurable_rF by (rule borel_measurable_lfp)
 
 lemma mono_r': "mono (\<lambda>F s. \<Sqinter>D\<in>step s. \<integral>\<^sup>+ t. (if fst t = Skip then f (snd t) else F t) \<partial>measure_pmf D)"
   by (auto intro!: monoI le_funI INF_mono[OF bexI] nn_integral_mono simp: le_fun_def)
 
 lemma E_inf_r:
   "step.E_inf s (r f) =
     lfp (\<lambda>F s. \<Sqinter>D\<in>step s. \<integral>\<^sup>+ t. (if fst t = Skip then f (snd t) else F t) \<partial>measure_pmf D) s"
 proof -
   have "step.E_inf s (r f) =
     lfp (\<lambda>F s. \<Sqinter>D\<in>step s. \<integral>\<^sup>+ t. (if fst t = Skip then f (snd t) else F t) \<partial>measure_pmf D) s"
     unfolding rF_def[abs_def]
   proof (rule step.E_inf_lfp[THEN fun_cong])
     let ?F = "\<lambda>t x. (if fst t = Skip then f (snd t) else x)"
     show "(\<lambda>(s, x). ?F s x) \<in> borel_measurable (count_space UNIV \<Otimes>\<^sub>M borel)"
       apply (simp add: measurable_split_conv split_beta')
       apply (intro borel_measurable_max borel_measurable_const measurable_If predE
          measurable_compose[OF measurable_snd] measurable_compose[OF measurable_fst])
       apply measurable
       done
     show "\<And>s. sup_continuous (?F s)"
       by (auto simp: sup_continuous_def SUP_sup_distrib[symmetric] split: prod.split pgcl.split)
     show "\<And>F cfg. (\<integral>\<^sup>+\<omega>. ?F (state cfg) (F \<omega>) \<partial>step.T cfg) =
       ?F (state cfg) (nn_integral (step.T cfg) F)"
       by (auto simp: split: pgcl.split prod.split)
   qed (rule step_finite)
   then show ?thesis
     by simp
 qed
 
 lemma E_inf_r_unfold:
   "step.E_inf s (r f) = (\<Sqinter>D\<in>step s. \<integral>\<^sup>+ t. (if fst t = Skip then f (snd t) else step.E_inf t (r f)) \<partial>measure_pmf D)"
   unfolding E_inf_r by (simp add: lfp_unfold[OF mono_r'])
 
 lemma E_inf_r_induct[consumes 1, case_names step]:
   assumes "P s y"
   assumes *: "\<And>F s y. P s y \<Longrightarrow>
     (\<And>s y. P s y \<Longrightarrow> F s \<le> y) \<Longrightarrow> (\<And>s. F s \<le> step.E_inf s (r f)) \<Longrightarrow>
     (\<Sqinter>D\<in>step s. \<integral>\<^sup>+ t. (if fst t = Skip then f (snd t) else F t) \<partial>measure_pmf D) \<le> y"
   shows "step.E_inf s (r f) \<le> y"
   using \<open>P s y\<close>
   unfolding E_inf_r
 proof (induction arbitrary: s y rule: lfp_ordinal_induct[OF mono_r'[where f=f]])
   case (1 F) with *[of s y F] show ?case
     unfolding le_fun_def E_inf_r[where f=f, symmetric] by simp
 qed (auto intro: SUP_least)
 
 lemma E_inf_Skip: "step.E_inf (Skip, s) (r f) = f s"
   by (subst E_inf_r_unfold) simp
 
 lemma E_inf_Seq:
   assumes [simp]: "\<And>x. 0 \<le> f x"
   shows "step.E_inf (Seq a b, s) (r f) = step.E_inf (a, s) (r (\<lambda>s. step.E_inf (b, s) (r f)))"
 proof (rule antisym)
   show "step.E_inf (Seq a b, s) (r f) \<le> step.E_inf (a, s) (r (\<lambda>s. step.E_inf (b, s) (r f)))"
   proof (coinduction arbitrary: a s rule: E_inf_r_induct)
     case step then show ?case
       by (rewrite in "_ \<le> \<hole>" E_inf_r_unfold)
          (force intro!: INF_mono[OF bexI] nn_integral_mono intro: le_infI2
                 simp: E_inf_Skip image_comp)
   qed
   show "step.E_inf (a, s) (r (\<lambda>s. step.E_inf (b, s) (r f))) \<le> step.E_inf (Seq a b, s) (r f)"
   proof (coinduction arbitrary: a s rule: E_inf_r_induct)
     case step then show ?case
       by (rewrite in "_ \<le> \<hole>" E_inf_r_unfold)
          (force intro!: INF_mono[OF bexI] nn_integral_mono intro: le_infI2
                 simp: E_inf_Skip image_comp)
    qed
 qed
 
 lemma E_inf_While:
   "step.E_inf (While g c, s) (r f) =
     lfp (\<lambda>F s. if g s then step.E_inf (c, s) (r F) else f s) s"
 proof (rule antisym)
   have E_inf_While_step: "step.E_inf (While g c, s) (r f) =
     (if g s then step.E_inf (c, s) (r (\<lambda>s. step.E_inf (While g c, s) (r f))) else f s)" for f s
     by (rewrite E_inf_r_unfold) (simp add: min_absorb1 E_inf_Seq)
 
   have "mono (\<lambda>F s. if g s then step.E_inf (c, s) (r F) else f s)" (is "mono ?F")
     by (auto intro!: mono_r step.E_inf_mono simp: mono_def le_fun_def max.coboundedI2)
   then show "lfp ?F s \<le> step.E_inf (While g c, s) (r f)"
   proof (induction arbitrary: s rule: lfp_ordinal_induct[consumes 1])
     case mono then show ?case
       by (rewrite E_inf_While_step) (auto intro!: step.E_inf_mono mono_r le_funI)
   qed (auto intro: SUP_least)
 
   define w where "w F s = (\<Sqinter>D\<in>step s. \<integral>\<^sup>+ t. (if fst t = Skip then if g (snd t) then F (c, snd t) else f (snd t) else F t) \<partial>measure_pmf D)"
     for F s
   have "mono w"
     by (auto simp: w_def mono_def le_fun_def intro!: INF_mono[OF bexI] nn_integral_mono) []
 
   define d where "d = c"
   define t where "t = Seq d (While g c)"
   then have "(t = While g c \<and> d = c \<and> g s) \<or> t = Seq d (While g c)"
     by auto
   then have "step.E_inf (t, s) (r f) \<le> lfp w (d, s)"
   proof (coinduction arbitrary: t d s rule: E_inf_r_induct)
     case (step F t d s)
     from step(1)
     show ?case
     proof (elim conjE disjE)
       { fix s have "\<not> g s \<Longrightarrow> F (While g c, s) \<le> f s"
           using step(3)[of "(While g c, s)"] by (simp add: E_inf_While_step) }
       note [simp] = this
       assume "t = Seq d (While g c)" then show ?thesis
         by (rewrite lfp_unfold[OF \<open>mono w\<close>])
            (auto simp: max.absorb2 w_def intro!: INF_mono[OF bexI] nn_integral_mono step)
     qed (auto intro!: step)
   qed
   also have "lfp w = lfp (\<lambda>F s. step.E_inf s (r (\<lambda>s. if g s then F (c, s) else f s)))"
     unfolding E_inf_r w_def
     by (rule lfp_lfp[symmetric]) (auto simp: le_fun_def intro!: INF_mono[OF bexI] nn_integral_mono)
   finally have "step.E_inf (While g c, s) (r f) \<le> (if g s then \<dots> (c, s) else f s)"
     unfolding t_def d_def by (rewrite E_inf_r_unfold) simp
   also have "\<dots> = lfp ?F s"
     by (rewrite lfp_rolling[symmetric, of "\<lambda>F s. if g s then F (c, s) else f s"  "\<lambda>F s. step.E_inf s (r F)"])
        (auto simp: mono_def le_fun_def sup_apply[abs_def] if_distrib[of "max 0"] max.coboundedI2 max.absorb2
                 intro!: step.E_inf_mono mono_r cong del: if_weak_cong)
   finally show "step.E_inf (While g c, s) (r f) \<le> \<dots>"
     .
 qed
 
 subsection \<open>Equate Both Semantics\<close>
 
 lemma E_inf_r_eq_wp: "step.E_inf (c, s) (r f) = wp c f s"
 proof (induction c arbitrary: f s)
   case Skip then show ?case
     by (simp add: E_inf_Skip)
 next
   case Abort then show ?case
   proof (intro antisym)
     have "lfp (\<lambda>F s. \<Sqinter>D\<in>step s. \<integral>\<^sup>+ t. (if fst t = Skip then f (snd t) else F t) \<partial>measure_pmf D) \<le>
       (\<lambda>s. if \<exists>t. s = (Abort, t) then 0 else \<top>)"
       by (intro lfp_lowerbound) (auto simp: le_fun_def)
     then show "step.E_inf (Abort, s) (r f) \<le> wp Abort f s"
       by (auto simp: E_inf_r le_fun_def split: if_split_asm)
   qed simp
 next
   case Assign then show ?case
     by (rewrite E_inf_r_unfold) (simp add: min_absorb1)
 next
   case (If b c1 c2) then show ?case
     by (rewrite E_inf_r_unfold) auto
 next
   case (Prob p c1 c2) then show ?case
     apply (rewrite E_inf_r_unfold)
     apply auto
     apply (rewrite nn_integral_measure_pmf_support[of "UNIV::bool set"])
     apply (auto simp: UNIV_bool ac_simps)
     done
 next
   case (Par c1 c2) then show ?case
     by (rewrite E_inf_r_unfold) (auto intro: inf.commute)
 next
   case (Seq c1 c2) then show ?case
     by (simp add: E_inf_Seq)
 next
   case (While g c) then show ?case
     apply (simp add: E_inf_While)
     apply (rewrite While)
     apply auto
     done
 qed
 
 end
diff --git a/thys/MonoBoolTranAlgebra/Mono_Bool_Tran_Algebra.thy b/thys/MonoBoolTranAlgebra/Mono_Bool_Tran_Algebra.thy
--- a/thys/MonoBoolTranAlgebra/Mono_Bool_Tran_Algebra.thy
+++ b/thys/MonoBoolTranAlgebra/Mono_Bool_Tran_Algebra.thy
@@ -1,961 +1,962 @@
 section \<open>Algebra of Monotonic Boolean Transformers\<close>
 
 theory  Mono_Bool_Tran_Algebra
 imports Mono_Bool_Tran
 begin
 
 text\<open>
 In this section we introduce the {\em algebra of monotonic boolean transformers}.
 This is a bounded distributive lattice with a monoid operation, a
 dual operator and an iteration operator. The standard model for this
 algebra is the set of monotonic boolean transformers introduced
 in the previous section. 
 \<close>
 
 class dual = 
   fixes dual::"'a \<Rightarrow> 'a" ("_ ^ o" [81] 80)
 
 class omega = 
   fixes omega::"'a \<Rightarrow> 'a" ("_ ^ \<omega>" [81] 80)
 
 class star = 
   fixes star::"'a \<Rightarrow> 'a" ("(_ ^ *)" [81] 80)
 
 class dual_star = 
   fixes dual_star::"'a \<Rightarrow> 'a" ("(_ ^ \<otimes>)" [81] 80)
 
 class mbt_algebra = monoid_mult + dual + omega + distrib_lattice + order_top + order_bot + star + dual_star +
   assumes
       dual_le: "(x \<le> y) = (y ^ o \<le> x ^ o)"
   and dual_dual [simp]: "(x ^ o) ^ o = x"
   and dual_comp: "(x * y) ^ o = x ^ o * y ^ o"
   and dual_one [simp]: "1 ^ o = 1"
   and top_comp [simp]: "\<top> * x = \<top>"
   and inf_comp: "(x \<sqinter> y) * z = (x * z) \<sqinter> (y * z)"
   and le_comp: "x \<le> y \<Longrightarrow> z * x \<le> z * y"
   and dual_neg: "(x * \<top>) \<sqinter> (x ^ o * \<bottom>) = \<bottom>"
   and omega_fix: "x ^ \<omega> = (x * (x ^ \<omega>)) \<sqinter> 1"
   and omega_least: "(x * z) \<sqinter> y \<le> z \<Longrightarrow> (x ^ \<omega>) * y \<le> z"
   and star_fix: "x ^ * = (x * (x ^ *)) \<sqinter> 1"
   and star_greatest: "z \<le> (x * z) \<sqinter> y \<Longrightarrow> z \<le> (x ^ *) * y"
   and dual_star_def: "(x ^ \<otimes>) = (((x ^ o) ^ *) ^ o)"
 begin
 
 lemma le_comp_right: "x \<le> y \<Longrightarrow> x * z \<le> y * z"
   apply (cut_tac x = x and y = y and z = z in inf_comp)
   apply (simp add: inf_absorb1)
   apply (subgoal_tac "x * z \<sqinter> (y * z) \<le> y * z")
   apply simp
   by (rule inf_le2)
 
 subclass bounded_lattice
   proof qed
 
 end
 
 instantiation MonoTran :: (complete_boolean_algebra) mbt_algebra
 begin
 
 lift_definition dual_MonoTran :: "'a MonoTran \<Rightarrow> 'a MonoTran"
   is dual_fun
   by (fact mono_dual_fun)
 
 lift_definition omega_MonoTran :: "'a MonoTran \<Rightarrow> 'a MonoTran"
   is omega_fun
   by (fact mono_omega_fun)
 
 lift_definition star_MonoTran :: "'a MonoTran \<Rightarrow> 'a MonoTran"
   is star_fun
   by (fact mono_star_fun)
 
 definition dual_star_MonoTran :: "'a MonoTran \<Rightarrow> 'a MonoTran"
 where
   "(x::('a MonoTran)) ^ \<otimes> = ((x ^ o) ^ *) ^ o"
   
 instance proof
   fix x y :: "'a MonoTran" show "(x \<le> y) = (y ^ o \<le> x ^ o)"
     apply transfer
     apply (auto simp add: fun_eq_iff le_fun_def)
     apply (drule_tac x = "-xa" in spec)
     apply simp
     done
 next
   fix x :: "'a MonoTran" show "(x ^ o) ^ o = x"
     apply transfer
     apply (simp add: fun_eq_iff)
     done
 next
   fix x y :: "'a MonoTran" show "(x * y) ^ o = x ^ o * y ^ o"
     apply transfer
     apply (simp add: fun_eq_iff)
     done
 next
   show "(1::'a MonoTran) ^ o = 1"
     apply transfer
     apply (simp add: fun_eq_iff)
     done
 next
   fix x :: "'a MonoTran" show "\<top> * x = \<top>"
     apply transfer
     apply (simp add: fun_eq_iff)
     done
 next
   fix x y z :: "'a MonoTran" show "(x \<sqinter> y) * z = (x * z) \<sqinter> (y * z)"
     apply transfer
     apply (simp add: fun_eq_iff)
     done
 next
   fix x y z :: "'a MonoTran" assume A: "x \<le> y" from A show " z * x \<le> z * y"
     apply transfer
     apply (auto simp add: le_fun_def elim: monoE)
     done
 next
   fix x :: "'a MonoTran" show "x * \<top> \<sqinter> (x ^ o * \<bottom>) = \<bottom>"
     apply transfer
     apply (simp add: fun_eq_iff)
     done
 next
   fix x :: "'a MonoTran" show "x ^ \<omega> = x * x ^ \<omega> \<sqinter> 1"
     apply transfer
     apply (simp add: fun_eq_iff)
     apply (simp add: omega_fun_def Omega_fun_def)
     apply (subst lfp_unfold, simp_all add: ac_simps)
     apply (auto intro!: mono_comp mono_comp_fun)
     done
 next
   fix x y z :: "'a MonoTran" assume A: "x * z \<sqinter> y \<le> z" from A show "x ^ \<omega> * y \<le> z"
     apply transfer
     apply (auto simp add: lfp_omega lfp_def)
     apply (rule Inf_lower)
     apply (auto simp add: Omega_fun_def ac_simps)
     done
 next
   fix x :: "'a MonoTran" show "x ^ * = x * x ^ * \<sqinter> 1"
     apply transfer
     apply (auto simp add: star_fun_def Omega_fun_def)
     apply (subst gfp_unfold, simp_all add: ac_simps)
     apply (auto intro!: mono_comp mono_comp_fun)
     done
 next
   fix x y z :: "'a MonoTran" assume A: "z \<le> x * z \<sqinter> y" from A show "z \<le> x ^ * * y"
     apply transfer
     apply (auto simp add: gfp_star gfp_def)
     apply (rule Sup_upper)
     apply (auto simp add: Omega_fun_def)
     done
 next
   fix x :: "'a MonoTran" show "x ^ \<otimes> = ((x ^ o) ^ *) ^ o"
     by (simp add: dual_star_MonoTran_def) 
 qed
 
 end
 
 context mbt_algebra begin
 
 lemma dual_top [simp]: "\<top> ^ o = \<bottom>"
   apply (rule order.antisym, simp_all)
   by (subst dual_le, simp)
 
 lemma dual_bot [simp]: "\<bottom> ^ o = \<top>"
   apply (rule order.antisym, simp_all)
   by (subst dual_le, simp)
 
 lemma dual_inf: "(x \<sqinter> y) ^ o = (x ^ o) \<squnion> (y ^ o)"
   apply (rule order.antisym, simp_all, safe)
   apply (subst dual_le, simp, safe)
   apply (subst dual_le, simp)
   apply (subst dual_le, simp)
   apply (subst dual_le, simp)
   by (subst dual_le, simp)
 
 lemma dual_sup: "(x \<squnion> y) ^ o = (x ^ o) \<sqinter> (y ^ o)"
   apply (rule order.antisym, simp_all, safe)
   apply (subst dual_le, simp)
   apply (subst dual_le, simp)
   apply (subst dual_le, simp, safe)
   apply (subst dual_le, simp)
   by (subst dual_le, simp)
 
 lemma sup_comp: "(x \<squnion> y) * z = (x * z) \<squnion> (y * z)"
   apply (subgoal_tac "((x ^ o \<sqinter> y ^ o) * z ^ o) ^ o = ((x ^ o * z ^ o) \<sqinter> (y ^ o * z ^ o)) ^ o")
   apply (simp add: dual_inf dual_comp)
   by (simp add: inf_comp)
 
 
 lemma dual_eq: "x ^ o = y ^ o \<Longrightarrow> x = y"
   apply (subgoal_tac "(x ^ o) ^ o = (y ^ o) ^ o")
   apply (subst (asm) dual_dual)
   apply (subst (asm) dual_dual)
   by simp_all
 
 lemma dual_neg_top [simp]: "(x ^ o * \<bottom>) \<squnion> (x * \<top>) = \<top>"
   apply (rule dual_eq)
   by(simp add: dual_sup dual_comp dual_neg)
 
  lemma bot_comp [simp]: "\<bottom> * x = \<bottom>"
    by (rule dual_eq, simp add: dual_comp)
 
 lemma [simp]: "(x * \<top>) * y = x * \<top>" 
   by (simp add: mult.assoc)
 
 lemma [simp]: "(x * \<bottom>) * y = x * \<bottom>" 
   by (simp add: mult.assoc)
 
 
 lemma gt_one_comp: "1 \<le> x \<Longrightarrow> y \<le> x * y"
   by (cut_tac x = 1 and y = x and z = y in le_comp_right, simp_all)
 
 
   theorem omega_comp_fix: "x ^ \<omega> * y = (x * (x ^ \<omega>) * y) \<sqinter> y"
   apply (subst omega_fix)
   by (simp add: inf_comp)
 
   theorem dual_star_fix: "x^\<otimes> = (x * (x^\<otimes>)) \<squnion> 1"
     by (metis dual_comp dual_dual dual_inf dual_one dual_star_def star_fix)
 
   theorem star_comp_fix: "x ^ * * y = (x * (x ^ *) * y) \<sqinter> y"
   apply (subst star_fix)
   by (simp add: inf_comp)
 
   theorem dual_star_comp_fix: "x^\<otimes> * y = (x * (x^\<otimes>) * y) \<squnion> y"
   apply (subst dual_star_fix)
   by (simp add: sup_comp)
 
   theorem dual_star_least: "(x * z) \<squnion> y \<le> z \<Longrightarrow> (x^\<otimes>) * y \<le> z"
     apply (subst dual_le)
     apply (simp add: dual_star_def dual_comp)
     apply (rule star_greatest)
     apply (subst dual_le)
     by (simp add: dual_inf dual_comp)
 
   lemma omega_one [simp]: "1 ^ \<omega> = \<bottom>"
     apply (rule order.antisym, simp_all)
     by (cut_tac x = "1::'a" and y = 1 and z = \<bottom> in omega_least, simp_all)
 
   lemma omega_mono: "x \<le> y \<Longrightarrow> x ^ \<omega> \<le> y ^ \<omega>"
     apply (cut_tac x = x and y = 1 and z = "y ^ \<omega>" in omega_least, simp_all)
     apply (subst (2) omega_fix, simp_all)
     apply (rule_tac y = "x * y ^ \<omega>" in order_trans, simp)
     by (rule le_comp_right, simp)
 end
 
 sublocale mbt_algebra < conjunctive "inf" "inf" "times"
 done
 sublocale mbt_algebra < disjunctive "sup" "sup" "times"
 done
 
 context mbt_algebra begin
 lemma dual_conjunctive: "x \<in> conjunctive \<Longrightarrow> x ^ o \<in> disjunctive"
   apply (simp add: conjunctive_def disjunctive_def)
   apply safe
   apply (rule dual_eq)
   by (simp add: dual_comp dual_sup)
 
 lemma dual_disjunctive: "x \<in> disjunctive \<Longrightarrow> x ^ o \<in> conjunctive"
   apply (simp add: conjunctive_def disjunctive_def)
   apply safe
   apply (rule dual_eq)
   by (simp add: dual_comp dual_inf)
 
 lemma comp_pres_conj: "x \<in> conjunctive \<Longrightarrow> y \<in> conjunctive \<Longrightarrow> x * y \<in> conjunctive"
   apply (subst conjunctive_def, safe)
   by (simp add: mult.assoc conjunctiveD)
 
 lemma comp_pres_disj: "x \<in> disjunctive \<Longrightarrow> y \<in> disjunctive \<Longrightarrow> x * y \<in> disjunctive"
   apply (subst disjunctive_def, safe)
   by (simp add: mult.assoc disjunctiveD)
 
 lemma start_pres_conj: "x \<in> conjunctive \<Longrightarrow> (x ^ *) \<in> conjunctive"
   apply (subst conjunctive_def, safe)
   apply (rule order.antisym, simp_all)
   apply (metis inf_le1 inf_le2 le_comp)
   apply (rule star_greatest)
   apply (subst conjunctiveD, simp)
   apply (subst star_comp_fix)
   apply (subst star_comp_fix)
   by (metis inf.assoc inf_left_commute mult.assoc order_refl)
 
 lemma dual_star_pres_disj: "x \<in> disjunctive \<Longrightarrow> x^\<otimes> \<in> disjunctive"
   apply (simp add: dual_star_def)
   apply (rule dual_conjunctive)
   apply (rule start_pres_conj)
   by (rule dual_disjunctive, simp)
 
 subsection\<open>Assertions\<close>
 
 text\<open>
 Usually, in Kleene algebra with tests or in other progrm algebras, tests or assertions
 or assumptions are defined using an existential quantifier. An element of the algebra
 is a test if it has a complement with respect to $\bot$ and $1$. In this formalization
 assertions can be defined much simpler using the dual operator.
 \<close>
 
 definition
    "assertion = {x . x \<le> 1 \<and> (x * \<top>) \<sqinter> (x ^ o) = x}"
 
 lemma assertion_prop: "x \<in> assertion \<Longrightarrow> (x * \<top>) \<sqinter> 1 = x"
   apply (simp add: assertion_def)
   apply safe
   apply (rule order.antisym)
   apply simp_all
   proof -
     assume [simp]: "x \<le> 1"
     assume A: "x * \<top> \<sqinter> x ^ o = x"
     have "x * \<top> \<sqinter> 1 \<le> x * \<top> \<sqinter> x ^ o"
       apply simp
       apply (rule_tac y = 1 in order_trans)
       apply simp
       apply (subst dual_le)
       by simp
     also have "\<dots> = x" by (cut_tac A, simp)
     finally show "x * \<top> \<sqinter> 1 \<le> x" .
   next
     assume A: "x * \<top> \<sqinter> x ^ o = x"
     have "x = x * \<top> \<sqinter> x ^ o" by (simp add: A)
     also have "\<dots> \<le> x * \<top>" by simp
     finally show "x \<le> x * \<top>" .
   qed
 
 lemma dual_assertion_prop: "x \<in> assertion \<Longrightarrow> ((x ^ o) * \<bottom>) \<squnion> 1 = x ^ o"
   apply (rule dual_eq)
   by (simp add: dual_sup dual_comp assertion_prop)
 
 lemma assertion_disjunctive: "x \<in> assertion \<Longrightarrow> x \<in> disjunctive"
   apply (simp add: disjunctive_def, safe)
   apply (drule assertion_prop)
   proof -
     assume A: "x * \<top> \<sqinter> 1 = x"
     fix y z::"'a"
     have "x * (y \<squnion> z) = (x * \<top> \<sqinter> 1) * (y \<squnion> z)" by (cut_tac  A, simp)
     also have "\<dots> = (x * \<top>) \<sqinter> (y \<squnion> z)" by (simp add: inf_comp)
     also have "\<dots> = ((x * \<top>) \<sqinter> y) \<squnion> ((x * \<top>) \<sqinter> z)" by (simp add: inf_sup_distrib)
     also have "\<dots> = (((x * \<top>) \<sqinter> 1) * y) \<squnion> (((x * \<top>) \<sqinter> 1) * z)" by (simp add: inf_comp)
     also have "\<dots> = x * y \<squnion> x * z" by (cut_tac  A, simp)
     finally show "x * (y \<squnion> z) = x * y \<squnion> x * z" .
   qed
 
 lemma Abs_MonoTran_injective: "mono x \<Longrightarrow> mono y \<Longrightarrow> Abs_MonoTran x = Abs_MonoTran y \<Longrightarrow> x = y"
   apply (subgoal_tac "Rep_MonoTran (Abs_MonoTran x) = Rep_MonoTran (Abs_MonoTran y)")
   apply (subst (asm) Abs_MonoTran_inverse, simp)
   by (subst (asm) Abs_MonoTran_inverse, simp_all)
 end
 
 lemma mbta_MonoTran_disjunctive: "Rep_MonoTran ` disjunctive = Apply.disjunctive"
   apply (simp add: disjunctive_def Apply.disjunctive_def)
   apply transfer
   apply auto
   proof -
     fix f :: "'a \<Rightarrow> 'a" and a b
     assume prem: "\<forall>y. mono y \<longrightarrow> (\<forall>z. mono z \<longrightarrow> f \<circ> y \<squnion> z = (f \<circ> y) \<squnion> (f \<circ> z))"
     { fix g h :: "'b \<Rightarrow> 'a"
       assume "mono g" and "mono h"
       then have "f \<circ> g \<squnion> h = (f \<circ> g) \<squnion> (f \<circ> h)"
         using prem by blast
     } note * = this
     assume "mono f"
     show "f (a \<squnion> b) = f a \<squnion> f b" (is "?P = ?Q")
     proof (rule order_antisym)
       show "?P \<le> ?Q"
         using * [of "\<lambda>_. a" "\<lambda>_. b"] by (simp add: comp_def fun_eq_iff)
     next
-      from \<open>mono f\<close> show "?Q \<le> ?P" by (rule Lattices.semilattice_sup_class.mono_sup)
+      from \<open>mono f\<close> show "?Q \<le> ?P"
+        using Fun.semilattice_sup_class.mono_sup by blast
     qed
   next
     fix f :: "'a \<Rightarrow> 'a"
     assume "\<forall>y z. f (y \<squnion> z) = f y \<squnion> f z"
     then have *: "\<And>y z. f (y \<squnion> z) = f y \<squnion> f z" by blast
     show "mono f"
     proof
       fix a b :: 'a
       assume "a \<le> b"
       then show "f a \<le> f b"
         unfolding sup.order_iff * [symmetric] by simp
     qed
   qed
 
 lemma assertion_MonoTran: "assertion = Abs_MonoTran ` assertion_fun"
     apply (safe)
     apply (subst assertion_fun_disj_less_one)
     apply (simp add: image_def)
     apply (rule_tac x = "Rep_MonoTran x" in bexI)
     apply (simp add: Rep_MonoTran_inverse)
     apply safe
     apply (drule assertion_disjunctive)
     apply (unfold mbta_MonoTran_disjunctive [THEN sym], simp)
     apply (simp add: assertion_def less_eq_MonoTran_def one_MonoTran_def Abs_MonoTran_inverse)
     apply (simp add: assertion_def)
     by (simp_all add: inf_MonoTran_def less_eq_MonoTran_def 
       times_MonoTran_def dual_MonoTran_def top_MonoTran_def Abs_MonoTran_inverse one_MonoTran_def assertion_fun_dual)
 
 context mbt_algebra begin
 lemma assertion_conjunctive: "x \<in> assertion \<Longrightarrow> x \<in> conjunctive"
   apply (simp add: conjunctive_def, safe)
   apply (drule assertion_prop)
   proof -
     assume A: "x * \<top> \<sqinter> 1 = x"
     fix y z::"'a"
     have "x * (y \<sqinter> z) = (x * \<top> \<sqinter> 1) * (y \<sqinter> z)" by (cut_tac  A, simp)
     also have "\<dots> = (x * \<top>) \<sqinter> (y \<sqinter> z)" by (simp add: inf_comp)
     also have "\<dots> = ((x * \<top>) \<sqinter> y) \<sqinter> ((x * \<top>) \<sqinter> z)"
       apply (rule order.antisym, simp_all, safe)
       apply (rule_tac y = "y \<sqinter> z" in order_trans)
       apply (rule inf_le2)
       apply simp
       apply (rule_tac y = "y \<sqinter> z" in order_trans)
       apply (rule inf_le2)
       apply simp_all
       apply (simp add: inf_assoc)
       apply (rule_tac y = " x * \<top> \<sqinter> y" in order_trans)
       apply (rule inf_le1)
       apply simp
       apply (rule_tac y = " x * \<top> \<sqinter> z" in order_trans)
       apply (rule inf_le2)
       by simp
     also have "\<dots> = (((x * \<top>) \<sqinter> 1) * y) \<sqinter> (((x * \<top>) \<sqinter> 1) * z)" by (simp add: inf_comp)
     also have "\<dots> = (x * y) \<sqinter> (x * z)" by (cut_tac  A, simp)
     finally show "x * (y \<sqinter> z) = (x * y) \<sqinter> (x * z)" .
   qed
 
 lemma dual_assertion_conjunctive: "x \<in> assertion \<Longrightarrow> x ^ o \<in> conjunctive"
   apply (drule assertion_disjunctive)
   by (rule dual_disjunctive, simp)
 
 lemma dual_assertion_disjunct: "x \<in> assertion \<Longrightarrow> x ^ o \<in> disjunctive"
   apply (drule assertion_conjunctive)
   by (rule dual_conjunctive, simp)
 
 
 lemma [simp]: "x \<in> assertion \<Longrightarrow> y \<in> assertion \<Longrightarrow> x \<sqinter> y \<le> x * y"
   apply (simp add: assertion_def, safe)
   proof -
   assume A: "x \<le> 1"
   assume B: "x * \<top> \<sqinter> x ^ o = x"
   assume C: "y \<le> 1"
   assume D: "y * \<top> \<sqinter> y ^ o = y"
   have "x \<sqinter> y = (x * \<top> \<sqinter> x ^ o) \<sqinter> (y * \<top> \<sqinter> y ^ o)" by (cut_tac B D, simp)
   also have "\<dots> \<le> (x * \<top>) \<sqinter> (((x^o) * (y * \<top>)) \<sqinter> ((x^o) * (y^o)))"
     apply (simp, safe)
       apply (rule_tac y = "x * \<top> \<sqinter> x ^ o" in order_trans)
       apply (rule inf_le1)
       apply simp
       apply (rule_tac y = "y * \<top>" in order_trans)
       apply (rule_tac y = "y * \<top> \<sqinter> y ^ o" in order_trans)
       apply (rule inf_le2)
       apply simp
       apply (rule gt_one_comp)
       apply (subst dual_le, simp add: A)
       apply (rule_tac y = "y ^ o" in order_trans)
       apply (rule_tac y = "y * \<top> \<sqinter> y ^ o" in order_trans)
       apply (rule inf_le2)
       apply simp
       apply (rule gt_one_comp)
       by (subst dual_le, simp add: A)
     also have "... = ((x * \<top>) \<sqinter> (x ^ o)) * ((y * \<top>) \<sqinter> (y ^ o))"
       apply (cut_tac x = x in dual_assertion_conjunctive)
       apply (cut_tac A, cut_tac B, simp add: assertion_def)
       by (simp add: inf_comp conjunctiveD)
     also have "... = x * y"
       by (cut_tac B, cut_tac D, simp)
     finally show "x \<sqinter> y \<le> x * y" .
   qed
     
 lemma [simp]: "x \<in> assertion \<Longrightarrow> x * y \<le> y"
   by (unfold assertion_def, cut_tac x = x and y = 1 and z = y in le_comp_right, simp_all)
 
 
 lemma [simp]: "x \<in> assertion \<Longrightarrow> y \<in> assertion \<Longrightarrow> x * y \<le> x"
   apply (subgoal_tac "x * y \<le> (x * \<top>) \<sqinter> (x ^ o)")
   apply (simp add: assertion_def) 
   apply (simp, safe)
   apply (rule le_comp, simp)
   apply (rule_tac y = 1 in order_trans)
   apply (rule_tac y = y in order_trans)
   apply simp
   apply (simp add: assertion_def)
   by (subst dual_le, simp add: assertion_def)
 
 lemma assertion_inf_comp_eq: "x \<in> assertion \<Longrightarrow> y \<in> assertion \<Longrightarrow> x \<sqinter> y = x * y"
   by (rule order.antisym, simp_all)
 
 lemma one_right_assertion [simp]: "x \<in> assertion \<Longrightarrow> x * 1 = x"
   apply (drule assertion_prop)
   proof -
     assume A: "x * \<top> \<sqinter> 1 = x"
     have "x * 1 = (x * \<top> \<sqinter> 1) * 1" by (simp add: A)
     also have "\<dots> = x * \<top> \<sqinter> 1" by (simp add: inf_comp)
     also have "\<dots> = x" by (simp add: A)
     finally show ?thesis .
   qed
 
 lemma [simp]: "x \<in> assertion \<Longrightarrow> x \<squnion> 1 = 1"
   by (rule order.antisym, simp_all add: assertion_def)
   
 lemma [simp]: "x \<in> assertion \<Longrightarrow> 1 \<squnion> x = 1"
   by (rule order.antisym, simp_all add: assertion_def)
   
 lemma [simp]: "x \<in> assertion \<Longrightarrow> x \<sqinter> 1 = x"
   by (rule order.antisym, simp_all add: assertion_def)
   
 lemma [simp]: "x \<in> assertion \<Longrightarrow> 1 \<sqinter> x = x"
   by (rule order.antisym, simp_all add: assertion_def)
 
 lemma [simp]:  "x \<in> assertion \<Longrightarrow> x \<le> x * \<top>"
   by (cut_tac x = 1 and y = \<top> and z = x in le_comp, simp_all)
 
 lemma [simp]: "x \<in> assertion \<Longrightarrow> x \<le> 1"
   by (simp add: assertion_def)
 
 definition
   "neg_assert (x::'a) = (x ^ o * \<bottom>) \<sqinter> 1"
   
 
 lemma sup_uminus[simp]: "x \<in> assertion \<Longrightarrow> x \<squnion> neg_assert x = 1"
   apply (simp add: neg_assert_def)
   apply (simp add: sup_inf_distrib)
   apply (rule order.antisym, simp_all)
   apply (unfold assertion_def)
   apply safe
   apply (subst dual_le)
   apply (simp add: dual_sup dual_comp)
   apply (subst inf_commute)
   by simp
 
 lemma inf_uminus[simp]: "x \<in> assertion \<Longrightarrow> x \<sqinter> neg_assert x = \<bottom>"
   apply (simp add: neg_assert_def)
   apply (rule order.antisym, simp_all)
   apply (rule_tac y = "x \<sqinter> (x ^ o * \<bottom>)" in order_trans)
   apply simp
   apply (rule_tac y = "x ^ o * \<bottom> \<sqinter> 1" in order_trans)
   apply (rule inf_le2)
   apply simp
   apply (rule_tac y = "(x * \<top>)  \<sqinter> (x ^ o * \<bottom>)" in order_trans)
   apply simp
   apply (rule_tac y = x in order_trans)
   apply simp_all
   by (simp add: dual_neg)
 
 
 lemma uminus_assertion[simp]: "x \<in> assertion \<Longrightarrow> neg_assert x \<in> assertion"
   apply (subst assertion_def)
   apply (simp add: neg_assert_def)
   apply (simp add: inf_comp dual_inf dual_comp inf_sup_distrib)
   apply (subst inf_commute)
   by (simp add: dual_neg)
 
 lemma uminus_uminus [simp]: "x \<in> assertion \<Longrightarrow> neg_assert (neg_assert x) = x"
   apply (simp add: neg_assert_def)
   by (simp add: dual_inf dual_comp sup_comp assertion_prop)
 
 lemma dual_comp_neg [simp]: "x ^ o * y \<squnion> (neg_assert x) * \<top> = x ^ o * y"
   apply (simp add: neg_assert_def inf_comp)
   apply (rule order.antisym, simp_all)
   by (rule le_comp, simp)
 
 
 lemma [simp]: "(neg_assert x) ^ o * y \<squnion> x * \<top> = (neg_assert x) ^ o * y"
   apply (simp add: neg_assert_def inf_comp dual_inf dual_comp sup_comp)
   by (rule order.antisym, simp_all)
 
 lemma [simp]: " x * \<top> \<squnion> (neg_assert x) ^ o * y= (neg_assert x) ^ o * y"
   by (simp add: neg_assert_def inf_comp dual_inf dual_comp sup_comp)
 
 lemma inf_assertion [simp]: "x \<in> assertion \<Longrightarrow> y \<in> assertion \<Longrightarrow> x \<sqinter> y \<in> assertion"
   apply (subst assertion_def)
   apply safe
   apply (rule_tac y = x in order_trans)
   apply simp_all
   apply (simp add: assertion_inf_comp_eq)
   proof -
     assume A: "x \<in> assertion"
     assume B: "y \<in> assertion"
     have C: "(x * \<top>) \<sqinter> (x ^ o) = x"
       by (cut_tac A, unfold assertion_def, simp) 
     have D: "(y * \<top>) \<sqinter> (y ^ o) = y"
       by (cut_tac B, unfold assertion_def, simp)
     have "x * y = ((x * \<top>) \<sqinter> (x ^ o)) * ((y * \<top>) \<sqinter> (y ^ o))" by (simp add: C D)
     also have "\<dots> = x * \<top> \<sqinter> ((x ^ o) * ((y * \<top>) \<sqinter> (y ^ o)))" by (simp add: inf_comp)
     also have "\<dots> =  x * \<top> \<sqinter> ((x ^ o) * (y * \<top>)) \<sqinter> ((x ^ o) *(y ^ o))" 
       by (cut_tac A, cut_tac x = x in dual_assertion_conjunctive, simp_all add: conjunctiveD inf_assoc)
     also have "\<dots> = (((x * \<top>) \<sqinter> (x ^ o)) * (y * \<top>)) \<sqinter> ((x ^ o) *(y ^ o))"
       by (simp add: inf_comp)
     also have "\<dots> = (x * y * \<top>)  \<sqinter> ((x * y) ^ o)" by (simp add: C mult.assoc dual_comp)
     finally show "(x * y * \<top>)  \<sqinter> ((x * y) ^ o) = x * y" by simp
   qed
 
 lemma comp_assertion [simp]: "x \<in> assertion \<Longrightarrow> y \<in> assertion \<Longrightarrow> x * y \<in> assertion"
   by (subst assertion_inf_comp_eq [THEN sym], simp_all)
 
 
 lemma sup_assertion [simp]: "x \<in> assertion \<Longrightarrow> y \<in> assertion \<Longrightarrow> x \<squnion> y \<in> assertion"
   apply (subst assertion_def)
   apply safe
   apply (unfold assertion_def)
   apply simp
   apply safe
   proof -
     assume [simp]: "x \<le> 1"
     assume [simp]: "y \<le> 1"
     assume A: "x * \<top> \<sqinter> x ^ o = x"
     assume B: "y * \<top> \<sqinter> y ^ o = y"
     have "(y * \<top>) \<sqinter> (x ^ o) \<sqinter> (y ^ o) = (x ^ o) \<sqinter> (y * \<top>) \<sqinter> (y ^ o)" by (simp add: inf_commute)
     also have "\<dots> = (x ^ o) \<sqinter> ((y * \<top>) \<sqinter> (y ^ o))" by (simp add: inf_assoc)
     also have "\<dots> = (x ^ o) \<sqinter> y" by (simp add: B)
     also have "\<dots> = y"
       apply (rule order.antisym, simp_all)
       apply (rule_tac y = 1 in order_trans)
       apply simp
       by (subst dual_le, simp)
     finally have [simp]: "(y * \<top>) \<sqinter> (x ^ o) \<sqinter> (y ^ o) = y" .
     have "x * \<top> \<sqinter> (x ^ o) \<sqinter> (y ^ o) = x \<sqinter> (y ^ o)"  by (simp add: A)
     also have "\<dots> = x"
       apply (rule order.antisym, simp_all)
       apply (rule_tac y = 1 in order_trans)
       apply simp
       by (subst dual_le, simp)
     finally have [simp]: "x * \<top> \<sqinter> (x ^ o) \<sqinter> (y ^ o) = x" .
     have "(x \<squnion> y) * \<top> \<sqinter> (x \<squnion> y) ^ o = (x * \<top> \<squnion> y * \<top>) \<sqinter> ((x ^ o) \<sqinter> (y ^ o))" by (simp add: sup_comp dual_sup)
     also have "\<dots> = x \<squnion> y" by (simp add: inf_sup_distrib inf_assoc [THEN sym])
     finally show "(x \<squnion> y) * \<top> \<sqinter> (x \<squnion> y) ^ o = x \<squnion> y" .
   qed
 
 lemma [simp]: "x \<in> assertion \<Longrightarrow> x * x = x"
   by (simp add: assertion_inf_comp_eq [THEN sym])
 
 lemma [simp]: "x \<in> assertion \<Longrightarrow> (x ^ o) * (x ^ o) = x ^ o"
   apply (rule dual_eq)
   by (simp add: dual_comp assertion_inf_comp_eq [THEN sym])
 
 lemma [simp]: "x \<in> assertion \<Longrightarrow> x * (x ^ o) = x"
   proof -
     assume A: "x \<in> assertion"
     have B: "x * \<top> \<sqinter> (x ^ o) = x" by (cut_tac A, unfold assertion_def, simp)
     have "x * x ^ o = (x * \<top> \<sqinter> (x ^ o)) * x ^ o" by (simp add: B)
     also have "\<dots> = x * \<top> \<sqinter> (x ^ o)" by (cut_tac A, simp add: inf_comp)
     also have "\<dots> = x" by (simp add: B)
     finally show ?thesis .
   qed
 
 lemma [simp]: "x \<in> assertion \<Longrightarrow> (x ^ o) * x = x ^ o"
   apply (rule dual_eq)
   by (simp add: dual_comp)
 
 
 lemma [simp]: "\<bottom> \<in> assertion"
   by (unfold assertion_def, simp)
 
 lemma [simp]: "1 \<in> assertion"
   by (unfold assertion_def, simp)
 
 
 subsection \<open>Weakest precondition of true\<close>
 
 definition
   "wpt x = (x * \<top>) \<sqinter> 1"
 
 lemma wpt_is_assertion [simp]: "wpt x \<in> assertion"
   apply (unfold wpt_def assertion_def, safe)
   apply simp
   apply (simp add: inf_comp dual_inf dual_comp inf_sup_distrib)
   apply (rule order.antisym)
   by (simp_all add: dual_neg)
 
 lemma wpt_comp: "(wpt x) * x = x"
   apply (simp add: wpt_def inf_comp)
   apply (rule order.antisym, simp_all)
   by (cut_tac x = 1 and y = \<top> and z = x in le_comp, simp_all)
 
 lemma wpt_comp_2: "wpt (x * y) = wpt (x * (wpt y))"
   by (simp add: wpt_def inf_comp mult.assoc)
 
 lemma wpt_assertion [simp]: "x \<in> assertion \<Longrightarrow> wpt x = x"
   by (simp add: wpt_def assertion_prop)
 
 lemma wpt_le_assertion: "x \<in> assertion \<Longrightarrow> x * y = y \<Longrightarrow> wpt y \<le> x"
   apply (simp add: wpt_def)
   proof -
     assume A: "x \<in> assertion"
     assume B: "x * y = y"
     have "y * \<top> \<sqinter> 1 = x * (y * \<top>) \<sqinter> 1" by (simp add: B mult.assoc [THEN sym])
     also have "\<dots> \<le> x * \<top> \<sqinter> 1" 
       apply simp
       apply (rule_tac y = "x * (y * \<top>)" in order_trans)
       apply simp_all
       by (rule le_comp, simp)
     also have "\<dots> = x" by (cut_tac A, simp add: assertion_prop)
     finally show "y * \<top> \<sqinter> 1 \<le> x" .
   qed
 
 lemma wpt_choice: "wpt (x \<sqinter> y) = wpt x \<sqinter> wpt y"
   apply (simp add: wpt_def inf_comp)
   proof -
     have "x * \<top> \<sqinter> 1 \<sqinter> (y * \<top> \<sqinter> 1) = x * \<top> \<sqinter> ((y * \<top> \<sqinter> 1) \<sqinter> 1)" apply (subst inf_assoc) by (simp add: inf_commute)
     also have "... = x * \<top> \<sqinter> (y * \<top> \<sqinter> 1)" by (subst inf_assoc, simp)
     also have "... = (x * \<top>) \<sqinter> (y * \<top>) \<sqinter> 1" by (subst inf_assoc, simp)
     finally show "x * \<top> \<sqinter> (y * \<top>) \<sqinter> 1 = x * \<top> \<sqinter> 1 \<sqinter> (y * \<top> \<sqinter> 1)" by simp
   qed
 end 
 
 context lattice begin
 lemma [simp]: "x \<le> y \<Longrightarrow> x \<sqinter> y = x"
   by (simp add: inf_absorb1)
 end
 
 
 context mbt_algebra begin
 
 lemma wpt_dual_assertion_comp: "x \<in> assertion \<Longrightarrow> y \<in> assertion \<Longrightarrow> wpt ((x ^ o) * y) = (neg_assert x) \<squnion> y"
   apply (simp add: wpt_def neg_assert_def)
   proof -
     assume A: "x \<in> assertion"
     assume B: "y \<in> assertion"
     have C: "((x ^ o) * \<bottom>) \<squnion> 1 = x ^ o"
       by (rule dual_assertion_prop, rule A)
     have "x ^ o * y * \<top> \<sqinter> 1 = (((x ^ o) * \<bottom>) \<squnion> 1) * y * \<top> \<sqinter> 1" by (simp add: C)
     also have "\<dots> = ((x ^ o) * \<bottom> \<squnion> (y * \<top>)) \<sqinter> 1" by (simp add: sup_comp)
     also have "\<dots> = (((x ^ o) * \<bottom>) \<sqinter> 1) \<squnion> ((y * \<top>) \<sqinter> 1)" by (simp add: inf_sup_distrib2)
     also have "\<dots> = (((x ^ o) * \<bottom>) \<sqinter> 1) \<squnion> y" by (cut_tac B, drule assertion_prop, simp)
     finally show "x ^ o * y * \<top> \<sqinter> 1 = (((x ^ o) * \<bottom>) \<sqinter> 1) \<squnion> y" .
   qed
 
 lemma le_comp_left_right: "x \<le> y \<Longrightarrow> u \<le> v \<Longrightarrow> x * u \<le> y * v"
   apply (rule_tac y = "x * v" in order_trans)
   apply (rule le_comp, simp)
   by (rule le_comp_right, simp)
 
 lemma wpt_dual_assertion: "x \<in> assertion \<Longrightarrow> wpt (x ^ o) = 1"
   apply (simp add: wpt_def)
   apply (rule order.antisym)
   apply simp_all
   apply (cut_tac x = 1 and y = "x ^ o" and u = 1 and v = \<top> in le_comp_left_right)
   apply simp_all
   apply (subst dual_le)
   by simp
 
 lemma assertion_commute: "x \<in> assertion \<Longrightarrow> y \<in> conjunctive \<Longrightarrow> y * x = wpt(y * x) * y"
   apply (simp add: wpt_def)
   apply (simp add: inf_comp)
   apply (drule_tac x = y and y = "x * \<top>" and z = 1 in conjunctiveD)
   by (simp add: mult.assoc [THEN sym] assertion_prop)
 
 
 lemma wpt_mono: "x \<le> y \<Longrightarrow> wpt x \<le> wpt y"
   apply (simp add: wpt_def)
   apply (rule_tac y = "x * \<top>" in order_trans, simp_all)
   by (rule le_comp_right, simp)
 
 lemma "a \<in> conjunctive \<Longrightarrow> x * a \<le> a * y \<Longrightarrow> (x ^ \<omega>) * a \<le> a * (y ^ \<omega>)"
   apply (rule omega_least)
   apply (simp add: mult.assoc [THEN sym])
   apply (rule_tac y = "a * y * y ^ \<omega> \<sqinter> a" in order_trans)
   apply (simp)
   apply (rule_tac y = "x * a * y ^ \<omega>" in order_trans, simp_all)
   apply (rule le_comp_right, simp)
   apply (simp add: mult.assoc)
   apply (subst (2) omega_fix)
   by (simp add: conjunctiveD)
 
 lemma [simp]: "x \<le> 1 \<Longrightarrow> y * x \<le> y"
   by (cut_tac x = x and y = 1 and z = y in le_comp, simp_all)
 
 lemma [simp]: "x \<le> x * \<top>"
   by (cut_tac x = 1 and y = \<top> and z = x in le_comp, simp_all)
 
 lemma [simp]: "x * \<bottom> \<le> x"
   by (cut_tac x = \<bottom> and y = 1 and z = x in le_comp, simp_all)
 
 end
 
 subsection\<open>Monotonic Boolean trasformers algebra with post condition statement\<close>
 
 definition
   "post_fun (p::'a::order) q = (if p \<le> q then (\<top>::'b::{order_bot,order_top}) else \<bottom>)"
 
 lemma mono_post_fun [simp]: "mono (post_fun (p::_::{order_bot,order_top}))"
   apply (simp add: post_fun_def mono_def, safe)
   apply (subgoal_tac "p \<le> y", simp)
   apply (rule_tac y = x in order_trans)
   apply simp_all
   done
 
 lemma post_top [simp]: "post_fun p p = \<top>"
   by (simp add: post_fun_def)
 
 lemma post_refin [simp]: "mono S \<Longrightarrow> ((S p)::'a::bounded_lattice) \<sqinter> (post_fun p) x \<le> S x"
   apply (simp add: le_fun_def assert_fun_def post_fun_def, safe)
   by (rule_tac f = S in monoD, simp_all)
 
 class post_mbt_algebra = mbt_algebra +
   fixes post :: "'a \<Rightarrow> 'a"
   assumes post_1: "(post x) * x * \<top> = \<top>"
   and post_2: "y * x * \<top> \<sqinter> (post x) \<le> y"
 
 instantiation MonoTran :: (complete_boolean_algebra) post_mbt_algebra
 begin
 
 lift_definition post_MonoTran :: "'a::complete_boolean_algebra MonoTran \<Rightarrow> 'a::complete_boolean_algebra MonoTran"
   is "\<lambda>x. post_fun (x \<top>)"
   by (rule mono_post_fun)
 
 instance proof
   fix x :: "'a MonoTran" show "post x * x * \<top> = \<top>"
     apply transfer
     apply (simp add: fun_eq_iff)
     done
   fix x y :: "'a MonoTran" show "y * x * \<top> \<sqinter> post x \<le> y"
     apply transfer
     apply (simp add: le_fun_def)
     done
 qed
    
 end
 
 subsection\<open>Complete monotonic Boolean transformers algebra\<close>
 
 class complete_mbt_algebra = post_mbt_algebra + complete_distrib_lattice +
   assumes Inf_comp: "(Inf X) * z = (INF x \<in> X . (x * z))"
 
 instance MonoTran :: (complete_boolean_algebra) complete_mbt_algebra
   apply intro_classes
   apply transfer
   apply (simp add: Inf_comp_fun)
   done
 
 context complete_mbt_algebra begin
 lemma dual_Inf: "(Inf X) ^ o = (SUP x\<in> X . x ^ o)"
   apply (rule order.antisym)
   apply (subst dual_le, simp)
   apply (rule Inf_greatest)
   apply (subst dual_le, simp)
   apply (rule SUP_upper, simp)
   apply (rule SUP_least)
   apply (subst dual_le, simp)
   by (rule Inf_lower, simp)
 
 lemma dual_Sup: "(Sup X) ^ o = (INF x\<in> X . x ^ o)"
   apply (rule order.antisym)
   apply (rule INF_greatest)
   apply (subst dual_le, simp)
   apply (rule Sup_upper, simp)
   apply (subst dual_le, simp)
   apply (rule Sup_least)
   apply (subst dual_le, simp)
   by (rule INF_lower, simp)
 
 lemma INF_comp: "(\<Sqinter>(f ` A)) * z = (INF a \<in> A . (f a) * z)"
   unfolding Inf_comp
   apply (subgoal_tac "((\<lambda>x::'a. x * z) ` f ` A) = ((\<lambda>a::'b. f a * z) ` A)")
   by auto
 
 lemma dual_INF: "(\<Sqinter>(f ` A)) ^ o = (SUP a \<in> A . (f a) ^ o)"
   unfolding Inf_comp dual_Inf
   apply (subgoal_tac "(dual ` f ` A) = ((\<lambda>a::'b. f a ^ o) ` A)")
   by auto
 
 lemma dual_SUP: "(\<Squnion>(f ` A)) ^ o = (INF a \<in> A . (f a) ^ o)"
   unfolding dual_Sup
   apply (subgoal_tac "(dual ` f ` A) = ((\<lambda>a::'b. f a ^ o) ` A)")
   by auto
 
 lemma Sup_comp: "(Sup X) * z = (SUP x \<in> X . (x * z))"
   apply (rule dual_eq)
   by (simp add: dual_comp dual_Sup dual_SUP INF_comp image_comp)
 
 lemma SUP_comp: "(\<Squnion>(f ` A)) * z = (SUP a \<in> A . (f a) * z)"
   unfolding Sup_comp
   apply (subgoal_tac "((\<lambda>x::'a. x * z) ` f ` A) = ((\<lambda>a::'b. f a * z) ` A)")
   by auto
 
 
 lemma Sup_assertion [simp]: "X \<subseteq> assertion \<Longrightarrow> Sup X \<in> assertion"
   apply (unfold assertion_def)
   apply safe
   apply (rule Sup_least)
   apply blast
   apply (simp add: Sup_comp dual_Sup Sup_inf)
   apply (subgoal_tac "((\<lambda>y . y \<sqinter> \<Sqinter>(dual ` X)) ` (\<lambda>x . x * \<top>) ` X) = X")
   apply simp
   proof -
     assume A: "X \<subseteq> {x. x \<le> 1 \<and> x * \<top> \<sqinter> x ^ o = x}"
     have B [simp]: "!! x . x \<in> X \<Longrightarrow>  x * \<top> \<sqinter> (\<Sqinter>(dual ` X)) = x"
     proof -
       fix x
       assume C: "x \<in> X"
       have "x * \<top> \<sqinter> \<Sqinter>(dual ` X) = x * \<top> \<sqinter> (x ^ o \<sqinter> \<Sqinter>(dual ` X))"
         apply (subgoal_tac "\<Sqinter>(dual ` X) = (x ^ o \<sqinter> \<Sqinter>(dual ` X))", simp)
         apply (rule order.antisym, simp_all)
         apply (rule Inf_lower, cut_tac C, simp)
         done
       also have "\<dots> = x \<sqinter> \<Sqinter>(dual ` X)" by (unfold  inf_assoc [THEN sym], cut_tac A, cut_tac C, auto)
       also have "\<dots> = x"
         apply (rule order.antisym, simp_all)
         apply (rule INF_greatest)
         apply (cut_tac A C)
         apply (rule_tac y = 1 in order_trans)
         apply auto[1]
         apply (subst dual_le, auto)
         done
       finally show "x * \<top> \<sqinter> \<Sqinter>(dual ` X) = x" .
       qed
       show "(\<lambda>y. y \<sqinter> \<Sqinter>(dual ` X)) ` (\<lambda>x . x * \<top>) ` X = X"
         by (simp add: image_comp)
     qed
 
 lemma Sup_range_assertion [simp]: "(!!w . p w \<in> assertion) \<Longrightarrow> Sup (range p) \<in> assertion"
   by (rule Sup_assertion, auto)
 
 lemma Sup_less_assertion [simp]: "(!!w . p w \<in> assertion) \<Longrightarrow> Sup_less p w \<in> assertion"
   by (unfold Sup_less_def, rule Sup_assertion, auto)
 
 theorem omega_lfp: 
   "x ^ \<omega> * y = lfp (\<lambda> z . (x * z) \<sqinter> y)"
   apply (rule order.antisym)
   apply (rule lfp_greatest)
   apply (drule omega_least, simp)
   apply (rule lfp_lowerbound)
   apply (subst (2) omega_fix)
   by (simp add: inf_comp mult.assoc)
 end
 
 lemma [simp]: "mono (\<lambda> (t::'a::mbt_algebra) . x * t \<sqinter> y)"
   apply (simp add: mono_def, safe)
   apply (rule_tac y = "x * xa" in order_trans, simp)
   by (rule le_comp, simp)
 
 
 class mbt_algebra_fusion = mbt_algebra +
   assumes fusion: "(\<forall> t . x * t \<sqinter> y \<sqinter> z \<le> u * (t \<sqinter> z) \<sqinter> v)
           \<Longrightarrow> (x ^ \<omega>) * y \<sqinter> z \<le> (u ^ \<omega>) * v "
 
 lemma 
     "class.mbt_algebra_fusion (1::'a::complete_mbt_algebra) ((*)) (\<sqinter>) (\<le>) (<) (\<squnion>) dual dual_star omega star \<bottom> \<top>"
     apply unfold_locales
     apply (cut_tac h = "\<lambda> t . t \<sqinter> z" and f = "\<lambda> t . x * t \<sqinter> y" and g = "\<lambda> t . u * t \<sqinter> v" in weak_fusion)
     apply (rule inf_Disj)
     apply simp_all
     apply (simp add: le_fun_def)
     by  (simp add: omega_lfp)
 
 context mbt_algebra_fusion
 begin
 
 lemma omega_star: "x \<in> conjunctive \<Longrightarrow> x ^ \<omega> = wpt (x ^ \<omega>) * (x ^ *)"
   apply (simp add: wpt_def inf_comp)
   apply (rule order.antisym)
   apply (cut_tac x = x and y = 1 and z = "x ^ \<omega> * \<top> \<sqinter> x ^ *" in omega_least)
   apply (simp_all add: conjunctiveD,safe)
   apply  (subst (2) omega_fix)
   apply (simp add: inf_comp inf_assoc mult.assoc)
   apply (metis inf.commute inf_assoc inf_le1 star_fix)
   apply (cut_tac x = x and y = \<top> and z = "x ^ *" and u = x and v = 1 in fusion)
   apply (simp add: conjunctiveD)
   apply (metis inf_commute inf_le1 le_infE star_fix)
   by (metis mult.right_neutral)
 
 lemma omega_pres_conj: "x \<in> conjunctive \<Longrightarrow> x ^ \<omega> \<in> conjunctive"
   apply (subst omega_star, simp)
   apply (rule comp_pres_conj)
   apply (rule assertion_conjunctive, simp)
   by (rule start_pres_conj, simp)
 end
 
 end
diff --git a/thys/Refine_Monadic/Refine_Mono_Prover.thy b/thys/Refine_Monadic/Refine_Mono_Prover.thy
--- a/thys/Refine_Monadic/Refine_Mono_Prover.thy
+++ b/thys/Refine_Monadic/Refine_Mono_Prover.thy
@@ -1,43 +1,43 @@
 theory Refine_Mono_Prover
 imports Main Automatic_Refinement.Refine_Lib
 begin
   ML_file \<open>refine_mono_prover.ML\<close>
 
   setup Refine_Mono_Prover.setup
   declaration Refine_Mono_Prover.decl_setup
 
   method_setup refine_mono = 
     \<open>Scan.succeed (fn ctxt => SIMPLE_METHOD' (
       Refine_Mono_Prover.untriggered_mono_tac ctxt
     ))\<close> 
     "Refinement framework: Monotonicity prover"
 
   locale mono_setup_loc = 
     \<comment> \<open>Locale to set up monotonicity prover for given ordering operator\<close>
     fixes le :: "'a \<Rightarrow> 'a \<Rightarrow> bool" 
     assumes refl: "le x x"
   begin
     lemma monoI: "(\<And>f g x. (\<And>x. le (f x) (g x)) \<Longrightarrow> le (B f x) (B g x)) 
       \<Longrightarrow> monotone (fun_ord le) (fun_ord le) B"
       unfolding monotone_def fun_ord_def by blast
     
     lemma mono_if: "\<lbrakk>le t t'; le e e'\<rbrakk> \<Longrightarrow> le (If b t e) (If b t' e')" by auto
     lemma mono_let: "(\<And>x. le (f x) (f' x)) \<Longrightarrow> le (Let x f) (Let x f')" by auto
 
     lemmas mono_thms[refine_mono] = monoI mono_if mono_let refl
 
     declaration \<open>Refine_Mono_Prover.declare_mono_triggers @{thms monoI}\<close>
 
   end
 
   interpretation order_mono_setup: mono_setup_loc "(\<le>) :: 'a::preorder \<Rightarrow> _"
     by standard auto
 
-  declaration \<open>Refine_Mono_Prover.declare_mono_triggers @{thms Orderings.monoI}\<close>
+  declaration \<open>Refine_Mono_Prover.declare_mono_triggers @{thms monoI}\<close>
 
   lemmas [refine_mono] = 
     lfp_mono[OF le_funI, THEN le_funD] 
     gfp_mono[OF le_funI, THEN le_funD]
 
 end
 
diff --git a/thys/Transformer_Semantics/Isotone_Transformers.thy b/thys/Transformer_Semantics/Isotone_Transformers.thy
--- a/thys/Transformer_Semantics/Isotone_Transformers.thy
+++ b/thys/Transformer_Semantics/Isotone_Transformers.thy
@@ -1,344 +1,344 @@
 (* 
   Title: Isotone Transformers Between Complete Lattices
   Author: Georg Struth 
   Maintainer: Georg Struth <g.struth@sheffield.ac.uk> 
 *)
 
 section \<open>Isotone Transformers Between Complete Lattices\<close>
 
 theory Isotone_Transformers    
   imports "Order_Lattice_Props.Fixpoint_Fusion" 
           "Quantales.Quantale_Star"
 
 
 begin
 
 text \<open>A transformer is a function between lattices; an isotone transformer preserves the order (or is monotone). In this component, 
 statements are developed in a type-driven way. Statements are developed in more general contexts or even the most general one.\<close>
 
 subsection \<open>Basic Properties\<close>
 
 text \<open>First I show that some basic transformers are isotone...\<close>
 
 lemma iso_id: "mono id"
   by (simp add: monoI)
 
 lemma iso_botf: "mono \<bottom>"
   by (simp add: monoI) 
 
 lemma iso_topf: "mono \<top>"
   by (simp add: monoI)
 
 text \<open>... and that compositions, Infs and Sups preserve isotonicity.\<close>
 
 lemma iso_fcomp: "mono f \<Longrightarrow> mono g \<Longrightarrow> mono (f \<circ> g)"
   by (simp add: mono_def)
 
 lemma iso_fSup: 
   fixes F :: "('a::order \<Rightarrow> 'b::complete_lattice) set"
   shows "(\<forall>f \<in> F. mono f) \<Longrightarrow> mono (\<Squnion>F)"
   by (simp add: mono_def SUP_subset_mono)
 
 lemma iso_fsup: "mono f \<Longrightarrow> mono g \<Longrightarrow> mono (f \<squnion> g)"
   unfolding mono_def using sup_mono by fastforce
 
 lemma iso_fInf: 
   fixes F :: "('a::order \<Rightarrow> 'b::complete_lattice) set"
   shows "\<forall>f \<in> F. mono f \<Longrightarrow> mono (\<Sqinter>F)"
   by (simp add: mono_def, safe, rule Inf_greatest, auto simp: INF_lower2)
  
 lemma iso_finf: "mono f \<Longrightarrow> mono g \<Longrightarrow> mono (f \<sqinter> g)"
   unfolding mono_def using inf_mono by fastforce
     
 lemma fun_isol: "mono f \<Longrightarrow> g \<le> h \<Longrightarrow> (f \<circ> g) \<le> (f \<circ> h)"
   by (simp add: le_fun_def monoD)
 
 lemma fun_isor: "mono f \<Longrightarrow> g \<le> h \<Longrightarrow> (g \<circ> f) \<le> (h \<circ> f)"
   by (simp add: le_fun_def monoD)
 
 
 subsection \<open>Pre-Quantale of Isotone Transformers\<close>
 
 text \<open>It is well known, and has been formalised within Isabelle, that functions into complete lattices form complete lattices.
 In the following proof, this needs to be replayed because isotone functions are considered and closure conditions
 need to be respected.
 
 Functions must now be restricted to a single type.\<close>
 
 instantiation iso :: (complete_lattice) unital_pre_quantale 
 begin
 
 lift_definition one_iso :: "'a::complete_lattice iso" is id
   by (simp add: iso_id)
 
 lift_definition times_iso :: "'a::complete_lattice iso \<Rightarrow> 'a iso \<Rightarrow> 'a iso" is "(\<circ>)"
   by (simp add: iso_fcomp)
 
 instance 
   by (intro_classes; transfer, simp_all add: comp_assoc fInf_distr_var fInf_subdistl_var)
 
 end
 
 text \<open>I have previously worked in (pre)quantales with many types or quantaloids. Formally, these are categories  
 enriched over the category of Sup-lattices (complete lattices with Sup-preserving functions). An advantage 
 of the single-typed approach is that the definition of the Kleene star for (pre)quantales is available in this setting.\<close>
 
 
 subsection \<open>Propositional Hoare Logic for Transformers without Star\<close>
 
 text \<open>The rules of an abstract Propositional Hoare logic are derivable.\<close>
 
 lemma H_iso_cond1: "(x::'a::preorder) \<le> y \<Longrightarrow> y \<le> f z \<Longrightarrow> x \<le> f z"
   using order_trans by auto
 
 lemma H_iso_cond2: "mono f \<Longrightarrow> y \<le> z \<Longrightarrow> x \<le> f y \<Longrightarrow> x \<le> f z"
   by (meson mono_def order_subst1)
 
 lemma H_iso_seq: "mono f \<Longrightarrow> x \<le> f y \<Longrightarrow> y \<le> g z \<Longrightarrow> x \<le> f (g z)"
   using H_iso_cond2 by force
 
 lemma H_iso_seq_var: "mono f \<Longrightarrow> x \<le> f y \<Longrightarrow> y \<le> g z \<Longrightarrow> x \<le> (f \<circ> g) z"
   by (simp add: H_iso_cond2)
 
 lemma H_iso_fInf: 
   fixes F :: "('a \<Rightarrow> 'b::complete_lattice) set"
   shows "(\<forall>f \<in> F. x \<le> f y) \<Longrightarrow> x \<le> (\<Sqinter>F) y"
   by (simp add: le_INF_iff)
 
 lemma H_iso_fSup: 
   fixes F :: "('a \<Rightarrow> 'b::complete_lattice) set"
   shows "F \<noteq> {} \<Longrightarrow> (\<forall>f \<in> F. x \<le> f y) \<Longrightarrow> x \<le> (\<Squnion>F) y"
   using SUP_upper2 by fastforce
 
 text \<open>These rules are suitable for weakest liberal preconditions. Order-dual ones, in which the order relation is swapped,
 are consistent with other kinds of transformers. In the context of dynamic logic, the first set corresponds to box modalities 
 whereas the second one would correspond to diamonds.\<close>
 
 
 subsection \<open>Kleene Star of Isotone Transformers\<close>
  
 text \<open>The Hoare rule for loops requires some preparation. On the way I verify some Kleene-algebra-style axioms for iteration.\<close>
 
 text \<open>First I show that functions form monoids.\<close>
 
 interpretation fun_mon: monoid_mult "id::'a \<Rightarrow> 'a" "(\<circ>)"
   by unfold_locales auto
 
 definition fiter_fun :: "('a \<Rightarrow> 'c::semilattice_inf) \<Rightarrow> ('b \<Rightarrow> 'c) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'c" where 
   "fiter_fun f g = (\<sqinter>) f \<circ> (\<circ>) g"
 
 definition fiter :: "('a \<Rightarrow> 'b::complete_lattice) \<Rightarrow> ('b \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b" where 
   "fiter f g = gfp (fiter_fun f g)" 
 
 definition fiter_id :: "('a::complete_lattice \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a" where 
   "fiter_id = fiter id"
 
 abbreviation "fpower \<equiv> fun_mon.power"
 
 definition fstar :: "('a::complete_lattice \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a" where
   "fstar f = (\<Sqinter>i. fpower f i)"
 
 text \<open>The types in the following statements are often more general than those in the prequantale setting. I develop them generally, 
 instead of inheriting (most of them) with more restrictive types from the quantale components.\<close>
 
 lemma fiter_fun_exp: "fiter_fun f g h = f \<sqinter> (g \<circ> h)"
   unfolding fiter_fun_def by simp
 
 text \<open>The two lemmas that follow set up the relationship between the star for transformers and those in quantales.\<close>
 
 lemma fiter_qiter1: "Abs_iso (fiter_fun (Rep_iso f) (Rep_iso g) (Rep_iso h)) = qiter_fun f g h"
   unfolding fiter_fun_def qiter_fun_def by (metis Rep_iso_inverse comp_def sup_iso.rep_eq times_iso.rep_eq)
 
 lemma fiter_qiter4: "mono f \<Longrightarrow> mono g \<Longrightarrow> mono h \<Longrightarrow> Rep_iso (qiter_fun (Abs_iso f) (Abs_iso g) (Abs_iso h)) = fiter_fun f g h"
-  by (metis Abs_iso_inverse fiter_fun_exp fiter_qiter1 iso_fcomp iso_finf mem_Collect_eq)
+  by (simp add: Abs_iso_inverse fiter_fun_exp qiter_fun_exp sup_iso.rep_eq times_iso.rep_eq)
 
 text \<open>The type coercions are needed to deal with isotone (monotone) functions, which had to be redefined to one single type above,
 in order to cooperate with the type classes for quantales. Having to deal with these coercions would be another drawback of using the 
 quantale-based setting for the development.\<close>
 
 lemma iso_fiter_fun: "mono f \<Longrightarrow> mono (fiter_fun f)" 
   by (simp add: fiter_fun_exp le_fun_def mono_def inf.coboundedI2)
 
 lemma iso_fiter_fun2: "mono f \<Longrightarrow> mono g \<Longrightarrow> mono (fiter_fun f g)" 
   by (simp add: fiter_fun_exp le_fun_def mono_def inf.coboundedI2)
 
 lemma fiter_unfoldl: 
   fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
   shows "mono f \<Longrightarrow> mono g \<Longrightarrow> f \<sqinter> (g \<circ> fiter f g) = fiter f g"
   by (metis fiter_def fiter_fun_exp gfp_unfold iso_fiter_fun2)
 
 lemma fiter_inductl: 
   fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
   shows "mono f \<Longrightarrow> mono g \<Longrightarrow> h \<le> f \<sqinter> (g \<circ> h) \<Longrightarrow> h \<le> fiter f g"
   by (simp add: fiter_def fiter_fun_def gfp_upperbound)
  
 lemma fiter_fusion: 
   fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
   assumes "mono f" 
   and "mono g"
 shows "fiter f g = fiter_id g \<circ> f"
 proof-
   have h1: "mono (fiter_fun id g)"
     by (simp add: assms(2) iso_fiter_fun2 iso_id)
   have h2: "mono (fiter_fun f g)"
     by (simp add: assms(1) assms(2) iso_fiter_fun2)
   have h3: "Inf \<circ> image (\<lambda>x. x \<circ> f) = (\<lambda>x. x \<circ> f) \<circ> Inf" 
     by (simp add: fun_eq_iff image_comp)
   have "(\<lambda>x. x \<circ> f) \<circ> (fiter_fun id g) = (fiter_fun f g) \<circ> (\<lambda>x. x \<circ> f)"
     by (simp add: fun_eq_iff fiter_fun_def) 
   thus ?thesis
     using gfp_fusion_inf_pres
     by (metis fiter_def fiter_id_def h1 h2 h3) 
 qed
 
 lemma fpower_supdistl: 
   fixes f :: "'a::complete_lattice \<Rightarrow> 'b::complete_lattice"
   shows "mono f \<Longrightarrow> f \<circ> fstar g \<le> (\<Sqinter>i. f \<circ> fpower g i)"
   by (simp add: Isotone_Transformers.fun_isol fstar_def mono_INF mono_def)
 
 lemma fpower_distr: "fstar f \<circ> g = (\<Sqinter>i. fpower f i \<circ> g)"
   by (auto simp: fstar_def image_comp)
 
 lemma fpower_Sup_subcomm: "mono f \<Longrightarrow> f \<circ> fstar f \<le> fstar f \<circ> f"
-  by (metis (mono_tags, lifting) fun_mon.power_commutes le_INF_iff fpower_distr fpower_supdistl)
+  unfolding fpower_distr fun_mon.power_commutes by (rule fpower_supdistl)
 
 lemma fpower_inductl: 
   fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
   shows "mono f \<Longrightarrow> mono g \<Longrightarrow> h \<le> g \<sqinter> (f \<circ> h) \<Longrightarrow> h \<le> fpower f i \<circ> g"
   apply (induct i, simp_all) by (metis (no_types, opaque_lifting) fun.map_comp fun_isol order_trans) 
 
 lemma fpower_inductr: 
   fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
   shows "mono f \<Longrightarrow> mono g \<Longrightarrow> h \<le> g \<sqinter> (h \<circ> f) \<Longrightarrow> h \<le> g \<circ> fpower f i"
   by (induct i, simp_all add: le_fun_def, metis comp_eq_elim fun_mon.power_commutes order_trans)
 
 lemma fiter_fstar: "mono f \<Longrightarrow> fiter_id f \<le> fstar f"
   by (metis (no_types, lifting) fiter_id_def fiter_unfoldl fpower_inductl fstar_def iso_id le_INF_iff o_id order_refl)
 
 lemma iso_fiter_ext: 
   fixes f :: "'a::order \<Rightarrow> 'b::complete_lattice"
   shows "mono f \<Longrightarrow> mono (\<lambda>x. y \<sqinter> f x)"
   by (simp add: le_infI2 mono_def)
 
 lemma fstar_pred_char: 
   fixes f :: "'a::complete_lattice \<Rightarrow> 'a"
   shows "mono f \<Longrightarrow> fiter_id f x = gfp (\<lambda>y. x \<sqinter> f y)"
 proof -
   assume hyp: "mono f"
   have "\<forall>g. (id \<sqinter> (f \<circ> g)) x = x \<sqinter> f (g x)"
     by simp
   hence "\<forall>g. fiter_fun id f g x = (\<lambda>y. x \<sqinter> f y) (g x)"
     unfolding fiter_fun_def by simp
   thus ?thesis
     by (simp add: fiter_id_def fiter_def gfp_fusion_var hyp iso_fiter_fun2 iso_id iso_fiter_ext)
 qed
 
 
 subsection \<open>Propositional Hoare Logic Completed\<close>
  
 lemma H_weak_loop: "mono f \<Longrightarrow> x \<le> f x \<Longrightarrow> x \<le> fiter_id f x"
   by (force simp: fstar_pred_char gfp_def intro: Sup_upper)
 
 lemma iso_fiter: "mono f \<Longrightarrow> mono (fiter_id f)"
   unfolding mono_def by (subst fstar_pred_char, simp add: mono_def)+ (auto intro: gfp_mono inf_mono) 
 
 text \<open>As already mentioned, a dual Hoare logic can be built for the dual lattice. In this case, weak iteration is defined with respect to Sup.\<close>
 
 text \<open>The following standard construction lifts elements of (meet semi)lattices to transformers.
 I allow a more general type.\<close>
 
 definition fqtran :: "'a::inf \<Rightarrow> 'a \<Rightarrow> 'a" where
   "fqtran x \<equiv> \<lambda>y. x \<sqinter> y"
 
 text \<open>The following standard construction lifts elements of boolean algebras to transformers.\<close>
 
 definition bqtran :: "'a::boolean_algebra \<Rightarrow> 'a \<Rightarrow> 'a" ("\<lfloor>_\<rfloor>") where
   "\<lfloor>x\<rfloor> y = -x \<squnion> y"
 
 text \<open>The conditional and while rule of Hoare logic are now derivable.\<close>
 
 lemma bqtran_iso: "mono \<lfloor>x\<rfloor>"
   by (metis bqtran_def monoI order_refl sup.mono)
 
 lemma cond_iso: "mono f \<Longrightarrow> mono g \<Longrightarrow> mono (\<lfloor>x\<rfloor> \<circ> f \<sqinter> \<lfloor>y\<rfloor> \<circ> g)"
   by (simp add: bqtran_iso iso_fcomp iso_finf)
 
 lemma loop_iso: "mono f \<Longrightarrow> mono (fiter_id (\<lfloor>x\<rfloor> \<circ> f) \<circ> \<lfloor>y\<rfloor>)"
   by (simp add: bqtran_iso iso_fcomp iso_fiter)
 
 lemma H_iso_cond: "mono f \<Longrightarrow> mono g \<Longrightarrow>  p \<sqinter> x \<le> f y \<Longrightarrow> q \<sqinter> x \<le> g y \<Longrightarrow> x \<le> (inf (\<lfloor>p\<rfloor> \<circ> f) (\<lfloor>q\<rfloor> \<circ> g)) y"
   by (metis (full_types) bqtran_def comp_apply inf_apply inf_commute le_inf_iff shunt1)
 
 lemma H_iso_loop: "mono f \<Longrightarrow> p \<sqinter> x \<le> f x \<Longrightarrow> x \<le> ((fiter_id (\<lfloor>p\<rfloor> \<circ> f)) \<circ> \<lfloor>q\<rfloor>) (x \<sqinter> q)"
 proof-
   assume a: "mono f"
 and "p \<sqinter> x \<le> f x"
   hence "x \<le> (\<lfloor>p\<rfloor> \<circ> f) x"
     using H_iso_cond by fastforce 
   hence "x \<le> (fiter_id (\<lfloor>p\<rfloor> \<circ> f)) x"
     by (simp add: H_weak_loop a bqtran_iso iso_fcomp)
   also have "... \<le> (fiter_id (\<lfloor>p\<rfloor> \<circ> f)) (-q \<squnion> (x \<sqinter> q))"
     by (meson a bqtran_iso dual_order.refl iso_fcomp iso_fiter monoD shunt1)
   finally show "x \<le> ((fiter_id (\<lfloor>p\<rfloor> \<circ> f)) \<circ> \<lfloor>q\<rfloor>) (x \<sqinter> q)"
     by (simp add: bqtran_def)
 qed
 
 lemma btran_spec: "x \<le> \<lfloor>y\<rfloor> (x \<sqinter> y)"
   by (simp add: bqtran_def sup_inf_distrib1)
 
 lemma btran_neg_spec: "x \<le> \<lfloor>-y\<rfloor> (x - y)"
   by (simp add: btran_spec diff_eq)
 
 
 subsection \<open>A Propositional Refinement Calculus\<close>
 
 text \<open>Next I derive the laws of an abstract Propositional Refinement Calculus, Morgan-style. 
 These are given without the co-called frames, which capture information about local and global variables in variants of this calculus.\<close>
 
 definition "Ri x y z = \<Sqinter>{f z |f. x \<le> f y \<and> mono (f::'a::order \<Rightarrow> 'b::complete_lattice)}"
 
 lemma Ri_least: "mono f \<Longrightarrow> x \<le> f y \<Longrightarrow> Ri x y z \<le> f z"
   unfolding Ri_def by (metis (mono_tags, lifting) Inf_lower mem_Collect_eq)
  
 lemma Ri_spec: "x \<le> Ri x y y"
   unfolding Ri_def by (rule Inf_greatest, safe)
 
 lemma Ri_spec_var: "(\<forall>z. Ri x y z \<le> f z) \<Longrightarrow> x \<le> f y"
   using Ri_spec dual_order.trans by blast 
 
 lemma Ri_prop: "mono f \<Longrightarrow> x \<le> f y \<longleftrightarrow> (\<forall>z. Ri x y z \<le> f z)"
   using Ri_least Ri_spec_var by blast
 
 lemma iso_Ri: "mono (Ri x y)"
   unfolding mono_def Ri_def by (auto intro!: Inf_mono) 
 
 lemma Ri_weaken: "x \<le> x' \<Longrightarrow>  y' \<le> y \<Longrightarrow> Ri x y z \<le> Ri x' y' z"
   by (meson H_iso_cond2 Ri_least Ri_spec iso_Ri order.trans)
  
 lemma Ri_seq: "Ri x y z \<le> Ri x w (Ri w y z)"
   by (metis (no_types, opaque_lifting) H_iso_cond2 Ri_prop Ri_spec iso_Ri iso_fcomp o_apply)
 
 lemma Ri_seq_var: "Ri x y z \<le> ((Ri x w) \<circ> (Ri w y)) z"
   by (simp add: Ri_seq)
 
 lemma Ri_Inf: " Ri (\<Sqinter> X) y z \<le> \<Sqinter>{Ri x y z |x. x \<in> X}"
   by (safe intro!: Inf_greatest, simp add: Ri_weaken Inf_lower)
 
 lemma Ri_weak_iter: "Ri x x y  \<le> fiter_id (Ri x x) y"
   by (simp add: H_weak_loop Ri_least Ri_spec iso_Ri iso_fiter)
 
 lemma Ri_cond: "Ri x y z \<le> (inf (\<lfloor>p\<rfloor> \<circ> (Ri (p \<sqinter> x) y)) ((\<lfloor>q\<rfloor> \<circ> (Ri (q \<sqinter> x) y)))) z"
   by (meson H_iso_cond Ri_least Ri_spec bqtran_iso iso_Ri iso_fcomp iso_finf)
 
 lemma Ri_loop: "Ri x (q \<sqinter> x) y \<le> ((fiter_id (\<lfloor>p\<rfloor> \<circ> (Ri (x \<sqinter> p) x))) \<circ> \<lfloor>q\<rfloor>) (q \<sqinter> y)"
 proof-
   have "(p \<sqinter> x) \<le> Ri (p \<sqinter> x) x x"
     by (simp add: Ri_spec)
   hence "x \<le> ((fiter_id (\<lfloor>p\<rfloor> \<circ> (Ri (x \<sqinter> p) x))) \<circ> \<lfloor>q\<rfloor>) (q \<sqinter> x)"
     by (metis H_iso_loop inf_commute iso_Ri)
   thus ?thesis
     apply (subst Ri_least, safe, simp_all add: mono_def)
     by (metis bqtran_iso inf_mono iso_Ri iso_fcomp iso_fiter mono_def order_refl)
 qed
 
 end
diff --git a/thys/Types_To_Sets_Extension/Examples/SML_Relativization/Lattices/SML_Complete_Lattices.thy b/thys/Types_To_Sets_Extension/Examples/SML_Relativization/Lattices/SML_Complete_Lattices.thy
--- a/thys/Types_To_Sets_Extension/Examples/SML_Relativization/Lattices/SML_Complete_Lattices.thy
+++ b/thys/Types_To_Sets_Extension/Examples/SML_Relativization/Lattices/SML_Complete_Lattices.thy
@@ -1,1240 +1,1152 @@
 (* Title: Examples/SML_Relativization/Lattices/SML_Complete_Lattices.thy
    Author: Mihails Milehins
    Copyright 2021 (C) Mihails Milehins
 *)
 section\<open>Relativization of the results about complete lattices\<close>
 theory SML_Complete_Lattices
   imports SML_Lattices
 begin
 
 
 
 subsection\<open>Simple complete lattices\<close>
 
 
 subsubsection\<open>Definitions and common properties\<close>
 
 locale Inf_ow = 
   fixes U :: "'al set" and Inf (\<open>\<Sqinter>\<^sub>o\<^sub>w\<close>)
   assumes Inf_closed[simp]: "\<Sqinter>\<^sub>o\<^sub>w ` Pow U \<subseteq> U"
 begin
 
 notation Inf (\<open>\<Sqinter>\<^sub>o\<^sub>w\<close>)
 
 lemma Inf_closed'[simp]: "\<forall>x\<subseteq>U. \<Sqinter>\<^sub>o\<^sub>w x \<in> U" using Inf_closed by blast
 
 end
 
 locale Inf_pair_ow = Inf\<^sub>1: Inf_ow U\<^sub>1 Inf\<^sub>1 + Inf\<^sub>2: Inf_ow U\<^sub>2 Inf\<^sub>2 
   for U\<^sub>1 :: "'al set" and Inf\<^sub>1 and U\<^sub>2 :: "'bl set" and Inf\<^sub>2
 begin
 
 notation Inf\<^sub>1 (\<open>\<Sqinter>\<^sub>o\<^sub>w\<^sub>.\<^sub>1\<close>)
 notation Inf\<^sub>2 (\<open>\<Sqinter>\<^sub>o\<^sub>w\<^sub>.\<^sub>2\<close>)
 
 end
 
 locale Sup_ow = 
   fixes U :: "'al set" and Sup (\<open>\<Squnion>\<^sub>o\<^sub>w\<close>)
   assumes Sup_closed[simp]: "\<Squnion>\<^sub>o\<^sub>w ` Pow U \<subseteq> U"
 begin
 
 notation Sup (\<open>\<Squnion>\<^sub>o\<^sub>w\<close>)
 
 lemma Sup_closed'[simp]: "\<forall>x\<subseteq>U. \<Squnion>\<^sub>o\<^sub>w x \<in> U" using Sup_closed by blast
 
 end
 
 locale Sup_pair_ow = Sup\<^sub>1: Sup_ow U\<^sub>1 Sup\<^sub>1 + Sup\<^sub>2: Sup_ow U\<^sub>2 Sup\<^sub>2 
   for U\<^sub>1 :: "'al set" and Sup\<^sub>1 and U\<^sub>2 :: "'bl set" and Sup\<^sub>2
 begin
 
 notation Sup\<^sub>1 (\<open>\<Squnion>\<^sub>o\<^sub>w\<^sub>.\<^sub>1\<close>)
 notation Sup\<^sub>2 (\<open>\<Squnion>\<^sub>o\<^sub>w\<^sub>.\<^sub>2\<close>)
 
 end
 
 locale complete_lattice_ow =
   lattice_ow U inf le ls sup +
   Inf_ow U Inf + 
   Sup_ow U Sup + 
   bot_ow U bot + 
   top_ow U top
   for U :: "'al set" and Inf  Sup inf le ls sup bot top +
   assumes Inf_lower: "\<lbrakk> A \<subseteq> U; x \<in> A \<rbrakk> \<Longrightarrow> \<Sqinter>\<^sub>o\<^sub>w A \<le>\<^sub>o\<^sub>w x"
     and Inf_greatest: 
       "\<lbrakk> A \<subseteq> U; z \<in> U; (\<And>x. x \<in> A \<Longrightarrow> z \<le>\<^sub>o\<^sub>w x) \<rbrakk> \<Longrightarrow> z \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w A"
     and Sup_upper: "\<lbrakk> x \<in> A; A \<subseteq> U \<rbrakk> \<Longrightarrow> x \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w A"
     and Sup_least: 
       "\<lbrakk> A \<subseteq> U; z \<in> U; (\<And>x. x \<in> A \<Longrightarrow> x \<le>\<^sub>o\<^sub>w z) \<rbrakk> \<Longrightarrow> \<Squnion>\<^sub>o\<^sub>w A \<le>\<^sub>o\<^sub>w z"
     and Inf_empty[simp]: "\<Sqinter>\<^sub>o\<^sub>w {} = \<top>\<^sub>o\<^sub>w"
     and Sup_empty[simp]: "\<Squnion>\<^sub>o\<^sub>w {} = \<bottom>\<^sub>o\<^sub>w"
 begin
 
 sublocale bounded_lattice_ow U \<open>(\<sqinter>\<^sub>o\<^sub>w)\<close> \<open>(\<le>\<^sub>o\<^sub>w)\<close> \<open>(<\<^sub>o\<^sub>w)\<close> \<open>(\<squnion>\<^sub>o\<^sub>w)\<close> \<open>\<bottom>\<^sub>o\<^sub>w\<close> \<open>\<top>\<^sub>o\<^sub>w\<close>
   apply standard
   subgoal using Sup_least by force
   subgoal using Inf_greatest by fastforce
   done
 
 tts_register_sbts \<open>\<bottom>\<^sub>o\<^sub>w\<close> | U
 proof-
   assume ALA: "Domainp ALA = (\<lambda>x. x \<in> U)" 
   have "Domainp ALA \<bottom>\<^sub>o\<^sub>w" unfolding ALA by simp
   then obtain bot' where "ALA \<bottom>\<^sub>o\<^sub>w bot'" by blast
   then show "\<exists>bot'. ALA \<bottom>\<^sub>o\<^sub>w bot'" by auto
 qed
 
 tts_register_sbts \<open>\<top>\<^sub>o\<^sub>w\<close> | U
 proof-
   assume ALA: "Domainp ALA = (\<lambda>x. x \<in> U)" 
   have "Domainp ALA \<top>\<^sub>o\<^sub>w" unfolding ALA by simp
   then obtain top' where "ALA \<top>\<^sub>o\<^sub>w top'" by blast
   then show "\<exists>top'. ALA \<top>\<^sub>o\<^sub>w top'" by auto
 qed
 
 end
 
 locale complete_lattice_pair_ow = 
   cl\<^sub>1: complete_lattice_ow U\<^sub>1 Inf\<^sub>1 Sup\<^sub>1 inf\<^sub>1 le\<^sub>1 ls\<^sub>1 sup\<^sub>1 bot\<^sub>1 top\<^sub>1 + 
   cl\<^sub>2: complete_lattice_ow U\<^sub>2 Inf\<^sub>2 Sup\<^sub>2 inf\<^sub>2 le\<^sub>2 ls\<^sub>2 sup\<^sub>2 bot\<^sub>2 top\<^sub>2 
   for U\<^sub>1 :: "'al set" and Inf\<^sub>1 Sup\<^sub>1 inf\<^sub>1 le\<^sub>1 ls\<^sub>1 sup\<^sub>1 bot\<^sub>1 top\<^sub>1
     and U\<^sub>2 :: "'bl set" and Inf\<^sub>2 Sup\<^sub>2 inf\<^sub>2 le\<^sub>2 ls\<^sub>2 sup\<^sub>2 bot\<^sub>2 top\<^sub>2
 begin
 
 sublocale bounded_lattice_pair_ow ..
 sublocale Inf_pair_ow ..
 sublocale Sup_pair_ow ..
 
 end
 
 
 subsubsection\<open>Transfer rules\<close>
 
 context
   includes lifting_syntax
 begin
 
 lemma complete_lattice_transfer[transfer_rule]:
   assumes [transfer_rule]: "bi_unique A" "right_total A" 
   shows 
     "(
       (rel_set A ===> A) ===> 
       (rel_set A ===> A) ===>
       (A ===> A ===> A) ===>
       (A ===> A ===> (=)) ===>
       (A ===> A ===> (=)) ===>
       (A ===> A ===> A) ===> 
       A ===> A ===>
       (=)
     )
     (complete_lattice_ow (Collect (Domainp A))) class.complete_lattice"
 proof-
   let ?P = 
     "(
       (rel_set A ===> A) ===> 
       (rel_set A ===> A) ===>
       (A ===> A ===> A) ===>
       (A ===> A ===> (=)) ===>
       (A ===> A ===> (=)) ===>
       (A ===> A ===> A) ===> 
       A ===> A ===>
       (=)
     )"
   let ?complete_lattice_ow = "(complete_lattice_ow (Collect (Domainp A)))"
   let ?Inf_Sup_UNIV = 
     "(\<lambda>F'::'b set \<Rightarrow> 'b. (F' ` Pow UNIV \<subseteq> UNIV))"
   have rrng:
     "((A2 \<and> A3 \<and> A4 \<and> A5 \<and> A1 \<and> A6 \<and> A7 \<and> A8 \<and> A9 \<and> A10 \<and> A11) = F') \<Longrightarrow>
     ((A1 \<and> A2 \<and> A3 \<and> A4 \<and> A5 \<and> A6 \<and> A7 \<and> A8 \<and> A9 \<and> A10 \<and> A11) = F')"
     for A1 A2 A3 A4 A5 A6 A7 A8 A9 A10 A11 F'
     by auto
   have 
     "?P 
       ?complete_lattice_ow
       (
         \<lambda>Inf Sup inf le ls sup bot top. 
           ?Inf_Sup_UNIV Inf \<and> ?Inf_Sup_UNIV Sup \<and> bot \<in> UNIV \<and> top \<in> UNIV \<and>
           class.complete_lattice Inf Sup inf le ls sup bot top
       )"
     unfolding 
       complete_lattice_ow_def class.complete_lattice_def
       complete_lattice_ow_axioms_def class.complete_lattice_axioms_def
       Inf_ow_def Sup_ow_def bot_ow_def top_ow_def
     apply transfer_prover_start
     apply transfer_step+
     apply(simp, intro ext, rule rrng, intro arg_cong2[where f="(\<and>)"])
     subgoal unfolding Ball_Collect by simp
     subgoal unfolding Ball_Collect by simp
     subgoal by simp
     subgoal by simp
     subgoal by simp
     subgoal unfolding Ball_Collect[symmetric] by auto
     subgoal unfolding Ball_Collect[symmetric] by metis
     subgoal unfolding Ball_Collect[symmetric] by auto
     subgoal unfolding Ball_Collect[symmetric] by metis
     subgoal by simp
     subgoal by simp
     done
   then show ?thesis by simp
 qed
   
 end
 
 
 subsubsection\<open>Relativization\<close>
 
 context complete_lattice_ow
 begin
 
 tts_context
   tts: (?'a to U)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty
   eliminating \<open>?a \<in> ?A\<close> and \<open>?A \<subseteq> ?B\<close> through auto
   applying [OF Inf_closed' Sup_closed' inf_closed' sup_closed']
 begin
 
 tts_lemma Inf_atLeast:
   assumes "x \<in> U"
   shows "\<Sqinter>\<^sub>o\<^sub>w {x..\<^sub>o\<^sub>w} = x"
   is complete_lattice_class.Inf_atLeast.
     
 tts_lemma Inf_atMost:
   assumes "x \<in> U"
   shows "\<Sqinter>\<^sub>o\<^sub>w {..\<^sub>o\<^sub>wx} = \<bottom>\<^sub>o\<^sub>w"
     is complete_lattice_class.Inf_atMost.
     
 tts_lemma Sup_atLeast:
   assumes "x \<in> U"
   shows "\<Squnion>\<^sub>o\<^sub>w {x..\<^sub>o\<^sub>w} = \<top>\<^sub>o\<^sub>w"
   is complete_lattice_class.Sup_atLeast.
     
 tts_lemma Sup_atMost:
   assumes "y \<in> U"
   shows "\<Squnion>\<^sub>o\<^sub>w {..\<^sub>o\<^sub>wy} = y"
     is complete_lattice_class.Sup_atMost.
     
 tts_lemma Inf_insert:
   assumes "a \<in> U" and "A \<subseteq> U"
   shows "\<Sqinter>\<^sub>o\<^sub>w (insert a A) = a \<sqinter>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w A"
     is complete_lattice_class.Inf_insert.
     
 tts_lemma Sup_insert:
   assumes "a \<in> U" and "A \<subseteq> U"
   shows "\<Squnion>\<^sub>o\<^sub>w (insert a A) = a \<squnion>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w A"
     is complete_lattice_class.Sup_insert.
     
 tts_lemma Inf_atMostLessThan:
   assumes "x \<in> U" and "\<top>\<^sub>o\<^sub>w <\<^sub>o\<^sub>w x"
   shows "\<Sqinter>\<^sub>o\<^sub>w {..<\<^sub>o\<^sub>wx} = \<bottom>\<^sub>o\<^sub>w"
     is complete_lattice_class.Inf_atMostLessThan.
     
 tts_lemma Sup_greaterThanAtLeast:
   assumes "x \<in> U" and "x <\<^sub>o\<^sub>w \<top>\<^sub>o\<^sub>w"
   shows "\<Squnion>\<^sub>o\<^sub>w {x<\<^sub>o\<^sub>w..} = \<top>\<^sub>o\<^sub>w"
     is complete_lattice_class.Sup_greaterThanAtLeast.
     
 tts_lemma le_Inf_iff:
   assumes "b \<in> U" and "A \<subseteq> U"
   shows "(b \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w A) = Ball A ((\<le>\<^sub>o\<^sub>w) b)"
     is complete_lattice_class.le_Inf_iff.
     
 tts_lemma Sup_le_iff:
   assumes "A \<subseteq> U" and "b \<in> U"
   shows "(\<Squnion>\<^sub>o\<^sub>w A \<le>\<^sub>o\<^sub>w b) = (\<forall>x\<in>A. x \<le>\<^sub>o\<^sub>w b)"
     is complete_lattice_class.Sup_le_iff.
     
 tts_lemma Inf_atLeastLessThan:
   assumes "x \<in> U" and "y \<in> U" and "x <\<^sub>o\<^sub>w y"
   shows "\<Sqinter>\<^sub>o\<^sub>w (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {x..<y}) = x"
     is complete_lattice_class.Inf_atLeastLessThan.
     
 tts_lemma Sup_greaterThanAtMost:
   assumes "x \<in> U" and "y \<in> U" and "x <\<^sub>o\<^sub>w y"
   shows "\<Squnion>\<^sub>o\<^sub>w {x<\<^sub>o\<^sub>w..y} = y"
     is complete_lattice_class.Sup_greaterThanAtMost.
     
 tts_lemma Inf_atLeastAtMost:
   assumes "x \<in> U" and "y \<in> U" and "x \<le>\<^sub>o\<^sub>w y"
   shows "\<Sqinter>\<^sub>o\<^sub>w {x..\<^sub>o\<^sub>wy} = x"
 is complete_lattice_class.Inf_atLeastAtMost.
     
 tts_lemma Sup_atLeastAtMost:
   assumes "x \<in> U" and "y \<in> U" and "x \<le>\<^sub>o\<^sub>w y"
   shows "\<Squnion>\<^sub>o\<^sub>w {x..\<^sub>o\<^sub>wy} = y"
     is complete_lattice_class.Sup_atLeastAtMost.
     
 tts_lemma Inf_lower2:
   assumes "A \<subseteq> U" and "v \<in> U" and "u \<in> A" and "u \<le>\<^sub>o\<^sub>w v"
   shows "\<Sqinter>\<^sub>o\<^sub>w A \<le>\<^sub>o\<^sub>w v"
   is complete_lattice_class.Inf_lower2.
     
 tts_lemma Sup_upper2:
   assumes "A \<subseteq> U" and "v \<in> U" and "u \<in> A" and "v \<le>\<^sub>o\<^sub>w u"
   shows "v \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w A"
     is complete_lattice_class.Sup_upper2.
     
 tts_lemma Inf_less_eq:
   assumes "A \<subseteq> U" and "u \<in> U" and "\<And>v. v \<in> A \<Longrightarrow> v \<le>\<^sub>o\<^sub>w u" and "A \<noteq> {}"
   shows "\<Sqinter>\<^sub>o\<^sub>w A \<le>\<^sub>o\<^sub>w u"
   given complete_lattice_class.Inf_less_eq by auto
 
 tts_lemma less_eq_Sup:
   assumes "A \<subseteq> U" and "u \<in> U" and "\<And>v. v \<in> A \<Longrightarrow> u \<le>\<^sub>o\<^sub>w v" and "A \<noteq> {}"
   shows "u \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w A"
   given complete_lattice_class.less_eq_Sup by auto
 
 tts_lemma Sup_eqI:
   assumes "A \<subseteq> U"
     and "x \<in> U"
     and "\<And>y. y \<in> A \<Longrightarrow> y \<le>\<^sub>o\<^sub>w x"
     and "\<And>y. \<lbrakk>y \<in> U; \<And>z. z \<in> A \<Longrightarrow> z \<le>\<^sub>o\<^sub>w y\<rbrakk> \<Longrightarrow> x \<le>\<^sub>o\<^sub>w y"
   shows "\<Squnion>\<^sub>o\<^sub>w A = x"
     given complete_lattice_class.Sup_eqI
     by (simp add: Sup_least Sup_upper order.antisym)
     
 tts_lemma Inf_eqI:
   assumes "A \<subseteq> U"
     and "x \<in> U"
     and "\<And>i. i \<in> A \<Longrightarrow> x \<le>\<^sub>o\<^sub>w i"
     and "\<And>y. \<lbrakk>y \<in> U; \<And>i. i \<in> A \<Longrightarrow> y \<le>\<^sub>o\<^sub>w i\<rbrakk> \<Longrightarrow> y \<le>\<^sub>o\<^sub>w x"
   shows "\<Sqinter>\<^sub>o\<^sub>w A = x"
     given complete_lattice_class.Inf_eqI 
   by (simp add: subset_eq)
 
 tts_lemma Inf_union_distrib:
   assumes "A \<subseteq> U" and "B \<subseteq> U"
   shows "\<Sqinter>\<^sub>o\<^sub>w (A \<union> B) = \<Sqinter>\<^sub>o\<^sub>w A \<sqinter>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w B"
     is complete_lattice_class.Inf_union_distrib.
 
 tts_lemma Sup_union_distrib:
   assumes "A \<subseteq> U" and "B \<subseteq> U"
   shows "\<Squnion>\<^sub>o\<^sub>w (A \<union> B) = \<Squnion>\<^sub>o\<^sub>w A \<squnion>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w B"
     is complete_lattice_class.Sup_union_distrib.
 
 tts_lemma Sup_inter_less_eq:
   assumes "A \<subseteq> U" and "B \<subseteq> U"
   shows "\<Squnion>\<^sub>o\<^sub>w (A \<inter> B) \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w A \<sqinter>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w B"
     is complete_lattice_class.Sup_inter_less_eq.
 
 tts_lemma less_eq_Inf_inter:
   assumes "A \<subseteq> U" and "B \<subseteq> U"
   shows "\<Sqinter>\<^sub>o\<^sub>w A \<squnion>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w B \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (A \<inter> B)"
     is complete_lattice_class.less_eq_Inf_inter.
 
 tts_lemma Sup_subset_mono:
   assumes "B \<subseteq> U" and "A \<subseteq> B"
   shows "\<Squnion>\<^sub>o\<^sub>w A \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w B"
     is complete_lattice_class.Sup_subset_mono.
 
 tts_lemma Inf_superset_mono:
   assumes "A \<subseteq> U" and "B \<subseteq> A"
   shows "\<Sqinter>\<^sub>o\<^sub>w A \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w B"
     is complete_lattice_class.Inf_superset_mono.
 
 tts_lemma Sup_bot_conv:
   assumes "A \<subseteq> U" 
   shows 
     "(\<Squnion>\<^sub>o\<^sub>w A = \<bottom>\<^sub>o\<^sub>w) = (\<forall>x\<in>A. x = \<bottom>\<^sub>o\<^sub>w)"
     "(\<bottom>\<^sub>o\<^sub>w = \<Squnion>\<^sub>o\<^sub>w A) = (\<forall>x\<in>A. x = \<bottom>\<^sub>o\<^sub>w)"
     is complete_lattice_class.Sup_bot_conv.
 
 tts_lemma Inf_top_conv:
   assumes "A \<subseteq> U"
   shows 
     "(\<Sqinter>\<^sub>o\<^sub>w A = \<top>\<^sub>o\<^sub>w) = (\<forall>x\<in>A. x = \<top>\<^sub>o\<^sub>w)" 
     "(\<top>\<^sub>o\<^sub>w = \<Sqinter>\<^sub>o\<^sub>w A) = (\<forall>x\<in>A. x = \<top>\<^sub>o\<^sub>w)"
     is complete_lattice_class.Inf_top_conv.
 
 tts_lemma Inf_le_Sup:
   assumes "A \<subseteq> U" and "A \<noteq> {}"
   shows "\<Sqinter>\<^sub>o\<^sub>w A \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w A"
     is complete_lattice_class.Inf_le_Sup.
 
 tts_lemma INF_UNIV_bool_expand:
   assumes "range A \<subseteq> U"
   shows "\<Sqinter>\<^sub>o\<^sub>w (range A) = A True \<sqinter>\<^sub>o\<^sub>w A False"
     is complete_lattice_class.INF_UNIV_bool_expand.
 
 tts_lemma SUP_UNIV_bool_expand:
   assumes "range A \<subseteq> U"
   shows "\<Squnion>\<^sub>o\<^sub>w (range A) = A True \<squnion>\<^sub>o\<^sub>w A False"
     is complete_lattice_class.SUP_UNIV_bool_expand.
 
 tts_lemma Sup_mono:
   assumes "A \<subseteq> U" and "B \<subseteq> U" and "\<And>a. a \<in> A \<Longrightarrow> Bex B ((\<le>\<^sub>o\<^sub>w) a)"
   shows "\<Squnion>\<^sub>o\<^sub>w A \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w B"
     given complete_lattice_class.Sup_mono by simp
 
 tts_lemma Inf_mono:
   assumes "B \<subseteq> U"
     and "A \<subseteq> U"
     and "\<And>b. b \<in> B \<Longrightarrow> \<exists>x\<in>A. x \<le>\<^sub>o\<^sub>w b"
   shows "\<Sqinter>\<^sub>o\<^sub>w A \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w B"
     given complete_lattice_class.Inf_mono by simp
 
 tts_lemma Sup_Inf_le:
   assumes "A \<subseteq> Pow U"
   shows "\<Squnion>\<^sub>o\<^sub>w 
     (
       \<Sqinter>\<^sub>o\<^sub>w ` {x. x \<subseteq> U \<and> (\<exists>f\<in>{f. f ` Pow U \<subseteq> U}. x = f ` A \<and> (\<forall>Y\<in>A. f Y \<in> Y))}
     ) \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (\<Squnion>\<^sub>o\<^sub>w ` A)"
     is complete_lattice_class.Sup_Inf_le.
 
 end
 
 tts_context
   tts: (?'a to U)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty 
   applying [
     OF Inf_closed' Sup_closed' inf_closed' sup_closed' bot_closed top_closed
     ]
 begin
 
 tts_lemma Inf_UNIV: "\<Sqinter>\<^sub>o\<^sub>w U = \<bottom>\<^sub>o\<^sub>w"
     is complete_lattice_class.Inf_UNIV.
 
 tts_lemma Sup_UNIV: "\<Squnion>\<^sub>o\<^sub>w U = \<top>\<^sub>o\<^sub>w"
     is complete_lattice_class.Sup_UNIV.
 
 end
 
 context 
   fixes U\<^sub>2 :: "'b set"
 begin
 
 lemmas [transfer_rule] =
   image_transfer[where ?'a='b]
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty
   eliminating through (insert Sup_least, auto)
 begin
 
 tts_lemma SUP_upper2:
   assumes "A \<subseteq> U\<^sub>2"
     and "u \<in> U"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "i \<in> A"
     and "u \<le>\<^sub>o\<^sub>w f i"
   shows "u \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (f ` A)"
   is complete_lattice_class.SUP_upper2.
 
 tts_lemma INF_lower2:
   assumes "A \<subseteq> U\<^sub>2"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "u \<in> U"
     and "i \<in> A"
     and "f i \<le>\<^sub>o\<^sub>w u"
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w u"
   is complete_lattice_class.INF_lower2.
     
 tts_lemma less_INF_D:
   assumes "y \<in> U"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "A \<subseteq> U\<^sub>2"
     and "y <\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (f ` A)"
     and "i \<in> A"
   shows "y <\<^sub>o\<^sub>w f i"
   is complete_lattice_class.less_INF_D.
     
 tts_lemma SUP_lessD:
   assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "A \<subseteq> U\<^sub>2"
     and "y \<in> U"
     and "\<Squnion>\<^sub>o\<^sub>w (f ` A) <\<^sub>o\<^sub>w y"
     and "i \<in> A"
   shows "f i <\<^sub>o\<^sub>w y"
   is complete_lattice_class.SUP_lessD.
 
 tts_lemma SUP_le_iff:
   assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U" and "A \<subseteq> U\<^sub>2" and "u \<in> U"
   shows "(\<Squnion>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w u) = (\<forall>x\<in>A. f x \<le>\<^sub>o\<^sub>w u)"
     is complete_lattice_class.SUP_le_iff.
 
 end
 
 end
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty
   eliminating through (auto dest: top_le)
 begin
 
 tts_lemma INF_eqI:
   assumes "A \<subseteq> U\<^sub>2"
     and "x \<in> U"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "\<And>i. \<lbrakk>i \<in> U\<^sub>2; i \<in> A\<rbrakk> \<Longrightarrow> x \<le>\<^sub>o\<^sub>w f i"
     and "\<And>y. \<lbrakk>y \<in> U; \<And>i. \<lbrakk>i \<in> U\<^sub>2; i \<in> A\<rbrakk> \<Longrightarrow> y \<le>\<^sub>o\<^sub>w f i\<rbrakk> \<Longrightarrow> y \<le>\<^sub>o\<^sub>w x"
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` A) = x"
   is complete_lattice_class.INF_eqI.
 
 end
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty
   eliminating through (auto simp: order.eq_iff)
 begin
 
 tts_lemma SUP_eqI:
   assumes "A \<subseteq> U\<^sub>2"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "x \<in> U"
     and "\<And>i. \<lbrakk>i \<in> U\<^sub>2; i \<in> A\<rbrakk> \<Longrightarrow> f i \<le>\<^sub>o\<^sub>w x"
     and "\<And>y. \<lbrakk>y \<in> U; \<And>i. \<lbrakk>i \<in> U\<^sub>2; i \<in> A\<rbrakk> \<Longrightarrow> f i \<le>\<^sub>o\<^sub>w y\<rbrakk> \<Longrightarrow> x \<le>\<^sub>o\<^sub>w y"
   shows "\<Squnion>\<^sub>o\<^sub>w (f ` A) = x"
     is complete_lattice_class.SUP_eqI.
     
 end
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty
   eliminating through simp
 begin
 
 tts_lemma INF_le_SUP:
   assumes "A \<subseteq> U\<^sub>2" and "\<forall>x\<in>U\<^sub>2. f x \<in> U" and "A \<noteq> {}"
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (f ` A)"
   is complete_lattice_class.INF_le_SUP.
     
 tts_lemma INF_inf_const1:
   assumes "I \<subseteq> U\<^sub>2" and "x \<in> U" and "\<forall>x\<in>U\<^sub>2. f x \<in> U" and "I \<noteq> {}"
   shows "\<Sqinter>\<^sub>o\<^sub>w ((\<lambda>i. x \<sqinter>\<^sub>o\<^sub>w f i) ` I) = x \<sqinter>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (f ` I)"
     is complete_lattice_class.INF_inf_const1.
     
 tts_lemma INF_inf_const2:
   assumes "I \<subseteq> U\<^sub>2" and "\<forall>x\<in>U\<^sub>2. f x \<in> U" and "x \<in> U" and "I \<noteq> {}"
   shows "\<Sqinter>\<^sub>o\<^sub>w ((\<lambda>i. f i \<sqinter>\<^sub>o\<^sub>w x) ` I) = \<Sqinter>\<^sub>o\<^sub>w (f ` I) \<sqinter>\<^sub>o\<^sub>w x"
     is complete_lattice_class.INF_inf_const2.    
 
 end
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty
   eliminating through auto
 begin
 
 tts_lemma INF_eq_const:
   assumes "I \<subseteq> U\<^sub>2" 
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U" 
     and "I \<noteq> {}"
     and "\<And>i. i \<in> I \<Longrightarrow> f i = x"
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` I) = x"
     given complete_lattice_class.INF_eq_const
 proof-
   assume 
     "\<lbrakk>I \<subseteq> U\<^sub>2; \<forall>x\<in>U\<^sub>2. f x \<in> U; I \<noteq> {}; \<And>i. \<lbrakk>i \<in> U\<^sub>2; i \<in> I\<rbrakk> \<Longrightarrow> f i = x\<rbrakk> \<Longrightarrow> 
       \<Sqinter>\<^sub>o\<^sub>w (f ` I) = x"
     for I :: "'a set" and U\<^sub>2 f x
   then have 
     "\<lbrakk>I \<subseteq> U\<^sub>2; \<forall>x\<in>U\<^sub>2. f x \<in> U; I \<noteq> {}; \<And>i. i \<in> I \<Longrightarrow> f i = x\<rbrakk> \<Longrightarrow> 
       \<Sqinter>\<^sub>o\<^sub>w (f ` I) = x"
     by presburger
   then show "\<Sqinter>\<^sub>o\<^sub>w (f ` I) = x" using assms by simp
 qed
     
 tts_lemma SUP_eq_const:
   assumes "I \<subseteq> U\<^sub>2"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "I \<noteq> {}"
     and "\<And>i. i \<in> I \<Longrightarrow> f i = x"
   shows "\<Squnion>\<^sub>o\<^sub>w (f ` I) = x"
     given complete_lattice_class.SUP_eq_const
 proof-
   assume 
     "\<lbrakk>I \<subseteq> U\<^sub>2; \<forall>x\<in>U\<^sub>2. f x \<in> U; I \<noteq> {}; \<And>i. \<lbrakk>i \<in> U\<^sub>2; i \<in> I\<rbrakk> \<Longrightarrow> f i = x\<rbrakk> \<Longrightarrow> 
       \<Squnion>\<^sub>o\<^sub>w (f ` I) = x"
     for I :: "'a set" and U\<^sub>2 f x
   then have 
     "\<lbrakk>I \<subseteq> U\<^sub>2; \<forall>x\<in>U\<^sub>2. f x \<in> U; I \<noteq> {}; \<And>i. i \<in> I \<Longrightarrow> f i = x\<rbrakk> \<Longrightarrow> 
       \<Squnion>\<^sub>o\<^sub>w (f ` I) = x"
     by presburger
   then show "\<Squnion>\<^sub>o\<^sub>w (f ` I) = x" using assms by simp
 qed
     
 tts_lemma SUP_eq_iff:
   assumes "I \<subseteq> U\<^sub>2"
     and "c \<in> U"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "I \<noteq> {}"
     and "\<And>i. i \<in> I \<Longrightarrow> c \<le>\<^sub>o\<^sub>w f i"
   shows "(\<Squnion>\<^sub>o\<^sub>w (f ` I) = c) = (\<forall>x\<in>I. f x = c)"
     given complete_lattice_class.SUP_eq_iff
 proof-
   assume 
     "\<lbrakk>
       I \<subseteq> U\<^sub>2; 
       c \<in> U; \<forall>x\<in>U\<^sub>2. f x \<in> U; 
       I \<noteq> {}; 
       \<And>i. \<lbrakk>i \<in> U\<^sub>2; i \<in> I\<rbrakk> \<Longrightarrow> c \<le>\<^sub>o\<^sub>w f i
     \<rbrakk> \<Longrightarrow>  (\<Squnion>\<^sub>o\<^sub>w (f ` I) = c) = (\<forall>x\<in>I. f x = c)"
     for I :: "'a set" and U\<^sub>2 c f
   then have 
     "\<lbrakk>
       I \<subseteq> U\<^sub>2; 
       c \<in> U; \<forall>x\<in>U\<^sub>2. f x \<in> U; 
       I \<noteq> {}; 
       \<And>i. i \<in> I \<Longrightarrow> c \<le>\<^sub>o\<^sub>w f i
     \<rbrakk> \<Longrightarrow> (\<Squnion>\<^sub>o\<^sub>w (f ` I) = c) = (\<forall>x\<in>I. f x = c)"
     by presburger
   then show "(\<Squnion>\<^sub>o\<^sub>w (f ` I) = c) = (\<forall>x\<in>I. f x = c)" using assms by auto
 qed
     
 tts_lemma INF_eq_iff:
   assumes "I \<subseteq> U\<^sub>2"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "c \<in> U"
     and "I \<noteq> {}"
     and "\<And>i. i \<in> I \<Longrightarrow> f i \<le>\<^sub>o\<^sub>w c"
   shows "(\<Sqinter>\<^sub>o\<^sub>w (f ` I) = c) = (\<forall>x\<in>I. f x = c)"
     given complete_lattice_class.INF_eq_iff
 proof-
   assume 
     "\<lbrakk>
       I \<subseteq> U\<^sub>2; 
       \<forall>x\<in>U\<^sub>2. f x \<in> U; c \<in> U; 
       I \<noteq> {}; 
       \<And>i. \<lbrakk>i \<in> U\<^sub>2; i \<in> I\<rbrakk> \<Longrightarrow> f i \<le>\<^sub>o\<^sub>w c
     \<rbrakk> \<Longrightarrow> (\<Sqinter>\<^sub>o\<^sub>w (f ` I) = c) = (\<forall>x\<in>I. f x = c)"
     for I :: "'a set" and U\<^sub>2 f c
   then have 
     "\<lbrakk>
       I \<subseteq> U\<^sub>2; 
       \<forall>x\<in>U\<^sub>2. f x \<in> U; c \<in> U; 
       I \<noteq> {}; 
       \<And>i. i \<in> I \<Longrightarrow> f i \<le>\<^sub>o\<^sub>w c
     \<rbrakk> \<Longrightarrow> (\<Sqinter>\<^sub>o\<^sub>w (f ` I) = c) = (\<forall>x\<in>I. f x = c)"
     by presburger
   then show "(\<Sqinter>\<^sub>o\<^sub>w (f ` I) = c) = (\<forall>x\<in>I. f x = c)" using assms by auto
 qed
 
 end
 
 
 context 
   fixes U\<^sub>2 :: "'b set"
 begin
 
 lemmas [transfer_rule] =
   image_transfer[where ?'a='b]
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty
   eliminating through (auto simp: sup_bot.top_unique top_le intro: Sup_least)
 begin
 
 tts_lemma INF_insert:
   assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U" and "a \<in> U\<^sub>2" and "A \<subseteq> U\<^sub>2"
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` insert a A) = f a \<sqinter>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (f ` A)"
   is complete_lattice_class.INF_insert.
     
 tts_lemma SUP_insert:
   assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U" and "a \<in> U\<^sub>2" and "A \<subseteq> U\<^sub>2"
   shows "\<Squnion>\<^sub>o\<^sub>w (f ` insert a A) = f a \<squnion>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (f ` A)"
     is complete_lattice_class.SUP_insert.
     
 tts_lemma le_INF_iff:
   assumes "u \<in> U" and "\<forall>x\<in>U\<^sub>2. f x \<in> U" and "A \<subseteq> U\<^sub>2"
   shows "(u \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (f ` A)) = (\<forall>x\<in>A. u \<le>\<^sub>o\<^sub>w f x)"
   is complete_lattice_class.le_INF_iff.
     
 tts_lemma INF_union:
   assumes "\<forall>x\<in>U\<^sub>2. M x \<in> U" and "A \<subseteq> U\<^sub>2" and "B \<subseteq> U\<^sub>2"
   shows "\<Sqinter>\<^sub>o\<^sub>w (M ` (A \<union> B)) = \<Sqinter>\<^sub>o\<^sub>w (M ` A) \<sqinter>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (M ` B)"
     is complete_lattice_class.INF_union.
     
 tts_lemma SUP_union:
   assumes "\<forall>x\<in>U\<^sub>2. M x \<in> U" and "A \<subseteq> U\<^sub>2" and "B \<subseteq> U\<^sub>2"
   shows "\<Squnion>\<^sub>o\<^sub>w (M ` (A \<union> B)) = \<Squnion>\<^sub>o\<^sub>w (M ` A) \<squnion>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (M ` B)"
   is complete_lattice_class.SUP_union.
     
 tts_lemma SUP_bot_conv:
   assumes "\<forall>x\<in>U\<^sub>2. B x \<in> U" and "A \<subseteq> U\<^sub>2"
   shows 
     "(\<Squnion>\<^sub>o\<^sub>w (B ` A) = \<bottom>\<^sub>o\<^sub>w) = (\<forall>x\<in>A. B x = \<bottom>\<^sub>o\<^sub>w)"
     "(\<bottom>\<^sub>o\<^sub>w = \<Squnion>\<^sub>o\<^sub>w (B ` A)) = (\<forall>x\<in>A. B x = \<bottom>\<^sub>o\<^sub>w)"
   is complete_lattice_class.SUP_bot_conv.
     
 tts_lemma INF_top_conv:
   assumes "\<forall>x\<in>U\<^sub>2. B x \<in> U" and "A \<subseteq> U\<^sub>2"
   shows 
     "(\<Sqinter>\<^sub>o\<^sub>w (B ` A) = \<top>\<^sub>o\<^sub>w) = (\<forall>x\<in>A. B x = \<top>\<^sub>o\<^sub>w)"
     "(\<top>\<^sub>o\<^sub>w = \<Sqinter>\<^sub>o\<^sub>w (B ` A)) = (\<forall>x\<in>A. B x = \<top>\<^sub>o\<^sub>w)"
   is complete_lattice_class.INF_top_conv.
     
 tts_lemma SUP_upper:
   assumes "A \<subseteq> U\<^sub>2" and "\<forall>x\<in>U\<^sub>2. f x \<in> U" and "i \<in> A"
   shows "f i \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (f ` A)"
   is complete_lattice_class.SUP_upper.
     
 tts_lemma INF_lower:
   assumes "A \<subseteq> U\<^sub>2" and "\<forall>x\<in>U\<^sub>2. f x \<in> U" and "i \<in> A"
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w f i"
   is complete_lattice_class.INF_lower.
 
 tts_lemma INF_inf_distrib:
   assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U" and "A \<subseteq> U\<^sub>2" and "\<forall>x\<in>U\<^sub>2. g x \<in> U"
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` A) \<sqinter>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (g ` A) = \<Sqinter>\<^sub>o\<^sub>w ((\<lambda>a. f a \<sqinter>\<^sub>o\<^sub>w g a) ` A)"
     is complete_lattice_class.INF_inf_distrib.
 
 tts_lemma SUP_sup_distrib:
   assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U" and "A \<subseteq> U\<^sub>2" and "\<forall>x\<in>U\<^sub>2. g x \<in> U"
   shows "\<Squnion>\<^sub>o\<^sub>w (f ` A) \<squnion>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (g ` A) = \<Squnion>\<^sub>o\<^sub>w ((\<lambda>a. f a \<squnion>\<^sub>o\<^sub>w g a) ` A)"
     is complete_lattice_class.SUP_sup_distrib.
 
 tts_lemma SUP_subset_mono:
   assumes "B \<subseteq> U\<^sub>2"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "\<forall>x\<in>U\<^sub>2. g x \<in> U"
     and "A \<subseteq> B"
     and "\<And>x. x \<in> A \<Longrightarrow> f x \<le>\<^sub>o\<^sub>w g x"
   shows "\<Squnion>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (g ` B)"
     given complete_lattice_class.SUP_subset_mono
 proof-
   assume 
     "\<lbrakk>
       B \<subseteq> U\<^sub>2; 
       \<forall>x\<in>U\<^sub>2. f x \<in> U; 
       \<forall>x\<in>U\<^sub>2. g x \<in> U; 
       A \<subseteq> B; 
       \<And>x. \<lbrakk>x \<in> U\<^sub>2; x \<in> A\<rbrakk> \<Longrightarrow> f x \<le>\<^sub>o\<^sub>w g x
     \<rbrakk> \<Longrightarrow> \<Squnion>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (g ` B)"
     for B :: "'b set" and f g A
   then have
     "\<lbrakk>
       B \<subseteq> U\<^sub>2; 
       \<forall>x\<in>U\<^sub>2. f x \<in> U; 
       \<forall>x\<in>U\<^sub>2. g x \<in> U; 
       A \<subseteq> B; 
       \<And>x. x \<in> A \<Longrightarrow> f x \<le>\<^sub>o\<^sub>w g x
     \<rbrakk> \<Longrightarrow> \<Squnion>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (g ` B)"
     by auto
   then show "\<Squnion>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (g ` B)" using assms by blast
 qed
 
 tts_lemma INF_superset_mono:
   assumes "A \<subseteq> U\<^sub>2"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "\<forall>x\<in>U\<^sub>2. g x \<in> U"
     and "B \<subseteq> A"
     and "\<And>x. \<lbrakk>x \<in> U\<^sub>2; x \<in> B\<rbrakk> \<Longrightarrow> f x \<le>\<^sub>o\<^sub>w g x"
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (g ` B)"
     given complete_lattice_class.INF_superset_mono
 proof-
   assume 
     "\<lbrakk>
       A \<subseteq> U\<^sub>2; 
       \<forall>x\<in>U\<^sub>2. f x \<in> U; 
       \<forall>x\<in>U\<^sub>2. g x \<in> U; 
       B \<subseteq> A; 
       \<And>x. \<lbrakk>x \<in> U\<^sub>2; x \<in> B\<rbrakk> \<Longrightarrow> f x \<le>\<^sub>o\<^sub>w g x
     \<rbrakk> \<Longrightarrow> \<Sqinter>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (g ` B)"
     for A :: "'b set" and f g B
   then have
     "\<lbrakk>
       A \<subseteq> U\<^sub>2; 
       \<forall>x\<in>U\<^sub>2. f x \<in> U; 
       \<forall>x\<in>U\<^sub>2. g x \<in> U; 
       B \<subseteq> A; 
       \<And>x. x \<in> B \<Longrightarrow> f x \<le>\<^sub>o\<^sub>w g x
     \<rbrakk> \<Longrightarrow> \<Sqinter>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (g ` B)"
     by auto
   then show "\<Sqinter>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (g ` B)" using assms by blast
 qed
 
 tts_lemma INF_absorb:
   assumes "I \<subseteq> U\<^sub>2" and "\<forall>x\<in>U\<^sub>2. A x \<in> U" and "k \<in> I"
   shows "A k \<sqinter>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (A ` I) = \<Sqinter>\<^sub>o\<^sub>w (A ` I)"
     is complete_lattice_class.INF_absorb.
 
 tts_lemma SUP_absorb:
   assumes "I \<subseteq> U\<^sub>2" and "\<forall>x\<in>U\<^sub>2. A x \<in> U" and "k \<in> I"
   shows "A k \<squnion>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (A ` I) = \<Squnion>\<^sub>o\<^sub>w (A ` I)"
     is complete_lattice_class.SUP_absorb.
 
 end
 
 end
 
 context 
   fixes f :: "'b \<Rightarrow> 'al" and U\<^sub>2 :: "'b set"
   assumes f[transfer_rule]: "\<forall>x \<in> U\<^sub>2. f x = \<bottom>\<^sub>o\<^sub>w"
 begin
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>)
   sbterms: (\<open>Orderings.bot::?'a::complete_lattice\<close> to \<open>\<bottom>\<^sub>o\<^sub>w\<close>)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty
   eliminating through simp
 begin
 
 tts_lemma SUP_bot:
   assumes "A \<subseteq> U\<^sub>2"
   shows "\<Squnion>\<^sub>o\<^sub>w (f ` A) = \<bottom>\<^sub>o\<^sub>w"
     is complete_lattice_class.SUP_bot[folded const_fun_def].
 
 end
 
 end
 
 context 
   fixes f :: "'b \<Rightarrow> 'al" and U\<^sub>2 :: "'b set"
   assumes f[transfer_rule]: "\<forall>x \<in> U\<^sub>2. f x = \<top>\<^sub>o\<^sub>w"
 begin
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>)
   sbterms: (\<open>Orderings.top::?'a::complete_lattice\<close> to \<open>\<top>\<^sub>o\<^sub>w\<close>)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty
   eliminating through simp
 begin
 
 tts_lemma INF_top:
   assumes "A \<subseteq> U\<^sub>2"
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` A) = \<top>\<^sub>o\<^sub>w"
   is complete_lattice_class.INF_top[folded const_fun_def].
 
 end
 
 end
 
 context 
   fixes f :: "'b \<Rightarrow> 'al" and c and F and U\<^sub>2 :: "'b set"
   assumes c_closed[transfer_rule]: "c \<in> U"
   assumes f[transfer_rule]: "\<forall>x \<in> U\<^sub>2. f x = c"
 begin
 
 tts_register_sbts \<open>c\<close> | U
 proof-
   assume ALC: "Domainp ALC = (\<lambda>x. x \<in> U)" 
   have "Domainp ALC c" unfolding ALC by (simp add: c_closed)
   then obtain c' where "ALC c c'" by blast
   then show "\<exists>c'. ALC c c'" by auto
 qed
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>)
   sbterms: (\<open>?c::?'a::complete_lattice\<close> to \<open>c\<close>)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty
   eliminating through simp
 begin
 
 tts_lemma INF_constant:
   assumes "A \<subseteq> U\<^sub>2"
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` A) = (if A = {} then \<top>\<^sub>o\<^sub>w else c)"
     is complete_lattice_class.INF_constant[folded const_fun_def].
 
 tts_lemma SUP_constant:
   assumes "A \<subseteq> U\<^sub>2"
   shows "\<Squnion>\<^sub>o\<^sub>w (f ` A) = (if A = {} then \<bottom>\<^sub>o\<^sub>w else c)"
     is complete_lattice_class.SUP_constant[folded const_fun_def].
 
 end
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>)
   sbterms: (\<open>?f::?'a::complete_lattice\<close> to \<open>c\<close>)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty
   eliminating through simp
 begin
 
 tts_lemma INF_const:
   assumes "A \<subseteq> U\<^sub>2" and "A \<noteq> {}"
   shows "\<Sqinter>\<^sub>o\<^sub>w ((\<lambda>i. c) ` A) = c"
     is complete_lattice_class.INF_const.
     
 tts_lemma SUP_const:
   assumes "A \<subseteq> U\<^sub>2" and "A \<noteq> {}"
   shows "\<Squnion>\<^sub>o\<^sub>w ((\<lambda>i. c) ` A) = c"
     is complete_lattice_class.SUP_const.
 
 end
 
 end
 
 end
 
 context complete_lattice_ow
 begin
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>) and (?'c to \<open>U\<^sub>3::'c set\<close>)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty  
   eliminating \<open>?U \<noteq> {}\<close> through (force simp: subset_iff INF_top equals0D)
   applying [
     OF Inf_closed' Sup_closed' inf_closed' sup_closed' bot_closed top_closed
     ]
 begin
 
 tts_lemma SUP_eq:
   assumes "A \<subseteq> U\<^sub>2"
     and "B \<subseteq> U\<^sub>3"
     and "\<forall>x\<in>U\<^sub>2. f (x::'a) \<in> U"
     and "\<forall>x\<in>U\<^sub>3. g x \<in> U"
     and "\<And>i. i \<in> A \<Longrightarrow> \<exists>x\<in>B. f i \<le>\<^sub>o\<^sub>w g x"
     and "\<And>j. j \<in> B \<Longrightarrow> \<exists>x\<in>A. g j \<le>\<^sub>o\<^sub>w f x"
   shows "\<Squnion>\<^sub>o\<^sub>w (f ` A) = \<Squnion>\<^sub>o\<^sub>w (g ` B)"
     given complete_lattice_class.SUP_eq
 proof-
   assume 
     "\<lbrakk>
       A \<subseteq> U\<^sub>2; 
       B \<subseteq> U\<^sub>3; 
       \<forall>x\<in>U\<^sub>2. f x \<in> U; 
       \<forall>x\<in>U\<^sub>3. g x \<in> U; 
       \<And>i. \<lbrakk>i \<in> U\<^sub>2; i \<in> A\<rbrakk> \<Longrightarrow> \<exists>x\<in>B. f i \<le>\<^sub>o\<^sub>w g x; 
       \<And>j. \<lbrakk>j \<in> U\<^sub>3; j \<in> B\<rbrakk> \<Longrightarrow> \<exists>x\<in>A. g j \<le>\<^sub>o\<^sub>w f x
     \<rbrakk> \<Longrightarrow> \<Squnion>\<^sub>o\<^sub>w (f ` A) = \<Squnion>\<^sub>o\<^sub>w (g ` B)"
     for A :: "'a set" and U\<^sub>2 and B :: "'b set" and U\<^sub>3 f g
   then have
     "\<lbrakk>
       A \<subseteq> U\<^sub>2; 
       B \<subseteq> U\<^sub>3; 
       \<forall>x\<in>U\<^sub>2. f x \<in> U; 
       \<forall>x\<in>U\<^sub>3. g x \<in> U; 
       \<And>i. i \<in> A \<Longrightarrow> \<exists>x\<in>B. f i \<le>\<^sub>o\<^sub>w g x; 
       \<And>j. j \<in> B \<Longrightarrow> \<exists>x\<in>A. g j \<le>\<^sub>o\<^sub>w f x
     \<rbrakk> \<Longrightarrow> \<Squnion>\<^sub>o\<^sub>w (f ` A) = \<Squnion>\<^sub>o\<^sub>w (g ` B)"
     by simp
   then show "\<Squnion>\<^sub>o\<^sub>w (f ` A) = \<Squnion>\<^sub>o\<^sub>w (g ` B)" using assms by simp
 qed
 
 tts_lemma INF_eq:
   assumes "A \<subseteq> U\<^sub>2"
     and "B \<subseteq> U\<^sub>3"
     and "\<forall>x\<in>U\<^sub>3. g x \<in> U"
     and "\<forall>x\<in>U\<^sub>2. f (x::'a) \<in> U"
     and "\<And>i. i \<in> A \<Longrightarrow> \<exists>x\<in>B. g x \<le>\<^sub>o\<^sub>w f i"
     and "\<And>j. j \<in> B \<Longrightarrow> \<exists>x\<in>A. f x \<le>\<^sub>o\<^sub>w g j"
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` A) = \<Sqinter>\<^sub>o\<^sub>w (g ` B)"
     given complete_lattice_class.INF_eq
 proof-
   assume 
     "\<lbrakk>
       A \<subseteq> U\<^sub>2; 
       B \<subseteq> U\<^sub>3; 
       \<forall>x\<in>U\<^sub>3. g x \<in> U; 
       \<forall>x\<in>U\<^sub>2. f x \<in> U; 
       \<And>i. \<lbrakk>i \<in> U\<^sub>2; i \<in> A\<rbrakk> \<Longrightarrow> \<exists>x\<in>B. g x \<le>\<^sub>o\<^sub>w f i; 
       \<And>j. \<lbrakk>j \<in> U\<^sub>3; j \<in> B\<rbrakk> \<Longrightarrow> \<exists>x\<in>A. f x \<le>\<^sub>o\<^sub>w g j
     \<rbrakk> \<Longrightarrow> \<Sqinter>\<^sub>o\<^sub>w (f ` A) = \<Sqinter>\<^sub>o\<^sub>w (g ` B)"
     for A :: "'a set" and U\<^sub>2 and B :: "'b set" and U\<^sub>3 g f
   then have
     "\<lbrakk>
       A \<subseteq> U\<^sub>2; 
       B \<subseteq> U\<^sub>3; 
       \<forall>x\<in>U\<^sub>3. g x \<in> U; 
       \<forall>x\<in>U\<^sub>2. f x \<in> U; 
       \<And>i. i \<in> A \<Longrightarrow> \<exists>x\<in>B. g x \<le>\<^sub>o\<^sub>w f i; 
       \<And>j. j \<in> B \<Longrightarrow> \<exists>x\<in>A. f x \<le>\<^sub>o\<^sub>w g j
     \<rbrakk> \<Longrightarrow> \<Sqinter>\<^sub>o\<^sub>w (f ` A) = \<Sqinter>\<^sub>o\<^sub>w (g ` B)"
     by simp
   then show "\<Sqinter>\<^sub>o\<^sub>w (f ` A) = \<Sqinter>\<^sub>o\<^sub>w (g ` B)" using assms by simp
 qed
 
 end
 
 end
 
 context complete_lattice_ow
 begin
 
 context 
   fixes U\<^sub>2 :: "'b set" and U\<^sub>3 :: "'c set"
 begin
 
 lemmas [transfer_rule] =
   image_transfer[where ?'a='b]
   image_transfer[where ?'a='c]
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>) and (?'c to \<open>U\<^sub>3::'c set\<close>)
   rewriting ctr_simps
   substituting complete_lattice_ow_axioms and sup_bot.sl_neut.not_empty
   applying [
     OF _ _ Inf_closed' Sup_closed' inf_closed' sup_closed' bot_closed top_closed
     ]
 begin
 
 tts_lemma ne_INF_commute:
   assumes "U\<^sub>2 \<noteq> {}"
     and "U\<^sub>3 \<noteq> {}"
     and "\<forall>x\<in>U\<^sub>2. \<forall>y\<in>U\<^sub>3. f (x::'b) y \<in> U"
     and "B \<subseteq> U\<^sub>3"
     and "A \<subseteq> U\<^sub>2"
   shows "\<Sqinter>\<^sub>o\<^sub>w ((\<lambda>i. \<Sqinter>\<^sub>o\<^sub>w (f i ` B)) ` A) = \<Sqinter>\<^sub>o\<^sub>w ((\<lambda>j. \<Sqinter>\<^sub>o\<^sub>w ((\<lambda>i. f i j) ` A)) ` B)"
     is complete_lattice_class.INF_commute.
     
 tts_lemma ne_SUP_commute:
   assumes "U\<^sub>2 \<noteq> {}"
     and "U\<^sub>3 \<noteq> {}"
     and "\<forall>x\<in>U\<^sub>2. \<forall>y\<in>U\<^sub>3. f (x::'b) y \<in> U"
     and "B \<subseteq> U\<^sub>3"
     and "A \<subseteq> U\<^sub>2"
   shows "\<Squnion>\<^sub>o\<^sub>w ((\<lambda>i. \<Squnion>\<^sub>o\<^sub>w (f i ` B)) ` A) = \<Squnion>\<^sub>o\<^sub>w ((\<lambda>j. \<Squnion>\<^sub>o\<^sub>w ((\<lambda>i. f i j) ` A)) ` B)"
     is complete_lattice_class.SUP_commute.
     
 tts_lemma ne_SUP_mono:
   assumes "U\<^sub>2 \<noteq> {}"
     and "U\<^sub>3 \<noteq> {}"
     and "A \<subseteq> U\<^sub>2"
     and "B \<subseteq> U\<^sub>3"
     and "\<forall>x\<in>U\<^sub>2. f (x::'b) \<in> U"
     and "\<forall>x\<in>U\<^sub>3. g x \<in> U"
     and "\<And>n. \<lbrakk>n \<in> U\<^sub>2; n \<in> A\<rbrakk> \<Longrightarrow> \<exists>x\<in>B. f n \<le>\<^sub>o\<^sub>w g x"
   shows "\<Squnion>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (g ` B)"
     is complete_lattice_class.SUP_mono.
     
 tts_lemma ne_INF_mono:
   assumes "U\<^sub>2 \<noteq> {}"
     and "U\<^sub>3 \<noteq> {}"
     and "B \<subseteq> U\<^sub>2"
     and "A \<subseteq> U\<^sub>3"
     and "\<forall>x\<in>U\<^sub>3. f x \<in> U"
     and "\<forall>x\<in>U\<^sub>2. g (x::'b) \<in> U"
     and "\<And>m. \<lbrakk>m \<in> U\<^sub>2; m \<in> B\<rbrakk> \<Longrightarrow> \<exists>x\<in>A. f x \<le>\<^sub>o\<^sub>w g m"
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (g ` B)"
     is complete_lattice_class.INF_mono.
 
 end
 
 end
 
 lemma INF_commute:
   assumes "\<forall>x\<in>U\<^sub>2. \<forall>y\<in>U\<^sub>3. f x y \<in> U" and "B \<subseteq> U\<^sub>3" and "A \<subseteq> U\<^sub>2" 
   shows 
     "\<Sqinter>\<^sub>o\<^sub>w ((\<lambda>x. \<Sqinter>\<^sub>o\<^sub>w (f x ` B)) ` A) = \<Sqinter>\<^sub>o\<^sub>w ((\<lambda>j. \<Sqinter>\<^sub>o\<^sub>w ((\<lambda>i. f i j) ` A)) ` B)"
 proof(cases \<open>U\<^sub>2 = {}\<close>)
   case True then show ?thesis 
     using assms by (simp add: inf_top.sl_neut.neutral_map Inf_top_conv(2)) 
 next
   case ne_U\<^sub>2: False show ?thesis
   proof(cases \<open>U\<^sub>3 = {}\<close>)
     case True show ?thesis
     proof-
       from assms(2) have "B = {}" unfolding True by simp
       from assms(1) show ?thesis 
         unfolding \<open>B = {}\<close> by (force intro: INF_top)
     qed
   next
     case False 
     from ne_U\<^sub>2 False assms show ?thesis by (rule ne_INF_commute)
   qed
 qed
 
 lemma SUP_commute:
   assumes "\<forall>x\<in>U\<^sub>2. \<forall>y\<in>U\<^sub>3. f x y \<in> U" and "B \<subseteq> U\<^sub>3" and "A \<subseteq> U\<^sub>2"
   shows 
     "\<Squnion>\<^sub>o\<^sub>w ((\<lambda>x. \<Squnion>\<^sub>o\<^sub>w (f x ` B)) ` A) = \<Squnion>\<^sub>o\<^sub>w ((\<lambda>j. \<Squnion>\<^sub>o\<^sub>w ((\<lambda>i. f i j) ` A)) ` B)"
 proof(cases \<open>U\<^sub>2 = {}\<close>)
   case True show ?thesis
   proof-
     from assms(3) have "A = {}" unfolding True by simp
     from assms(2) show ?thesis 
       unfolding \<open>A = {}\<close> 
       by (simp add: sup_bot.sl_neut.neutral_map inf_absorb1 SUP_bot)
   qed
 next
   case ne_U\<^sub>2: False show ?thesis
   proof(cases \<open>U\<^sub>3 = {}\<close>)
     case True show ?thesis
     proof-
       from assms(2) have "B = {}" unfolding True by simp
       from assms(1) show ?thesis 
         unfolding \<open>B = {}\<close> 
         by (simp add: sup_bot.sl_neut.neutral_map Sup_bot_conv(1))
     qed
   next
     case False 
     from ne_U\<^sub>2 False assms show ?thesis by (rule ne_SUP_commute)
   qed
 qed
 
 lemma SUP_mono:
   assumes "A \<subseteq> U\<^sub>2" 
     and "B \<subseteq> U\<^sub>3" 
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U" 
     and "\<forall>x\<in>U\<^sub>3. g x \<in> U"
     and "\<And>n. n \<in> A \<Longrightarrow> \<exists>m\<in>B. f n \<le>\<^sub>o\<^sub>w g m" 
   shows "\<Squnion>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Squnion>\<^sub>o\<^sub>w (g ` B)"
 proof(cases \<open>U\<^sub>2 = {}\<close>)
   case True show ?thesis
   proof-
     from assms(1) have "A = {}" unfolding True by simp
     have "f ` A = {}" unfolding \<open>A = {}\<close> by simp
     from assms(2,4) show ?thesis 
       unfolding \<open>f ` A = {}\<close> by (simp add: image_subset_iff in_mono)
   qed
 next
   case ne_U\<^sub>2: False show ?thesis
   proof(cases \<open>U\<^sub>3 = {}\<close>)
     case True show ?thesis
     proof-
       from assms(2) have "B = {}" unfolding True by simp
       have "g ` B = {}" unfolding \<open>B = {}\<close> by simp
       from assms(1,3,5) show ?thesis
         unfolding \<open>g ` B = {}\<close> \<open>B = {}\<close> by (force simp: subset_iff)
     qed
   next
     case False 
     from ne_U\<^sub>2 False assms show ?thesis by (rule ne_SUP_mono)
   qed
 qed
 
 lemma INF_mono:
   assumes "B \<subseteq> U\<^sub>2" 
     and "A \<subseteq> U\<^sub>3" 
     and "\<forall>x\<in>U\<^sub>3. f x \<in> U" 
     and "\<forall>x\<in>U\<^sub>2. g x \<in> U"
     and "\<And>m. m \<in> B \<Longrightarrow> \<exists>n\<in>A. f n \<le>\<^sub>o\<^sub>w g m" 
   shows "\<Sqinter>\<^sub>o\<^sub>w (f ` A) \<le>\<^sub>o\<^sub>w \<Sqinter>\<^sub>o\<^sub>w (g ` B)"
 proof(cases \<open>U\<^sub>2 = {}\<close>)
   case True show ?thesis
   proof-
     from assms(1) have "B = {}" unfolding True by simp
     have "g ` B = {}" unfolding \<open>B = {}\<close> by simp
     from assms(2,3) show ?thesis 
       unfolding \<open>g ` B = {}\<close> by (simp add: image_subset_iff in_mono)
   qed
 next
   case ne_U\<^sub>2: False show ?thesis
   proof(cases \<open>U\<^sub>3 = {}\<close>)
     case True show ?thesis
     proof-
       from assms(2) have "A = {}" unfolding True by simp
       have "f ` A = {}" unfolding \<open>A = {}\<close> by simp
       from assms show ?thesis
         unfolding \<open>f ` A = {}\<close> \<open>A = {}\<close> by (auto simp: subset_iff) fastforce
     qed
   next
     case False from ne_U\<^sub>2 False assms show ?thesis by (rule ne_INF_mono)
   qed                                                              
 qed
 
 end
 
 context complete_lattice_pair_ow
 begin
 
-tts_context
-  tts: (?'a to U\<^sub>1) and (?'b to U\<^sub>2) 
-  rewriting ctr_simps
-  substituting cl\<^sub>1.complete_lattice_ow_axioms
-    and cl\<^sub>2.complete_lattice_ow_axioms
-    and cl\<^sub>1.inf_top.sl_neut.not_empty
-    and cl\<^sub>2.inf_top.sl_neut.not_empty
-  applying 
-    [
-      OF 
-        cl\<^sub>1.Inf_closed' 
-        cl\<^sub>1.Sup_closed' 
-        cl\<^sub>1.inf_closed'   
-        cl\<^sub>1.sup_closed'
-        cl\<^sub>1.bot_closed
-        cl\<^sub>1.top_closed
-        cl\<^sub>2.Inf_closed' 
-        cl\<^sub>2.Sup_closed' 
-        cl\<^sub>2.inf_closed'   
-        cl\<^sub>2.sup_closed'
-        cl\<^sub>2.bot_closed
-        cl\<^sub>2.top_closed
-    ]
-begin
-
-tts_lemma mono_Inf:
-  assumes "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
-    and "A \<subseteq> U\<^sub>1"
-    and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-  shows "f (\<Sqinter>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 A) \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 \<Sqinter>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 (f ` A)"
-    is complete_lattice_class.mono_Inf.
-    
-tts_lemma mono_Sup:
-  assumes "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
-    and "A \<subseteq> U\<^sub>1"
-    and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-  shows "\<Squnion>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 (f ` A) \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f (\<Squnion>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 A)"
-    is complete_lattice_class.mono_Sup.
-
-end
-
 context 
   fixes U\<^sub>3 :: "'c set"
 begin
 
 lemmas [transfer_rule] =
   image_transfer[where ?'a='c]
 
-tts_context
-  tts: (?'a to U\<^sub>1) and (?'b to U\<^sub>2) and (?'c to \<open>U\<^sub>3::'c set\<close>) 
-  rewriting ctr_simps
-  substituting cl\<^sub>1.complete_lattice_ow_axioms
-    and cl\<^sub>2.complete_lattice_ow_axioms
-    and cl\<^sub>1.inf_top.sl_neut.not_empty
-    and cl\<^sub>2.inf_top.sl_neut.not_empty
-  eliminating through (simp add: image_subset_iff image_subset_iff')
-  applying 
-    [
-      OF 
-        _
-        cl\<^sub>1.Inf_closed' 
-        cl\<^sub>1.Sup_closed' 
-        cl\<^sub>1.inf_closed'   
-        cl\<^sub>1.sup_closed'
-        cl\<^sub>1.bot_closed
-        cl\<^sub>1.top_closed
-        cl\<^sub>2.Inf_closed' 
-        cl\<^sub>2.Sup_closed' 
-        cl\<^sub>2.inf_closed'   
-        cl\<^sub>2.sup_closed'
-        cl\<^sub>2.bot_closed
-        cl\<^sub>2.top_closed
-    ]
-begin
-
-tts_lemma mono_SUP:
-  assumes "U\<^sub>3 \<noteq> {}"
-    and "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
-    and "\<forall>x\<in>U\<^sub>3. A x \<in> U\<^sub>1"
-    and "I \<subseteq> U\<^sub>3"
-    and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-  shows "\<Squnion>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 ((\<lambda>x. f (A x)) ` I) \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f (\<Squnion>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 (A ` I))"
-    is complete_lattice_class.mono_SUP.
-    
-tts_lemma mono_INF:
-  assumes "U\<^sub>3 \<noteq> {}"
-    and "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
-    and "\<forall>x\<in>U\<^sub>3. A x \<in> U\<^sub>1"
-    and "I \<subseteq> U\<^sub>3"
-    and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-  shows "f (\<Sqinter>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 (A ` I)) \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 \<Sqinter>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 ((\<lambda>x. f (A x)) ` I)"
-    is complete_lattice_class.mono_INF.
-    
-end
-
 end
 
 end
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Types_To_Sets_Extension/Examples/SML_Relativization/Lattices/SML_Linorders.thy b/thys/Types_To_Sets_Extension/Examples/SML_Relativization/Lattices/SML_Linorders.thy
--- a/thys/Types_To_Sets_Extension/Examples/SML_Relativization/Lattices/SML_Linorders.thy
+++ b/thys/Types_To_Sets_Extension/Examples/SML_Relativization/Lattices/SML_Linorders.thy
@@ -1,569 +1,472 @@
 (* Title: Examples/SML_Relativization/Lattices/SML_Linorders.thy
    Author: Mihails Milehins
    Copyright 2021 (C) Mihails Milehins
 *)
 section\<open>Relativization of the results about linear orders\<close>
 theory SML_Linorders
   imports SML_Semilattices
 begin               
 
 
 
 subsection\<open>Linear orders\<close>
 
 
 subsubsection\<open>Definitions and further properties\<close>
 
 locale linorder_ow = order_ow +
   assumes linear: "\<lbrakk> x \<in> U; y \<in> U \<rbrakk> \<Longrightarrow> x \<le>\<^sub>o\<^sub>w y \<or> y \<le>\<^sub>o\<^sub>w x"
 begin
 
 sublocale min: 
   semilattice_order_ow U \<open>(\<lambda>x y. (with (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>min\<guillemotright> x y))\<close> \<open>(\<le>\<^sub>o\<^sub>w)\<close> \<open>(<\<^sub>o\<^sub>w)\<close>
   apply unfold_locales
   subgoal unfolding min.with_def by simp
   subgoal by (metis linear order_trans min.with_def)
   subgoal unfolding min.with_def by (auto dest: linear simp: antisym)
   subgoal unfolding min.with_def by simp
   subgoal unfolding min.with_def by (simp add: eq_iff)
   subgoal unfolding min.with_def by (simp add: less_le)
   done             
 
 sublocale max: 
   semilattice_order_ow U \<open>(\<lambda>x y. (with (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>max\<guillemotright> x y))\<close> \<open>(\<ge>\<^sub>o\<^sub>w)\<close> \<open>(>\<^sub>o\<^sub>w)\<close>
   apply unfold_locales
   subgoal unfolding max.with_def by simp
   subgoal by (metis linear order_trans max.with_def)
   subgoal unfolding max.with_def by (auto dest: linear simp: antisym)
   subgoal unfolding max.with_def by simp
   subgoal unfolding max.with_def by (auto dest: linear simp: antisym)
   subgoal unfolding max.with_def by (auto dest: linear simp: less_le_not_le)
   done
 
 end
 
 locale ord_linorder_ow = 
   ord?: ord_ow U\<^sub>1 le\<^sub>1 ls\<^sub>1 + lo?: linorder_ow U\<^sub>2 le\<^sub>2 ls\<^sub>2
   for U\<^sub>1 :: "'ao set" and le\<^sub>1 ls\<^sub>1 and U\<^sub>2 :: "'bo set" and le\<^sub>2 ls\<^sub>2
 begin
 
 sublocale ord_order_ow ..
 
 end
 
 locale preorder_linorder_ow = 
   po?: preorder_ow U\<^sub>1 le\<^sub>1 ls\<^sub>1 + lo?: linorder_ow U\<^sub>2 le\<^sub>2 ls\<^sub>2
   for U\<^sub>1 :: "'ao set" and le\<^sub>1 ls\<^sub>1 and U\<^sub>2 :: "'bo set" and le\<^sub>2 ls\<^sub>2
 begin
 
 sublocale preorder_order_ow ..
 
 end
 
 locale order_linorder_ow = 
   order?: order_ow U\<^sub>1 le\<^sub>1 ls\<^sub>1 + lo?: linorder_ow U\<^sub>2 le\<^sub>2 ls\<^sub>2
   for U\<^sub>1 :: "'ao set" and le\<^sub>1 ls\<^sub>1 and U\<^sub>2 :: "'bo set" and le\<^sub>2 ls\<^sub>2
 begin
 
 sublocale order_pair_ow ..
 
 end
 
 locale linorder_pair_ow = 
   lo\<^sub>1?: linorder_ow U\<^sub>1 le\<^sub>1 ls\<^sub>1 + lo\<^sub>2?: linorder_ow U\<^sub>2 le\<^sub>2 ls\<^sub>2
   for U\<^sub>1 :: "'ao set" and le\<^sub>1 ls\<^sub>1 and U\<^sub>2 :: "'bo set" and le\<^sub>2 ls\<^sub>2
 begin
 
 sublocale order_linorder_ow ..
 
 end
 
 
 subsubsection\<open>Transfer rules\<close>
 
 context
   includes lifting_syntax
 begin
 
 lemma linorder_transfer[transfer_rule]:
   assumes [transfer_rule]: "bi_unique A" "right_total A" 
   shows 
     "((A ===> A ===> (=)) ===> (A ===> A ===> (=)) ===> (=)) 
       (linorder_ow (Collect (Domainp A))) class.linorder"
   unfolding 
     linorder_ow_def class.linorder_def
     linorder_ow_axioms_def class.linorder_axioms_def
   apply transfer_prover_start
   apply transfer_step+
   by simp
   
 end
 
 
 subsubsection\<open>Relativization\<close>
 
 context linorder_ow 
 begin
 
 tts_context
   tts: (?'a to U)
   rewriting ctr_simps
   substituting linorder_ow_axioms
   eliminating through simp
 begin
 
 tts_lemma le_less_linear:
   assumes "x \<in> U" and "y \<in> U"
   shows "x \<le>\<^sub>o\<^sub>w y \<or> y <\<^sub>o\<^sub>w x"
   is linorder_class.le_less_linear.
 
 tts_lemma not_less:
   assumes "x \<in> U" and "y \<in> U"
   shows "(\<not> x <\<^sub>o\<^sub>w y) = (y \<le>\<^sub>o\<^sub>w x)"
     is linorder_class.not_less.
     
 tts_lemma not_le:
   assumes "x \<in> U" and "y \<in> U"
   shows "(\<not> x \<le>\<^sub>o\<^sub>w y) = (y <\<^sub>o\<^sub>w x)"
     is linorder_class.not_le.
 
 tts_lemma lessThan_minus_lessThan:
   assumes "n \<in> U" and "m \<in> U"
   shows "{..<\<^sub>o\<^sub>wn} - {..<\<^sub>o\<^sub>wm} = (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {m..<n})"
     is linorder_class.lessThan_minus_lessThan.
 
 tts_lemma Ici_subset_Ioi_iff:
   assumes "a \<in> U" and "b \<in> U"
   shows "({a..\<^sub>o\<^sub>w} \<subseteq> {b<\<^sub>o\<^sub>w..}) = (b <\<^sub>o\<^sub>w a)"
     is linorder_class.Ici_subset_Ioi_iff.
 
 tts_lemma Iic_subset_Iio_iff:
   assumes "a \<in> U" and "b \<in> U"
   shows "({..\<^sub>o\<^sub>wa} \<subseteq> {..<\<^sub>o\<^sub>wb}) = (a <\<^sub>o\<^sub>w b)"
     is linorder_class.Iic_subset_Iio_iff.
 
 tts_lemma leI:
   assumes "x \<in> U" and "y \<in> U" and "\<not> x <\<^sub>o\<^sub>w y"
   shows "y \<le>\<^sub>o\<^sub>w x"
     is linorder_class.leI.
 
 tts_lemma not_le_imp_less:
   assumes "y \<in> U" and "x \<in> U" and "\<not> y \<le>\<^sub>o\<^sub>w x"
   shows "x <\<^sub>o\<^sub>w y"
     is linorder_class.not_le_imp_less.
 
 tts_lemma Int_atMost:
   assumes "a \<in> U" and "b \<in> U"
   shows "{..\<^sub>o\<^sub>wa} \<inter> {..\<^sub>o\<^sub>wb} = {..\<^sub>o\<^sub>wmin a b}"
     is linorder_class.Int_atMost.
 
 tts_lemma lessThan_Int_lessThan:
   assumes "a \<in> U" and "b \<in> U"
   shows "{a<\<^sub>o\<^sub>w..} \<inter> {b<\<^sub>o\<^sub>w..} = {max a b<\<^sub>o\<^sub>w..}"
     is linorder_class.lessThan_Int_lessThan.
 
 tts_lemma greaterThan_Int_greaterThan:
   assumes "a \<in> U" and "b \<in> U"
   shows "{..<\<^sub>o\<^sub>wa} \<inter> {..<\<^sub>o\<^sub>wb} = {..<\<^sub>o\<^sub>wmin a b}"
     is linorder_class.greaterThan_Int_greaterThan.
 
 tts_lemma less_linear:
   assumes "x \<in> U" and "y \<in> U"
   shows "x <\<^sub>o\<^sub>w y \<or> x = y \<or> y <\<^sub>o\<^sub>w x"
     is linorder_class.less_linear.
 
 tts_lemma Int_atLeastAtMostR2:
   assumes "a \<in> U" and "c \<in> U" and "d \<in> U"
   shows "{a..\<^sub>o\<^sub>w} \<inter> {c..\<^sub>o\<^sub>wd} = {max a c..\<^sub>o\<^sub>wd}"
     is linorder_class.Int_atLeastAtMostR2.
 
 tts_lemma Int_atLeastAtMostR1:
   assumes "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows "{..\<^sub>o\<^sub>wb} \<inter> {c..\<^sub>o\<^sub>wd} = {c..\<^sub>o\<^sub>wmin b d}"
     is linorder_class.Int_atLeastAtMostR1.
 
 tts_lemma Int_atLeastAtMostL2:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U"
   shows "{a..\<^sub>o\<^sub>wb} \<inter> {c..\<^sub>o\<^sub>w} = {max a c..\<^sub>o\<^sub>wb}"
     is linorder_class.Int_atLeastAtMostL2.
 
 tts_lemma Int_atLeastAtMostL1:
   assumes "a \<in> U" and "b \<in> U" and "d \<in> U"
   shows "{a..\<^sub>o\<^sub>wb} \<inter> {..\<^sub>o\<^sub>wd} = {a..\<^sub>o\<^sub>wmin b d}"
     is linorder_class.Int_atLeastAtMostL1.
 
 tts_lemma neq_iff:
   assumes "x \<in> U" and "y \<in> U"
   shows "(x \<noteq> y) = (x <\<^sub>o\<^sub>w y \<or> y <\<^sub>o\<^sub>w x)"
     is linorder_class.neq_iff.
 
 tts_lemma not_less_iff_gr_or_eq:
   assumes "x \<in> U" and "y \<in> U"
   shows "(\<not> x <\<^sub>o\<^sub>w y) = (y <\<^sub>o\<^sub>w x \<or> x = y)"
     is linorder_class.not_less_iff_gr_or_eq.
 
 tts_lemma max_min_distrib2:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U"
   shows "max a (min b c) = min (max a b) (max a c)"
     is linorder_class.max_min_distrib2.
 
 tts_lemma max_min_distrib1:
   assumes "b \<in> U" and "c \<in> U" and "a \<in> U"
   shows "max (min b c) a = min (max b a) (max c a)"
     is linorder_class.max_min_distrib1.
 
 tts_lemma min_max_distrib2:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U"
   shows "min a (max b c) = max (min a b) (min a c)"
     is linorder_class.min_max_distrib2.
 
 tts_lemma min_max_distrib1:
   assumes "b \<in> U" and "c \<in> U" and "a \<in> U"
   shows "min (max b c) a = max (min b a) (min c a)"
     is linorder_class.min_max_distrib1.
 
 tts_lemma atLeastAtMost_diff_ends:
   assumes "a \<in> U" and "b \<in> U"
   shows "{a..\<^sub>o\<^sub>wb} - {a, b} = {a<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wb}"
     is linorder_class.atLeastAtMost_diff_ends.
 
 tts_lemma less_max_iff_disj:
   assumes "z \<in> U" and "x \<in> U" and "y \<in> U"
   shows "(z <\<^sub>o\<^sub>w max x y) = (z <\<^sub>o\<^sub>w x \<or> z <\<^sub>o\<^sub>w y)"
     is linorder_class.less_max_iff_disj.
 
 tts_lemma min_less_iff_conj:
   assumes "z \<in> U" and "x \<in> U" and "y \<in> U"
   shows "(z <\<^sub>o\<^sub>w min x y) = (z <\<^sub>o\<^sub>w x \<and> z <\<^sub>o\<^sub>w y)"
     is linorder_class.min_less_iff_conj.
 
 tts_lemma max_less_iff_conj:
   assumes "x \<in> U" and "y \<in> U" and "z \<in> U"
   shows "(max x y <\<^sub>o\<^sub>w z) = (x <\<^sub>o\<^sub>w z \<and> y <\<^sub>o\<^sub>w z)"
     is linorder_class.max_less_iff_conj.
 
 tts_lemma min_less_iff_disj:
   assumes "x \<in> U" and "y \<in> U" and "z \<in> U"
   shows "(min x y <\<^sub>o\<^sub>w z) = (x <\<^sub>o\<^sub>w z \<or> y <\<^sub>o\<^sub>w z)"
     is linorder_class.min_less_iff_disj.
 
 tts_lemma le_max_iff_disj:
   assumes "z \<in> U" and "x \<in> U" and "y \<in> U"
   shows "(z \<le>\<^sub>o\<^sub>w max x y) = (z \<le>\<^sub>o\<^sub>w x \<or> z \<le>\<^sub>o\<^sub>w y)"
     is linorder_class.le_max_iff_disj.
 
 tts_lemma min_le_iff_disj:
   assumes "x \<in> U" and "y \<in> U" and "z \<in> U"
   shows "(min x y \<le>\<^sub>o\<^sub>w z) = (x \<le>\<^sub>o\<^sub>w z \<or> y \<le>\<^sub>o\<^sub>w z)"
     is linorder_class.min_le_iff_disj.
 
 tts_lemma antisym_conv3:
   assumes "y \<in> U" and "x \<in> U" and "\<not> y <\<^sub>o\<^sub>w x"
   shows "(\<not> x <\<^sub>o\<^sub>w y) = (x = y)"
     is linorder_class.antisym_conv3.
 
 tts_lemma Int_atLeastAtMost:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows "{a..\<^sub>o\<^sub>wb} \<inter> {c..\<^sub>o\<^sub>wd} = {max a c..\<^sub>o\<^sub>wmin b d}"
     is linorder_class.Int_atLeastAtMost.
 
 tts_lemma Int_atLeastLessThan:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows 
     "(on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {a..<b}) \<inter> (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {c..<d}) = 
       (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {(max a c)..<(min b d)})"
     is linorder_class.Int_atLeastLessThan.
 
 tts_lemma Int_greaterThanAtMost:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows "{a<\<^sub>o\<^sub>w..b} \<inter> {c<\<^sub>o\<^sub>w..d} = {max a c<\<^sub>o\<^sub>w..min b d}"
     is linorder_class.Int_greaterThanAtMost.
 
 tts_lemma Int_greaterThanLessThan:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows "{a<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wb} \<inter> {c<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wd} = {max a c<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wmin b d}"
     is linorder_class.Int_greaterThanLessThan.
 
 tts_lemma le_cases:
   assumes "x \<in> U" and "y \<in> U" and "x \<le>\<^sub>o\<^sub>w y \<Longrightarrow> P" and "y \<le>\<^sub>o\<^sub>w x \<Longrightarrow> P"
   shows P
     is linorder_class.le_cases.
 
 tts_lemma split_max:
   assumes "i \<in> U" and "j \<in> U"
   shows "P (max i j) = ((i \<le>\<^sub>o\<^sub>w j \<longrightarrow> P j) \<and> (\<not> i \<le>\<^sub>o\<^sub>w j \<longrightarrow> P i))"
     is linorder_class.split_max.
 
 tts_lemma split_min:
   assumes "i \<in> U" and "j \<in> U"
   shows "P (min i j) = ((i \<le>\<^sub>o\<^sub>w j \<longrightarrow> P i) \<and> (\<not> i \<le>\<^sub>o\<^sub>w j \<longrightarrow> P j))"
     is linorder_class.split_min.
 
 tts_lemma Ioc_subset_iff:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows "({a<\<^sub>o\<^sub>w..b} \<subseteq> {c<\<^sub>o\<^sub>w..d}) = (b \<le>\<^sub>o\<^sub>w a \<or> b \<le>\<^sub>o\<^sub>w d \<and> c \<le>\<^sub>o\<^sub>w a)"
     is linorder_class.Ioc_subset_iff.
 
 tts_lemma atLeastLessThan_subset_iff:
   assumes "a \<in> U"
     and "b \<in> U"
     and "c \<in> U"
     and "d \<in> U"
     and "(on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {a..<b}) \<subseteq> (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {c..<d})"
   shows "b \<le>\<^sub>o\<^sub>w a \<or> b \<le>\<^sub>o\<^sub>w d \<and> c \<le>\<^sub>o\<^sub>w a"
     is linorder_class.atLeastLessThan_subset_iff.
 
 tts_lemma Ioc_inj:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows "({a<\<^sub>o\<^sub>w..b} = {c<\<^sub>o\<^sub>w..d}) = (b \<le>\<^sub>o\<^sub>w a \<and> d \<le>\<^sub>o\<^sub>w c \<or> a = c \<and> b = d)"
     is linorder_class.Ioc_inj.
 
 tts_lemma neqE:
   assumes "x \<in> U"
     and "y \<in> U"
     and "x \<noteq> y"
     and "x <\<^sub>o\<^sub>w y \<Longrightarrow> R"
     and "y <\<^sub>o\<^sub>w x \<Longrightarrow> R"
   shows R
     is linorder_class.neqE.
 
 tts_lemma Ioc_disjoint:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows 
     "({a<\<^sub>o\<^sub>w..b} \<inter> {c<\<^sub>o\<^sub>w..d} = {}) = (b \<le>\<^sub>o\<^sub>w a \<or> d \<le>\<^sub>o\<^sub>w c \<or> b \<le>\<^sub>o\<^sub>w c \<or> d \<le>\<^sub>o\<^sub>w a)"
     is linorder_class.Ioc_disjoint.
 
 tts_lemma linorder_cases:
   assumes "x \<in> U"
     and "y \<in> U"
     and "x <\<^sub>o\<^sub>w y \<Longrightarrow> P"
     and "x = y \<Longrightarrow> P"
     and "y <\<^sub>o\<^sub>w x \<Longrightarrow> P"
   shows P
     is linorder_class.linorder_cases.
 
 tts_lemma le_cases3:
   assumes "x \<in> U"
     and "y \<in> U"
     and "z \<in> U"
     and "\<lbrakk>x \<le>\<^sub>o\<^sub>w y; y \<le>\<^sub>o\<^sub>w z\<rbrakk> \<Longrightarrow> P"
     and "\<lbrakk>y \<le>\<^sub>o\<^sub>w x; x \<le>\<^sub>o\<^sub>w z\<rbrakk> \<Longrightarrow> P"
     and "\<lbrakk>x \<le>\<^sub>o\<^sub>w z; z \<le>\<^sub>o\<^sub>w y\<rbrakk> \<Longrightarrow> P"
     and "\<lbrakk>z \<le>\<^sub>o\<^sub>w y; y \<le>\<^sub>o\<^sub>w x\<rbrakk> \<Longrightarrow> P"
     and "\<lbrakk>y \<le>\<^sub>o\<^sub>w z; z \<le>\<^sub>o\<^sub>w x\<rbrakk> \<Longrightarrow> P"
     and "\<lbrakk>z \<le>\<^sub>o\<^sub>w x; x \<le>\<^sub>o\<^sub>w y\<rbrakk> \<Longrightarrow> P"
   shows P
     is linorder_class.le_cases3.
 
 end
 
 end
 
-context order_linorder_ow
-begin
-
-tts_context
-  tts: (?'a to U\<^sub>2) and (?'b to U\<^sub>1)
-  rewriting ctr_simps
-  substituting order.order_ow_axioms and lo.linorder_ow_axioms
-  eliminating through simp
-begin
-
-
-tts_lemma strict_mono_imp_inj_on:
-  assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U\<^sub>1"
-    and "A \<subseteq> U\<^sub>2"
-    and "on U\<^sub>2 with (<\<^sub>o\<^sub>w\<^sub>.\<^sub>1) (<\<^sub>o\<^sub>w\<^sub>.\<^sub>2) : \<guillemotleft>strict_mono\<guillemotright> f"
-  shows "inj_on f A"
-    is linorder_class.strict_mono_imp_inj_on.
-    
-tts_lemma strict_mono_eq:
-  assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U\<^sub>1"
-    and "x \<in> U\<^sub>2"
-    and "y \<in> U\<^sub>2"
-    and "on U\<^sub>2 with (<\<^sub>o\<^sub>w\<^sub>.\<^sub>1) (<\<^sub>o\<^sub>w\<^sub>.\<^sub>2) : \<guillemotleft>strict_mono\<guillemotright> f"
-  shows "(f x = f y) = (x = y)"
-    is linorder_class.strict_mono_eq.
-
-tts_lemma strict_mono_less:
-  assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U\<^sub>1"
-    and "x \<in> U\<^sub>2"
-    and "y \<in> U\<^sub>2"
-    and "on U\<^sub>2 with (<\<^sub>o\<^sub>w\<^sub>.\<^sub>1) (<\<^sub>o\<^sub>w\<^sub>.\<^sub>2) : \<guillemotleft>strict_mono\<guillemotright> f"
-  shows "(f x <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 f y) = (x <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 y)"
-    is linorder_class.strict_mono_less.
-    
-tts_lemma strict_mono_less_eq:
-  assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U\<^sub>1"
-    and "x \<in> U\<^sub>2"
-    and "y \<in> U\<^sub>2"
-    and "on U\<^sub>2 with (<\<^sub>o\<^sub>w\<^sub>.\<^sub>1) (<\<^sub>o\<^sub>w\<^sub>.\<^sub>2) : \<guillemotleft>strict_mono\<guillemotright> f"
-  shows "(f x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 f y) = (x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 y)"
-    is linorder_class.strict_mono_less_eq.
-    
-tts_lemma mono_strict_invE:
-  assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U\<^sub>1"
-    and "x \<in> U\<^sub>2"
-    and "y \<in> U\<^sub>2"
-    and "on U\<^sub>2 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) : \<guillemotleft>mono\<guillemotright> f"
-    and "f x <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 f y"
-    and "x <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 y \<Longrightarrow> thesis"
-  shows thesis
-    is linorder_class.mono_strict_invE.
-
-tts_lemma mono_invE:
-  assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U\<^sub>1"
-    and "x \<in> U\<^sub>2"
-    and "y \<in> U\<^sub>2"
-    and "on U\<^sub>2 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) : \<guillemotleft>mono\<guillemotright> f"
-    and "f x <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 f y"
-    and "x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 y \<Longrightarrow> thesis"
-  shows thesis
-    is linorder_class.mono_invE.
-
-end
-    
-end
-
-context linorder_pair_ow
-begin
-
-tts_context
-  tts: (?'a to U\<^sub>1) and (?'b to U\<^sub>2)
-  rewriting ctr_simps
-  substituting lo\<^sub>1.linorder_ow_axioms and lo\<^sub>2.linorder_ow_axioms
-  eliminating through simp
-begin
-
-tts_lemma max_of_mono:
-  assumes "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
-    and "m \<in> U\<^sub>1"
-    and "n \<in> U\<^sub>1"
-    and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-  shows "lo\<^sub>2.max (f m) (f n) = f (lo\<^sub>1.max m n)"
-    is linorder_class.max_of_mono.
-
-tts_lemma min_of_mono:
-  assumes "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
-    and "m \<in> U\<^sub>1"
-    and "n \<in> U\<^sub>1"
-    and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-  shows "lo\<^sub>2.min (f m) (f n) = f (lo\<^sub>1.min m n)"
-    is linorder_class.min_of_mono.
-
-end
-
-end
-
-
 
 subsection\<open>Dense linear orders\<close>
 
 
 subsubsection\<open>Definitions and further properties\<close>
 
 locale dense_linorder_ow = linorder_ow U le ls + dense_order_ow U le ls
   for U :: "'ao set" and le (infix \<open>\<le>\<^sub>o\<^sub>w\<close> 50) and ls (infix \<open><\<^sub>o\<^sub>w\<close> 50)
 
 
 subsubsection\<open>Transfer rules\<close>
 
 context
   includes lifting_syntax
 begin
 
 lemma dense_linorder_transfer[transfer_rule]:
   assumes [transfer_rule]: "bi_unique A" "right_total A" 
   shows 
     "((A ===> A ===> (=)) ===> (A ===> A ===> (=))  ===> (=)) 
       (dense_linorder_ow (Collect (Domainp A))) class.dense_linorder"
   unfolding dense_linorder_ow_def class.dense_linorder_def
   apply transfer_prover_start
   apply transfer_step+
   by auto
 
 end
 
 
 subsubsection\<open>Relativization\<close>
 
 context dense_linorder_ow 
 begin
 
 tts_context
   tts: (?'a to U)
   rewriting ctr_simps
   substituting dense_linorder_ow_axioms
   eliminating through simp
 begin
 
 tts_lemma infinite_Icc:
   assumes "a \<in> U" and "b \<in> U" and "a <\<^sub>o\<^sub>w b"
   shows "infinite {a..\<^sub>o\<^sub>wb}"
     is dense_linorder_class.infinite_Icc.
 
 tts_lemma infinite_Ico:
   assumes "a \<in> U" and "b \<in> U" and "a <\<^sub>o\<^sub>w b"
   shows "infinite (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {a..<b})"
     is dense_linorder_class.infinite_Ico.
 
 tts_lemma infinite_Ioc:
   assumes "a \<in> U" and "b \<in> U" and "a <\<^sub>o\<^sub>w b"
   shows "infinite {a<\<^sub>o\<^sub>w..b}"
     is dense_linorder_class.infinite_Ioc.
 
 tts_lemma infinite_Ioo:
   assumes "a \<in> U" and "b \<in> U" and "a <\<^sub>o\<^sub>w b"
   shows "infinite {a<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wb}"
     is dense_linorder_class.infinite_Ioo.
 
 tts_lemma atLeastLessThan_subseteq_atLeastAtMost_iff:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows 
     "((on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {a..<b}) \<subseteq> {c..\<^sub>o\<^sub>wd}) = 
       (a <\<^sub>o\<^sub>w b \<longrightarrow> b \<le>\<^sub>o\<^sub>w d \<and> c \<le>\<^sub>o\<^sub>w a)"
     is dense_linorder_class.atLeastLessThan_subseteq_atLeastAtMost_iff.
 
 tts_lemma greaterThanAtMost_subseteq_atLeastAtMost_iff:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows "({a<\<^sub>o\<^sub>w..b} \<subseteq> {c..\<^sub>o\<^sub>wd}) = (a <\<^sub>o\<^sub>w b \<longrightarrow> b \<le>\<^sub>o\<^sub>w d \<and> c \<le>\<^sub>o\<^sub>w a)"
     is dense_linorder_class.greaterThanAtMost_subseteq_atLeastAtMost_iff.
 
 tts_lemma greaterThanAtMost_subseteq_atLeastLessThan_iff:
   assumes "a \<in> U"
     and "b \<in> U"
     and "c \<in> U"
     and "d \<in> U"
   shows "({a<\<^sub>o\<^sub>w..b} \<subseteq> (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {c..<d})) = 
     (a <\<^sub>o\<^sub>w b \<longrightarrow> b <\<^sub>o\<^sub>w d \<and> c \<le>\<^sub>o\<^sub>w a)"
     is dense_linorder_class.greaterThanAtMost_subseteq_atLeastLessThan_iff.
 
 tts_lemma greaterThanLessThan_subseteq_atLeastAtMost_iff:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows "({a<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wb} \<subseteq> {c..\<^sub>o\<^sub>wd}) = (a <\<^sub>o\<^sub>w b \<longrightarrow> b \<le>\<^sub>o\<^sub>w d \<and> c \<le>\<^sub>o\<^sub>w a)"
     is dense_linorder_class.greaterThanLessThan_subseteq_atLeastAtMost_iff.
 
 tts_lemma greaterThanLessThan_subseteq_atLeastLessThan_iff:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows 
     "({a<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wb} \<subseteq> (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {c..<d})) = 
       (a <\<^sub>o\<^sub>w b \<longrightarrow> b \<le>\<^sub>o\<^sub>w d \<and> c \<le>\<^sub>o\<^sub>w a)"
     is dense_linorder_class.greaterThanLessThan_subseteq_atLeastLessThan_iff.
 
 tts_lemma greaterThanLessThan_subseteq_greaterThanAtMost_iff:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows "({a<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wb} \<subseteq> {c<\<^sub>o\<^sub>w..d}) = (a <\<^sub>o\<^sub>w b \<longrightarrow> b \<le>\<^sub>o\<^sub>w d \<and> c \<le>\<^sub>o\<^sub>w a)"
     is dense_linorder_class.greaterThanLessThan_subseteq_greaterThanAtMost_iff.
 
 tts_lemma greaterThanLessThan_subseteq_greaterThanLessThan:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows "({a<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wb} \<subseteq> {c<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wd}) = (a <\<^sub>o\<^sub>w b \<longrightarrow> b \<le>\<^sub>o\<^sub>w d \<and> c \<le>\<^sub>o\<^sub>w a)"
     is dense_linorder_class.greaterThanLessThan_subseteq_greaterThanLessThan.
 
 end
 
 end
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file
diff --git a/thys/Types_To_Sets_Extension/Examples/SML_Relativization/Simple_Orders/SML_Simple_Orders.thy b/thys/Types_To_Sets_Extension/Examples/SML_Relativization/Simple_Orders/SML_Simple_Orders.thy
--- a/thys/Types_To_Sets_Extension/Examples/SML_Relativization/Simple_Orders/SML_Simple_Orders.thy
+++ b/thys/Types_To_Sets_Extension/Examples/SML_Relativization/Simple_Orders/SML_Simple_Orders.thy
@@ -1,1985 +1,1821 @@
 (* Title: Examples/SML_Relativization/Simple_Orders/SML_Simple_Orders.thy
    Author: Mihails Milehins
    Copyright 2021 (C) Mihails Milehins
 *)
 section\<open>Relativization of the results about orders\<close>
 theory SML_Simple_Orders
   imports 
     "../../Introduction"
     "../Foundations/SML_Relations"
     Complex_Main
 begin
 
 
 
 subsection\<open>Class \<^class>\<open>ord\<close>\<close>
 
 
 subsubsection\<open>Definitions and common properties\<close>
 
 locale ord_ow =
   fixes U :: "'ao set"
     and le :: "['ao, 'ao] \<Rightarrow> bool" (infix \<open>\<le>\<^sub>o\<^sub>w\<close> 50) 
     and ls :: "['ao, 'ao] \<Rightarrow> bool" (infix \<open><\<^sub>o\<^sub>w\<close> 50)
 begin
 
 notation le (\<open>'(\<le>\<^sub>o\<^sub>w')\<close>)
   and le (infix \<open>\<le>\<^sub>o\<^sub>w\<close> 50) 
   and ls (\<open>'(<\<^sub>o\<^sub>w')\<close>) 
   and ls (infix \<open><\<^sub>o\<^sub>w\<close> 50)
 
 abbreviation (input) ge (infix \<open>\<ge>\<^sub>o\<^sub>w\<close> 50) where "x \<ge>\<^sub>o\<^sub>w y \<equiv> y \<le>\<^sub>o\<^sub>w x"
 abbreviation (input) gt (infix \<open>>\<^sub>o\<^sub>w\<close> 50) where "x >\<^sub>o\<^sub>w y \<equiv> y <\<^sub>o\<^sub>w x"
 
 notation ge (\<open>'(\<ge>\<^sub>o\<^sub>w')\<close>) 
   and ge (infix \<open>\<ge>\<^sub>o\<^sub>w\<close> 50) 
   and gt (\<open>'(>\<^sub>o\<^sub>w')\<close>) 
   and gt (infix \<open>>\<^sub>o\<^sub>w\<close> 50)
 
 tts_register_sbts \<open>(\<le>\<^sub>o\<^sub>w)\<close> | U
 proof-
   assume "Domainp AOA = (\<lambda>x. x \<in> U)" "bi_unique AOA" "right_total AOA" 
   from tts_AA_eq_transfer[OF this] show ?thesis by auto
 qed
 
 tts_register_sbts \<open>(<\<^sub>o\<^sub>w)\<close> | U
 proof-
   assume "Domainp AOA = (\<lambda>x. x \<in> U)" "bi_unique AOA" "right_total AOA" 
   from tts_AA_eq_transfer[OF this] show ?thesis by auto
 qed
 
 end
 
 locale ord_pair_ow = ord\<^sub>1: ord_ow U\<^sub>1 le\<^sub>1 ls\<^sub>1 + ord\<^sub>2: ord_ow U\<^sub>2 le\<^sub>2 ls\<^sub>2
   for U\<^sub>1 :: "'ao set" and le\<^sub>1 ls\<^sub>1 and U\<^sub>2 :: "'bo set" and le\<^sub>2 ls\<^sub>2
 begin
 
 notation le\<^sub>1 (\<open>'(\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1')\<close>)
   and le\<^sub>1 (infix \<open>\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1\<close> 50) 
   and ls\<^sub>1 (\<open>'(<\<^sub>o\<^sub>w\<^sub>.\<^sub>1')\<close>) 
   and ls\<^sub>1 (infix \<open><\<^sub>o\<^sub>w\<^sub>.\<^sub>1\<close> 50)
   and le\<^sub>2 (\<open>'(\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2')\<close>)
   and le\<^sub>2 (infix \<open>\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2\<close> 50) 
   and ls\<^sub>2 (\<open>'(<\<^sub>o\<^sub>w\<^sub>.\<^sub>2')\<close>) 
   and ls\<^sub>2 (infix \<open><\<^sub>o\<^sub>w\<^sub>.\<^sub>2\<close> 50)
 
 notation ord\<^sub>1.ge (\<open>'(\<ge>\<^sub>o\<^sub>w\<^sub>.\<^sub>1')\<close>) 
   and ord\<^sub>1.ge (infix \<open>\<ge>\<^sub>o\<^sub>w\<^sub>.\<^sub>1\<close> 50) 
   and ord\<^sub>1.gt (\<open>'(>\<^sub>o\<^sub>w\<^sub>.\<^sub>1')\<close>) 
   and ord\<^sub>1.gt (infix \<open>>\<^sub>o\<^sub>w\<^sub>.\<^sub>1\<close> 50)
   and ord\<^sub>2.ge (\<open>'(\<ge>\<^sub>o\<^sub>w\<^sub>.\<^sub>2')\<close>) 
   and ord\<^sub>2.ge (infix \<open>\<ge>\<^sub>o\<^sub>w\<^sub>.\<^sub>2\<close> 50) 
   and ord\<^sub>2.gt (\<open>'(>\<^sub>o\<^sub>w\<^sub>.\<^sub>2')\<close>) 
   and ord\<^sub>2.gt (infix \<open>>\<^sub>o\<^sub>w\<^sub>.\<^sub>2\<close> 50)
 
 end
 
 ud \<open>ord.lessThan\<close> (\<open>(with _ : ({..<_}))\<close> [1000] 10)
 ud lessThan' \<open>lessThan\<close> 
 ud \<open>ord.atMost\<close> (\<open>(with _ : ({.._}))\<close> [1000] 10) 
 ud atMost' \<open>atMost\<close> 
 ud \<open>ord.greaterThan\<close> (\<open>(with _ : ({_<..}))\<close> [1000] 10) 
 ud greaterThan' \<open>greaterThan\<close> 
 ud \<open>ord.atLeast\<close> (\<open>(with _ : ({_..}))\<close> [1000] 10) 
 ud atLeast' \<open>atLeast\<close> 
 ud \<open>ord.greaterThanLessThan\<close> (\<open>(with _ : ({_<..<_}))\<close> [1000, 999, 1000] 10) 
 ud greaterThanLessThan' \<open>greaterThanLessThan\<close> 
 ud \<open>ord.atLeastLessThan\<close> (\<open>(with _ _ : ({_..<_}))\<close> [1000, 999, 1000, 1000] 10)
 ud atLeastLessThan' \<open>atLeastLessThan\<close> 
 ud \<open>ord.greaterThanAtMost\<close> (\<open>(with _ _ : ({_<.._}))\<close> [1000, 999, 1000, 999] 10) 
 ud greaterThanAtMost' \<open>greaterThanAtMost\<close> 
 ud \<open>ord.atLeastAtMost\<close> (\<open>(with _ : ({_.._}))\<close> [1000, 1000, 1000] 10) 
 ud atLeastAtMost' \<open>atLeastAtMost\<close> 
 ud \<open>ord.min\<close> (\<open>(with _ : \<guillemotleft>min\<guillemotright> _ _)\<close> [1000, 1000, 999] 10)
 ud min' \<open>min\<close> 
 ud \<open>ord.max\<close> (\<open>(with _ : \<guillemotleft>max\<guillemotright> _ _)\<close> [1000, 1000, 999] 10)
 ud max' \<open>max\<close>
 
 ctr relativization
   synthesis ctr_simps
   assumes [transfer_domain_rule, transfer_rule]: "Domainp A = (\<lambda>x. x \<in> U)"
     and [transfer_rule]: "right_total A" 
   trp (?'a A)
   in lessThan_ow: lessThan.with_def 
     (\<open>(on _ with _ : ({..<_}))\<close> [1000, 1000, 1000] 10) 
     and atMost_ow: atMost.with_def 
       (\<open>(on _ with _ : ({.._}))\<close> [1000, 1000, 1000] 10) 
     and greaterThan_ow: greaterThan.with_def
       (\<open>(on _ with _: ({_<..}))\<close> [1000, 1000, 1000] 10) 
     and atLeast_ow: atLeast.with_def
       (\<open>(on _ with _ : ({_..}))\<close> [1000, 1000, 1000] 10) 
 
 ctr relativization
   synthesis ctr_simps
   assumes [transfer_domain_rule, transfer_rule]: "Domainp A = (\<lambda>x. x \<in> U)"
     and [transfer_rule]: "bi_unique A" "right_total A" 
   trp (?'a A)
   in greaterThanLessThan_ow: greaterThanLessThan.with_def 
       (\<open>(on _ with _ : ({_<..<_}))\<close> [1000, 1000, 1000, 1000] 10) 
     and atLeastLessThan_ow: atLeastLessThan.with_def 
       (\<open>(on _ with _ _ : ({_..<_}))\<close> [1000, 1000, 999, 1000, 1000] 10)
     and greaterThanAtMost_ow: greaterThanAtMost.with_def 
       (\<open>(on _ with _ _ : ({_<.._}))\<close> [1000, 1000, 999, 1000, 1000] 10) 
     and atLeastAtMost_ow: atLeastAtMost.with_def 
       (\<open>(on _ with _ : ({_.._}))\<close> [1000, 1000, 1000, 1000] 10)
 
 ctr parametricity
   in min_ow: min.with_def
     and max_ow: max.with_def
 
 context ord_ow
 begin
 
 abbreviation lessThan :: "'ao \<Rightarrow> 'ao set" ("(1{..<\<^sub>o\<^sub>w_})") 
   where "{..<\<^sub>o\<^sub>w u} \<equiv> on U with (<\<^sub>o\<^sub>w) : {..<u}"
 abbreviation atMost :: "'ao \<Rightarrow> 'ao set" ("(1{..\<^sub>o\<^sub>w_})") 
   where "{..\<^sub>o\<^sub>w u} \<equiv> on U with (\<le>\<^sub>o\<^sub>w) : {..u}"
 abbreviation greaterThan :: "'ao \<Rightarrow> 'ao set" ("(1{_<\<^sub>o\<^sub>w..})")  
   where "{l<\<^sub>o\<^sub>w..} \<equiv> on U with (<\<^sub>o\<^sub>w) : {l<..}"
 abbreviation atLeast :: "'ao \<Rightarrow> 'ao set" ("(1{_..\<^sub>o\<^sub>w})") 
   where "atLeast l \<equiv> on U with (\<le>\<^sub>o\<^sub>w) : {l..}"
 abbreviation greaterThanLessThan :: "'ao \<Rightarrow> 'ao \<Rightarrow> 'ao set" ("(1{_<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>w_})")
   where "{l<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wu} \<equiv> on U with (<\<^sub>o\<^sub>w) : {l<..<u}"
 abbreviation atLeastLessThan :: "'ao \<Rightarrow> 'ao \<Rightarrow> 'ao set" ("(1{_..<\<^sub>o\<^sub>w_})")
   where "{l..<\<^sub>o\<^sub>w u} \<equiv> on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {l<..u}"
 abbreviation greaterThanAtMost :: "'ao \<Rightarrow> 'ao \<Rightarrow> 'ao set" ("(1{_<\<^sub>o\<^sub>w.._})")
   where "{l<\<^sub>o\<^sub>w..u}  \<equiv> on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {l<..u}"
 abbreviation atLeastAtMost :: "'ao \<Rightarrow> 'ao \<Rightarrow> 'ao set" ("(1{_..\<^sub>o\<^sub>w_})")
   where "{l..\<^sub>o\<^sub>wu} \<equiv> on U with (\<le>\<^sub>o\<^sub>w) : {l..u}"
 abbreviation min :: "'ao \<Rightarrow> 'ao \<Rightarrow> 'ao" where "min \<equiv> min.with (\<le>\<^sub>o\<^sub>w)"
 abbreviation max :: "'ao \<Rightarrow> 'ao \<Rightarrow> 'ao" where "max \<equiv> max.with (\<le>\<^sub>o\<^sub>w)"
 
 end
 
 context ord_pair_ow
 begin
 
 notation ord\<^sub>1.lessThan ("(1{..<\<^sub>o\<^sub>w\<^sub>.\<^sub>1_})") 
 notation ord\<^sub>1.atMost ("(1{..\<^sub>o\<^sub>w\<^sub>.\<^sub>1_})") 
 notation ord\<^sub>1.greaterThan ("(1{_<\<^sub>o\<^sub>w\<^sub>.\<^sub>1..})")  
 notation ord\<^sub>1.atLeast ("(1{_..\<^sub>o\<^sub>w\<^sub>.\<^sub>1})") 
 notation ord\<^sub>1.greaterThanLessThan ("(1{_<\<^sub>o\<^sub>w\<^sub>.\<^sub>1..<\<^sub>o\<^sub>w\<^sub>.\<^sub>1_})")
 notation ord\<^sub>1.atLeastLessThan ("(1{_..<\<^sub>o\<^sub>w\<^sub>.\<^sub>1_})")
 notation ord\<^sub>1.greaterThanAtMost ("(1{_<\<^sub>o\<^sub>w\<^sub>.\<^sub>1.._})")
 notation ord\<^sub>1.atLeastAtMost ("(1{_..\<^sub>o\<^sub>w\<^sub>.\<^sub>1_})")
 
 notation ord\<^sub>2.lessThan ("(1{..<\<^sub>o\<^sub>w\<^sub>.\<^sub>2_})") 
 notation ord\<^sub>2.atMost ("(1{..\<^sub>o\<^sub>w\<^sub>.\<^sub>2_})") 
 notation ord\<^sub>2.greaterThan ("(1{_<\<^sub>o\<^sub>w\<^sub>.\<^sub>2..})")  
 notation ord\<^sub>2.atLeast ("(1{_..\<^sub>o\<^sub>w\<^sub>.\<^sub>2})") 
 notation ord\<^sub>2.greaterThanLessThan ("(1{_<\<^sub>o\<^sub>w\<^sub>.\<^sub>2..<\<^sub>o\<^sub>w\<^sub>.\<^sub>2_})")
 notation ord\<^sub>2.atLeastLessThan ("(1{_..<\<^sub>o\<^sub>w\<^sub>.\<^sub>2_})")
 notation ord\<^sub>2.greaterThanAtMost ("(1{_<\<^sub>o\<^sub>w\<^sub>.\<^sub>2.._})")
 notation ord\<^sub>2.atLeastAtMost ("(1{_..\<^sub>o\<^sub>w\<^sub>.\<^sub>2_})")
 
 end
 
 
 
 subsection\<open>Preorders\<close>
 
 
 subsubsection\<open>Definitions and common properties\<close>
 
 locale partial_preordering_ow =
   fixes U :: "'ao set"
     and le :: "'ao \<Rightarrow> 'ao \<Rightarrow> bool" (infix "\<^bold>\<le>\<^sub>o\<^sub>w" 50)
   assumes refl: "a \<in> U \<Longrightarrow> a \<^bold>\<le>\<^sub>o\<^sub>w a"
     and trans: "\<lbrakk> a \<in> U; b \<in> U; c \<in> U; a \<^bold>\<le>\<^sub>o\<^sub>w b; b \<^bold>\<le>\<^sub>o\<^sub>w c \<rbrakk> \<Longrightarrow> a \<^bold>\<le>\<^sub>o\<^sub>w c"
 begin
 
 notation le (infix "\<^bold>\<le>\<^sub>o\<^sub>w" 50)
 
 end
 
 locale preordering_ow = partial_preordering_ow U le 
   for U :: "'ao set"
     and le :: "'ao \<Rightarrow> 'ao \<Rightarrow> bool" (infix "\<^bold>\<le>\<^sub>o\<^sub>w" 50) +
   fixes ls :: \<open>'ao \<Rightarrow> 'ao \<Rightarrow> bool\<close> (infix "\<^bold><\<^sub>o\<^sub>w" 50)
   assumes strict_iff_not: 
     "\<lbrakk> a \<in> U; b \<in> U \<rbrakk> \<Longrightarrow> a \<^bold><\<^sub>o\<^sub>w b \<longleftrightarrow> a \<^bold>\<le>\<^sub>o\<^sub>w b \<and> \<not> b \<^bold>\<le>\<^sub>o\<^sub>w a"
 
 locale preorder_ow = ord_ow U le ls 
   for U :: "'ao set" and le ls +
   assumes less_le_not_le: 
     "\<lbrakk> x \<in> U; y \<in> U \<rbrakk> \<Longrightarrow> x <\<^sub>o\<^sub>w y \<longleftrightarrow> x \<le>\<^sub>o\<^sub>w y \<and> \<not> (y \<le>\<^sub>o\<^sub>w x)"
     and order_refl[iff]: "x \<in> U \<Longrightarrow> x \<le>\<^sub>o\<^sub>w x"
     and order_trans: "\<lbrakk> x \<in> U; y \<in> U; z \<in> U; x \<le>\<^sub>o\<^sub>w y; y \<le>\<^sub>o\<^sub>w z \<rbrakk> \<Longrightarrow> x \<le>\<^sub>o\<^sub>w z"
 begin
 
 sublocale 
   order: preordering_ow U \<open>(\<le>\<^sub>o\<^sub>w)\<close> \<open>(<\<^sub>o\<^sub>w)\<close> + 
   dual_order: preordering_ow U \<open>(\<ge>\<^sub>o\<^sub>w)\<close> \<open>(>\<^sub>o\<^sub>w)\<close>
   apply unfold_locales
   subgoal by auto
   subgoal by (meson order_trans)
   subgoal using less_le_not_le by simp
   subgoal by (meson order_trans)
   subgoal by (metis less_le_not_le)
   done
 
 end
 
 locale ord_preorder_ow = 
   ord\<^sub>1: ord_ow U\<^sub>1 le\<^sub>1 ls\<^sub>1 + ord\<^sub>2: preorder_ow U\<^sub>2 le\<^sub>2 ls\<^sub>2
   for U\<^sub>1 :: "'ao set" and le\<^sub>1 ls\<^sub>1 and U\<^sub>2 :: "'bo set" and le\<^sub>2 ls\<^sub>2
 begin
 
 sublocale ord_pair_ow .
 
 end
 
 locale preorder_pair_ow = 
   ord\<^sub>1: preorder_ow U\<^sub>1 le\<^sub>1 ls\<^sub>1 + ord\<^sub>2: preorder_ow U\<^sub>2 le\<^sub>2 ls\<^sub>2
   for U\<^sub>1 :: "'ao set" and le\<^sub>1 and ls\<^sub>1 and U\<^sub>2 :: "'bo set" and le\<^sub>2 and ls\<^sub>2
 begin
 
 sublocale ord_preorder_ow ..
 
 end
 
 ud \<open>preordering_bdd.bdd\<close>
 ud \<open>preorder.bdd_above\<close>
 ud bdd_above' \<open>bdd_above\<close> 
 ud \<open>preorder.bdd_below\<close> 
 ud bdd_below' \<open>bdd_below\<close> 
 
 ctr relativization
   synthesis ctr_simps
   assumes [transfer_domain_rule, transfer_rule]: "Domainp A = (\<lambda>x. x \<in> U)"
     and [transfer_rule]: "right_total A"
   trp (?'a A)
   in bdd_ow: bdd.with_def
     (\<open>(on _ with _ : \<guillemotleft>bdd\<guillemotright> _)\<close> [1000, 1000, 1000] 10)
     and bdd_above_ow: bdd_above.with_def
     (\<open>(on _ with _ : \<guillemotleft>bdd'_above\<guillemotright> _)\<close> [1000, 1000, 1000] 10)
     and bdd_below_ow: bdd_below.with_def
     (\<open>(on _ with _ : \<guillemotleft>bdd'_below\<guillemotright> _)\<close> [1000, 1000, 1000] 10)
 
 declare bdd.with[ud_with del]
 
 context preorder_ow
 begin
 
 abbreviation bdd_above :: "'ao set \<Rightarrow> bool" 
   where "bdd_above \<equiv> bdd_above_ow U (\<le>\<^sub>o\<^sub>w)"
 abbreviation bdd_below :: "'ao set \<Rightarrow> bool" 
   where "bdd_below \<equiv> bdd_below_ow U (\<le>\<^sub>o\<^sub>w)"
 
 end
 
 
 subsubsection\<open>Transfer rules\<close>
 
 context
   includes lifting_syntax
 begin
 
 lemma partial_preordering_transfer[transfer_rule]:
   assumes [transfer_rule]: "right_total A"
   shows 
     "((A ===> A ===> (=)) ===> (=))
       (partial_preordering_ow (Collect (Domainp A))) partial_preordering"
   unfolding partial_preordering_ow_def partial_preordering_def
   apply transfer_prover_start
   apply transfer_step+
   by blast
 
 lemma preordering_transfer[transfer_rule]:
   assumes [transfer_rule]: "right_total A"
   shows 
     "((A ===> A ===> (=)) ===> (A ===> A ===> (=)) ===> (=))
       (preordering_ow (Collect (Domainp A))) preordering"
   unfolding 
     preordering_ow_def preordering_ow_axioms_def 
     preordering_def preordering_axioms_def
   apply transfer_prover_start
   apply transfer_step+
   by blast
 
 lemma preorder_transfer[transfer_rule]:
   assumes [transfer_rule]: "right_total A"
   shows 
     "((A ===> A ===> (=)) ===> (A ===> A ===> (=))  ===> (=)) 
       (preorder_ow (Collect (Domainp A))) class.preorder"
   unfolding preorder_ow_def class.preorder_def
   apply transfer_prover_start
   apply transfer_step+
   by blast
 
 end
 
 
 subsubsection\<open>Relativization\<close>
 
 context preordering_ow
 begin
 
 tts_context
   tts: (?'a to U)
   rewriting ctr_simps
   substituting preordering_ow_axioms
   eliminating through auto
 begin
 
 tts_lemma strict_implies_order:
   assumes "a \<in> U" and "b \<in> U" and "a \<^bold><\<^sub>o\<^sub>w b"
   shows "a \<^bold>\<le>\<^sub>o\<^sub>w b"
     is preordering.strict_implies_order.
 
 tts_lemma irrefl:
   assumes "a \<in> U"
   shows "\<not>a \<^bold><\<^sub>o\<^sub>w a"
     is preordering.irrefl.
 
 tts_lemma asym:
   assumes "a \<in> U" and "b \<in> U" and "a \<^bold><\<^sub>o\<^sub>w b" and "b \<^bold><\<^sub>o\<^sub>w a"
   shows False
     is preordering.asym.
 
 tts_lemma strict_trans1:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "a \<^bold>\<le>\<^sub>o\<^sub>w b" and "b \<^bold><\<^sub>o\<^sub>w c"
   shows "a \<^bold><\<^sub>o\<^sub>w c"
     is preordering.strict_trans1.
 
 tts_lemma strict_trans2:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "a \<^bold><\<^sub>o\<^sub>w b" and "b \<^bold>\<le>\<^sub>o\<^sub>w c"
   shows "a \<^bold><\<^sub>o\<^sub>w c"
     is preordering.strict_trans2.
 
 tts_lemma strict_trans:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "a \<^bold><\<^sub>o\<^sub>w b" and "b \<^bold><\<^sub>o\<^sub>w c"
   shows "a \<^bold><\<^sub>o\<^sub>w c"
     is preordering.strict_trans.
 
 end
 
 end
 
 context preorder_ow
 begin
 
 tts_context
   tts: (?'a to U)
   rewriting ctr_simps
   substituting preorder_ow_axioms
   eliminating through auto
 begin
 
 tts_lemma less_irrefl:
   assumes "x \<in> U"
   shows "\<not> x <\<^sub>o\<^sub>w x"
   is preorder_class.less_irrefl.
     
 tts_lemma bdd_below_Ioc:
   assumes "a \<in> U" and "b \<in> U"
   shows "bdd_below {a<\<^sub>o\<^sub>w..b}"
   is preorder_class.bdd_below_Ioc.
     
 tts_lemma bdd_above_Ioc:
   assumes "a \<in> U" and "b \<in> U"
   shows "bdd_above {a<\<^sub>o\<^sub>w..b}"
     is preorder_class.bdd_above_Ioc.
 
 tts_lemma bdd_above_Iic:
   assumes "b \<in> U"
   shows "bdd_above {..\<^sub>o\<^sub>wb}"
     is preorder_class.bdd_above_Iic.
 
 tts_lemma bdd_above_Iio:
   assumes "b \<in> U"
   shows "bdd_above {..<\<^sub>o\<^sub>wb}"
     is preorder_class.bdd_above_Iio.
 
 tts_lemma bdd_below_Ici:
   assumes "a \<in> U"
   shows "bdd_below {a..\<^sub>o\<^sub>w}"
     is preorder_class.bdd_below_Ici.
 
 tts_lemma bdd_below_Ioi:
   assumes "a \<in> U"
   shows "bdd_below {a<\<^sub>o\<^sub>w..}"
     is preorder_class.bdd_below_Ioi.
 
 tts_lemma bdd_above_Icc:
   assumes "a \<in> U" and "b \<in> U"
   shows "bdd_above {a..\<^sub>o\<^sub>wb}"
     is preorder_class.bdd_above_Icc.
 
 tts_lemma bdd_above_Ioo:
   assumes "a \<in> U" and "b \<in> U"
   shows "bdd_above {a<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wb}"
     is preorder_class.bdd_above_Ioo.
 
 tts_lemma bdd_below_Icc:
   assumes "a \<in> U" and "b \<in> U"
   shows "bdd_below {a..\<^sub>o\<^sub>wb}"
     is preorder_class.bdd_below_Icc.
 
 tts_lemma bdd_below_Ioo:
   assumes "a \<in> U" and "b \<in> U"
   shows "bdd_below {a<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wb}"
     is preorder_class.bdd_below_Ioo.
 
 tts_lemma bdd_above_Ico:
   assumes "a \<in> U" and "b \<in> U"
   shows "bdd_above (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {a..<b})"
     is preorder_class.bdd_above_Ico.
 
 tts_lemma bdd_below_Ico:
   assumes "a \<in> U" and "b \<in> U"
   shows "bdd_below (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {a..<b})"
     is preorder_class.bdd_below_Ico.
 
 tts_lemma Ioi_le_Ico:
   assumes "a \<in> U"
   shows "{a<\<^sub>o\<^sub>w..} \<subseteq> {a..\<^sub>o\<^sub>w}"
     is preorder_class.Ioi_le_Ico.
 
 tts_lemma eq_refl:
   assumes "y \<in> U" and "x = y"
   shows "x \<le>\<^sub>o\<^sub>w y"
     is preorder_class.eq_refl.
 
 tts_lemma less_imp_le:
   assumes "x \<in> U" and "y \<in> U" and "x <\<^sub>o\<^sub>w y"
   shows "x \<le>\<^sub>o\<^sub>w y"
     is preorder_class.less_imp_le.
 
 tts_lemma less_not_sym:
   assumes "x \<in> U" and "y \<in> U" and "x <\<^sub>o\<^sub>w y"
   shows "\<not> y <\<^sub>o\<^sub>w x"
     is preorder_class.less_not_sym.
 
 tts_lemma less_imp_not_less:
   assumes "x \<in> U" and "y \<in> U" and "x <\<^sub>o\<^sub>w y"
   shows "(\<not> y <\<^sub>o\<^sub>w x) = True"
     is preorder_class.less_imp_not_less.
 
 tts_lemma less_asym':
   assumes "a \<in> U" and "b \<in> U" and "a <\<^sub>o\<^sub>w b" and "b <\<^sub>o\<^sub>w a"
   shows P
     is preorder_class.less_asym'.
 
 tts_lemma less_imp_triv:
   assumes "x \<in> U" and "y \<in> U" and "x <\<^sub>o\<^sub>w y"
   shows "(y <\<^sub>o\<^sub>w x \<longrightarrow> P) = True"
     is preorder_class.less_imp_triv.
 
 tts_lemma less_trans:
   assumes "x \<in> U" and "y \<in> U" and "z \<in> U" and "x <\<^sub>o\<^sub>w y" and "y <\<^sub>o\<^sub>w z"
   shows "x <\<^sub>o\<^sub>w z"
     is preorder_class.less_trans.
 
 tts_lemma less_le_trans:
   assumes "x \<in> U" and "y \<in> U" and "z \<in> U" and "x <\<^sub>o\<^sub>w y" and "y \<le>\<^sub>o\<^sub>w z"
   shows "x <\<^sub>o\<^sub>w z"
     is preorder_class.less_le_trans.
 
 tts_lemma le_less_trans:
   assumes "x \<in> U" and "y \<in> U" and "z \<in> U" and "x \<le>\<^sub>o\<^sub>w y" and "y <\<^sub>o\<^sub>w z"
   shows "x <\<^sub>o\<^sub>w z"
     is preorder_class.le_less_trans.
 
 tts_lemma bdd_aboveI:
   assumes "A \<subseteq> U" and "M \<in> U" and "\<And>x. \<lbrakk>x \<in> U; x \<in> A\<rbrakk> \<Longrightarrow> x \<le>\<^sub>o\<^sub>w M"
   shows "bdd_above A"
     is preorder_class.bdd_aboveI.
 
 tts_lemma bdd_belowI:
   assumes "A \<subseteq> U" and "m \<in> U" and "\<And>x. \<lbrakk>x \<in> U; x \<in> A\<rbrakk> \<Longrightarrow> m \<le>\<^sub>o\<^sub>w x"
   shows "bdd_below A"
     is preorder_class.bdd_belowI.
 
 tts_lemma less_asym:
   assumes "x \<in> U" and "y \<in> U" and "x <\<^sub>o\<^sub>w y" and "\<not> P \<Longrightarrow> y <\<^sub>o\<^sub>w x"
   shows P
     is preorder_class.less_asym.
 
 tts_lemma transp_less: "transp_on U (<\<^sub>o\<^sub>w)"
   is preorder_class.transp_less.
 
 tts_lemma transp_le: "transp_on U (\<le>\<^sub>o\<^sub>w)"
   is preorder_class.transp_le.
 
 tts_lemma transp_gr: "transp_on U (\<lambda>x y. y <\<^sub>o\<^sub>w x)"
   is preorder_class.transp_gr.
 
 tts_lemma transp_ge: "transp_on U (\<lambda>x y. y \<le>\<^sub>o\<^sub>w x)"
   is preorder_class.transp_ge.
 
 tts_lemma bdd_above_Int1:
   assumes "A \<subseteq> U" and "B \<subseteq> U" and "bdd_above A"
   shows "bdd_above (A \<inter> B)"
     is preorder_class.bdd_above_Int1.
 
 tts_lemma bdd_above_Int2:
   assumes "B \<subseteq> U" and "A \<subseteq> U" and "bdd_above B"
   shows "bdd_above (A \<inter> B)"
     is preorder_class.bdd_above_Int2.
 
 tts_lemma bdd_below_Int1:
   assumes "A \<subseteq> U" and "B \<subseteq> U" and "bdd_below A"
   shows "bdd_below (A \<inter> B)"
     is preorder_class.bdd_below_Int1.
 
 tts_lemma bdd_below_Int2:
   assumes "B \<subseteq> U" and "A \<subseteq> U" and "bdd_below B"
   shows "bdd_below (A \<inter> B)"
     is preorder_class.bdd_below_Int2.
 
 tts_lemma bdd_above_mono:
   assumes "B \<subseteq> U" and "bdd_above B" and "A \<subseteq> B"
   shows "bdd_above A"
     is preorder_class.bdd_above_mono.
 
 tts_lemma bdd_below_mono:
   assumes "B \<subseteq> U" and "bdd_below B" and "A \<subseteq> B"
   shows "bdd_below A"
     is preorder_class.bdd_below_mono.
 
 tts_lemma atLeastAtMost_subseteq_atLeastLessThan_iff:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows "({a..\<^sub>o\<^sub>wb} \<subseteq> (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {c..<d})) = 
     (a \<le>\<^sub>o\<^sub>w b \<longrightarrow> b <\<^sub>o\<^sub>w d \<and> c \<le>\<^sub>o\<^sub>w a)"
     is preorder_class.atLeastAtMost_subseteq_atLeastLessThan_iff.
 
 tts_lemma atMost_subset_iff:
   assumes "x \<in> U" and "y \<in> U"
   shows "({..\<^sub>o\<^sub>wx} \<subseteq> {..\<^sub>o\<^sub>wy}) = (x \<le>\<^sub>o\<^sub>w y)"
     is Set_Interval.atMost_subset_iff.
 
 tts_lemma single_Diff_lessThan:
   assumes "k \<in> U"
   shows "{k} - {..<\<^sub>o\<^sub>wk} = {k}"
   is Set_Interval.single_Diff_lessThan.
 
 tts_lemma atLeast_subset_iff:
   assumes "x \<in> U" and "y \<in> U"
   shows "({x..\<^sub>o\<^sub>w} \<subseteq> {y..\<^sub>o\<^sub>w}) = (y \<le>\<^sub>o\<^sub>w x)"
     is Set_Interval.atLeast_subset_iff.
 
 tts_lemma atLeastatMost_psubset_iff:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows 
     "({a..\<^sub>o\<^sub>wb} \<subset> {c..\<^sub>o\<^sub>wd}) = 
       (c \<le>\<^sub>o\<^sub>w d \<and> (\<not> a \<le>\<^sub>o\<^sub>w b \<or> c \<le>\<^sub>o\<^sub>w a \<and> b \<le>\<^sub>o\<^sub>w d \<and> (c <\<^sub>o\<^sub>w a \<or> b <\<^sub>o\<^sub>w d)))"
     is preorder_class.atLeastatMost_psubset_iff.
 
 tts_lemma not_empty_eq_Iic_eq_empty:
   assumes "h \<in> U"
   shows "{} \<noteq> {..\<^sub>o\<^sub>wh}"
     is preorder_class.not_empty_eq_Iic_eq_empty.
     
 tts_lemma atLeastatMost_subset_iff:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U" and "d \<in> U"
   shows "({a..\<^sub>o\<^sub>wb} \<subseteq> {c..\<^sub>o\<^sub>wd}) = (\<not> a \<le>\<^sub>o\<^sub>w b \<or> b \<le>\<^sub>o\<^sub>w d \<and> c \<le>\<^sub>o\<^sub>w a)"
     is preorder_class.atLeastatMost_subset_iff.
 
 tts_lemma Icc_subset_Ici_iff:
   assumes "l \<in> U" and "h \<in> U" and "l' \<in> U"
   shows "({l..\<^sub>o\<^sub>wh} \<subseteq> {l'..\<^sub>o\<^sub>w}) = (\<not> l \<le>\<^sub>o\<^sub>w h \<or> l' \<le>\<^sub>o\<^sub>w l)"
     is preorder_class.Icc_subset_Ici_iff.
     
 tts_lemma Icc_subset_Iic_iff:
   assumes "l \<in> U" and "h \<in> U" and "h' \<in> U"
   shows "({l..\<^sub>o\<^sub>wh} \<subseteq> {..\<^sub>o\<^sub>wh'}) = (\<not> l \<le>\<^sub>o\<^sub>w h \<or> h \<le>\<^sub>o\<^sub>w h')"
     is preorder_class.Icc_subset_Iic_iff.
 
 tts_lemma not_empty_eq_Ici_eq_empty:
   assumes "l \<in> U"
   shows "{} \<noteq> {l..\<^sub>o\<^sub>w}"
   is preorder_class.not_empty_eq_Ici_eq_empty.
     
 tts_lemma not_Ici_eq_empty:
   assumes "l \<in> U"
   shows "{l..\<^sub>o\<^sub>w} \<noteq> {}"
 is preorder_class.not_Ici_eq_empty.
     
 tts_lemma not_Iic_eq_empty:
   assumes "h \<in> U"
   shows "{..\<^sub>o\<^sub>wh} \<noteq> {}"
     is preorder_class.not_Iic_eq_empty.
 
 tts_lemma atLeastatMost_empty_iff2:
   assumes "a \<in> U" and "b \<in> U"
   shows "({} = {a..\<^sub>o\<^sub>wb}) = (\<not> a \<le>\<^sub>o\<^sub>w b)"
     is preorder_class.atLeastatMost_empty_iff2.
     
 tts_lemma atLeastLessThan_empty_iff2:
   assumes "a \<in> U" and "b \<in> U"
   shows "({} = (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {a..<b})) = (\<not> a <\<^sub>o\<^sub>w b)"
     is preorder_class.atLeastLessThan_empty_iff2.
     
 tts_lemma greaterThanAtMost_empty_iff2:
   assumes "k \<in> U" and "l \<in> U"
   shows "({} = {k<\<^sub>o\<^sub>w..l}) = (\<not> k <\<^sub>o\<^sub>w l)"
     is preorder_class.greaterThanAtMost_empty_iff2.
     
 tts_lemma atLeastatMost_empty_iff:
   assumes "a \<in> U" and "b \<in> U"
   shows "({a..\<^sub>o\<^sub>wb} = {}) = (\<not> a \<le>\<^sub>o\<^sub>w b)"
     is preorder_class.atLeastatMost_empty_iff.
     
 tts_lemma atLeastLessThan_empty_iff:
   assumes "a \<in> U" and "b \<in> U"
   shows "((on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {a..<b}) = {}) = (\<not> a <\<^sub>o\<^sub>w b)"
     is preorder_class.atLeastLessThan_empty_iff.
     
 tts_lemma greaterThanAtMost_empty_iff:
   assumes "k \<in> U" and "l \<in> U"
   shows "({k<\<^sub>o\<^sub>w..l} = {}) = (\<not> k <\<^sub>o\<^sub>w l)"
     is preorder_class.greaterThanAtMost_empty_iff.
 
 end
 
 tts_context
   tts: (?'a to U)
   substituting preorder_ow_axioms
 begin
 
 tts_lemma bdd_above_empty:
   assumes "U \<noteq> {}"
   shows "bdd_above {}"
     is preorder_class.bdd_above_empty.
     
 tts_lemma bdd_below_empty:
   assumes "U \<noteq> {}"
   shows "bdd_below {}"
     is preorder_class.bdd_below_empty.
     
 end
 
 tts_context
   tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'a set\<close>)
   rewriting ctr_simps
   substituting preorder_ow_axioms
   eliminating through (auto intro: bdd_above_empty bdd_below_empty)
 begin
 
 tts_lemma bdd_belowI2:
   assumes "A \<subseteq> U\<^sub>2"
     and "m \<in> U"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "\<And>x. x \<in> A \<Longrightarrow> m \<le>\<^sub>o\<^sub>w f x"
   shows "bdd_below (f ` A)"
     given preorder_class.bdd_belowI2
   by blast
 
 tts_lemma bdd_aboveI2:
   assumes "A \<subseteq> U\<^sub>2"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U"
     and "M \<in> U"
     and "\<And>x. x \<in> A \<Longrightarrow> f x \<le>\<^sub>o\<^sub>w M"
   shows "bdd_above (f ` A)"
     given preorder_class.bdd_aboveI2
   by blast
     
 end
 
 end
 
 
 
 subsection\<open>Partial orders\<close>
 
 
 subsubsection\<open>Definitions and common properties\<close>
 
 locale ordering_ow = partial_preordering_ow U le 
   for U :: "'ao set" and le :: "'ao \<Rightarrow> 'ao \<Rightarrow> bool" (infix "\<^bold>\<le>\<^sub>o\<^sub>w" 50) +
   fixes ls :: "'ao \<Rightarrow> 'ao \<Rightarrow> bool" (infix "\<^bold><\<^sub>o\<^sub>w" 50)
   assumes strict_iff_order: "\<lbrakk> a \<in> U; b \<in> U \<rbrakk> \<Longrightarrow> a \<^bold><\<^sub>o\<^sub>w b \<longleftrightarrow> a \<^bold>\<le>\<^sub>o\<^sub>w b \<and> a \<noteq> b"
     and antisym: "\<lbrakk> a \<in> U; b \<in> U; a \<^bold>\<le>\<^sub>o\<^sub>w b; b \<^bold>\<le>\<^sub>o\<^sub>w a \<rbrakk> \<Longrightarrow> a = b"
 begin
 
 notation le (infix "\<^bold>\<le>\<^sub>o\<^sub>w" 50)
   and ls (infix "\<^bold><\<^sub>o\<^sub>w" 50)
 
 sublocale preordering_ow U \<open>(\<^bold>\<le>\<^sub>o\<^sub>w)\<close> \<open>(\<^bold><\<^sub>o\<^sub>w)\<close>  
   using local.antisym strict_iff_order by unfold_locales blast
 
 end
 
 locale order_ow = preorder_ow U le ls for U :: "'ao set" and le ls +
   assumes antisym: "\<lbrakk> x \<in> U; y \<in> U; x \<le>\<^sub>o\<^sub>w y; y \<le>\<^sub>o\<^sub>w x \<rbrakk> \<Longrightarrow> x = y" 
 begin
 
 sublocale 
   order: ordering_ow U \<open>(\<le>\<^sub>o\<^sub>w)\<close> \<open>(<\<^sub>o\<^sub>w)\<close> + 
   dual_order: ordering_ow U \<open>(\<ge>\<^sub>o\<^sub>w)\<close> \<open>(>\<^sub>o\<^sub>w)\<close>
   apply unfold_locales
   subgoal by (force simp: less_le_not_le antisym)
   subgoal by (simp add: antisym)
   subgoal by (force simp: less_le_not_le antisym)
   subgoal by (simp add: antisym)
   done
 
 no_notation le (infix "\<^bold>\<le>\<^sub>o\<^sub>w" 50)
   and ls (infix "\<^bold><\<^sub>o\<^sub>w" 50)
 
 end
 
 locale ord_order_ow = ord\<^sub>1: ord_ow U\<^sub>1 le\<^sub>1 ls\<^sub>1 + ord\<^sub>2: order_ow U\<^sub>2 le\<^sub>2 ls\<^sub>2
   for U\<^sub>1 :: "'ao set" and le\<^sub>1 ls\<^sub>1 and U\<^sub>2 :: "'bo set" and le\<^sub>2 ls\<^sub>2
 
 sublocale ord_order_ow \<subseteq> ord_preorder_ow ..
 
 locale preorder_order_ow =
   ord\<^sub>1: preorder_ow U\<^sub>1 le\<^sub>1 ls\<^sub>1 + ord\<^sub>2: order_ow U\<^sub>2 le\<^sub>2 ls\<^sub>2
   for U\<^sub>1 :: "'ao set" and le\<^sub>1 ls\<^sub>1 and U\<^sub>2 :: "'bo set" and le\<^sub>2 ls\<^sub>2
 
 sublocale preorder_order_ow \<subseteq> preorder_pair_ow ..
 
 locale order_pair_ow = ord\<^sub>1: order_ow U\<^sub>1 le\<^sub>1 ls\<^sub>1 + ord\<^sub>2: order_ow U\<^sub>2 le\<^sub>2 ls\<^sub>2
   for U\<^sub>1 :: "'ao set" and le\<^sub>1 ls\<^sub>1 and U\<^sub>2 :: "'bo set" and le\<^sub>2 ls\<^sub>2
 
 sublocale order_pair_ow \<subseteq> preorder_order_ow ..
 
-ud \<open>order.mono\<close> (\<open>(with _ _ : \<guillemotleft>mono\<guillemotright> _)\<close> [1000, 999, 1000] 10)
-ud mono' \<open>mono\<close> 
-ud \<open>order.strict_mono\<close> (\<open>(with _ _ : \<guillemotleft>strict'_mono\<guillemotright> _)\<close> [1000, 999, 1000] 10)
-ud strict_mono' \<open>strict_mono\<close> 
+definition mono where
+  "mono f \<longleftrightarrow> (\<forall>x y. x \<le> y \<longrightarrow> f x \<le> f y)"
+
+definition strict_mono where
+  "strict_mono f \<longleftrightarrow> (\<forall>x y. x < y \<longrightarrow> f x < f y)"
+
+lemma mono_iff_mono: "mono f \<longleftrightarrow> Fun.mono f"
+  by (simp add: mono_def Fun.mono_def)
+
+ud \<open>mono\<close> (\<open>(with _ _ : \<guillemotleft>mono\<guillemotright> _)\<close> [1000, 999, 1000] 10)
+ud \<open>strict_mono\<close> (\<open>(with _ _ : \<guillemotleft>strict'_mono\<guillemotright> _)\<close> [1000, 999, 1000] 10)
 ud \<open>order.antimono\<close> (\<open>(with _ _ : \<guillemotleft>strict'_mono\<guillemotright> _)\<close> [1000, 999, 1000] 10)
 ud antimono' \<open>antimono\<close> 
 ud \<open>monoseq\<close> (\<open>(with _ : \<guillemotleft>monoseq\<guillemotright> _)\<close> [1000, 1000] 10)
 
 ctr relativization
   synthesis ctr_simps
   assumes [transfer_domain_rule, transfer_rule]: 
     "Domainp (B::'c\<Rightarrow>'d\<Rightarrow>bool) = (\<lambda>x. x \<in> U\<^sub>2)"
     and [transfer_rule]: "right_total B" 
   trp (?'b \<open>A::'a\<Rightarrow>'b\<Rightarrow>bool\<close>) and (?'a B)
   in mono_ow: mono.with_def 
     (\<open>(on _ with _ _ : \<guillemotleft>mono\<guillemotright> _)\<close> [1000, 1000, 999, 1000] 10)
     and strict_mono_ow: strict_mono.with_def 
       (\<open>(on _ with _ _ : \<guillemotleft>strict'_mono\<guillemotright> _)\<close> [1000, 1000, 999, 1000] 10)
     and antimono_ow: antimono.with_def
       (\<open>(on _ with _ _ : \<guillemotleft>antimono\<guillemotright> _)\<close> [1000, 1000, 999, 1000] 10)
     and monoseq_ow: monoseq.with_def
 
 
 subsubsection\<open>Transfer rules\<close>
 
 context
   includes lifting_syntax
 begin
 
 lemma ordering_transfer[transfer_rule]:
   assumes [transfer_rule]: "bi_unique A" "right_total A" 
   shows 
     "((A ===> A ===> (=)) ===> (A ===> A ===> (=)) ===> (=)) 
       (ordering_ow (Collect (Domainp A))) ordering"
   unfolding ordering_ow_def ordering_ow_axioms_def ordering_def ordering_axioms_def 
   apply transfer_prover_start
   apply transfer_step+
   unfolding Ball_Collect[symmetric]
   by (intro ext HOL.arg_cong2[where f="(\<and>)"]) auto
 
 lemma order_transfer[transfer_rule]:
   assumes [transfer_rule]: "bi_unique A" "right_total A" 
   shows 
     "((A ===> A ===> (=)) ===> (A ===> A ===> (=)) ===> (=)) 
       (order_ow (Collect (Domainp A))) class.order"
   unfolding 
     order_ow_def class.order_def order_ow_axioms_def class.order_axioms_def
   apply transfer_prover_start
   apply transfer_step+
   by simp
 
 end
 
 
 subsubsection\<open>Relativization\<close>
 
 context ordering_ow
 begin
 
 tts_context
   tts: (?'a to U)
   rewriting ctr_simps
   substituting ordering_ow_axioms
   eliminating through simp
 begin
 
 tts_lemma strict_implies_not_eq:
   assumes "a \<in> U" and "b \<in> U" and "a \<^bold><\<^sub>o\<^sub>w b"
   shows "a \<noteq> b"
     is ordering.strict_implies_not_eq.
     
 tts_lemma order_iff_strict:
   assumes "a \<in> U" and "b \<in> U"
   shows "(a \<^bold>\<le>\<^sub>o\<^sub>w b) = (a \<^bold><\<^sub>o\<^sub>w b \<or> a = b)"
     is ordering.order_iff_strict.
    
 tts_lemma not_eq_order_implies_strict:
   assumes "a \<in> U" and "b \<in> U" and "a \<noteq> b" and "a \<^bold>\<le>\<^sub>o\<^sub>w b"
   shows "a \<^bold><\<^sub>o\<^sub>w b"
     is ordering.not_eq_order_implies_strict.
 
 tts_lemma eq_iff:
   assumes "a \<in> U" and "b \<in> U"
   shows "(a = b) = (a \<^bold>\<le>\<^sub>o\<^sub>w b \<and> b \<^bold>\<le>\<^sub>o\<^sub>w a)"
     is ordering.eq_iff.
 
 end
 
 end
 
 context order_ow 
 begin
 
 tts_context
   tts: (?'a to U)
   rewriting ctr_simps
   substituting order_ow_axioms
   eliminating through clarsimp
 begin
 
 tts_lemma atLeastAtMost_singleton:
   assumes "a \<in> U"
   shows "{a..\<^sub>o\<^sub>wa} = {a}"
   is order_class.atLeastAtMost_singleton.
     
 tts_lemma less_imp_neq:
   assumes "y \<in> U" and "x <\<^sub>o\<^sub>w y"
   shows "x \<noteq> y"
     is order_class.less_imp_neq.
     
 tts_lemma atLeastatMost_empty:
   assumes "b \<in> U" and "a \<in> U" and "b <\<^sub>o\<^sub>w a"
   shows "{a..\<^sub>o\<^sub>wb} = {}"
     is order_class.atLeastatMost_empty.
     
 tts_lemma less_imp_not_eq:
   assumes "y \<in> U" and "x <\<^sub>o\<^sub>w y"
   shows "(x = y) = False"
     is order_class.less_imp_not_eq.
     
 tts_lemma less_imp_not_eq2:
   assumes "y \<in> U" and "x <\<^sub>o\<^sub>w y"
   shows "(y = x) = False"
     is order_class.less_imp_not_eq2.
     
 tts_lemma atLeastLessThan_empty:
   assumes "b \<in> U" and "a \<in> U" and "b \<le>\<^sub>o\<^sub>w a"
   shows "(on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {a..<b}) = {}"
     is order_class.atLeastLessThan_empty.
     
 tts_lemma greaterThanAtMost_empty:
   assumes "l \<in> U" and "k \<in> U" and "l \<le>\<^sub>o\<^sub>w k"
   shows "{k<\<^sub>o\<^sub>w..l} = {}"
     is order_class.greaterThanAtMost_empty.
 
 tts_lemma antisym_conv1:
   assumes "x \<in> U" and "y \<in> U" and "\<not> x <\<^sub>o\<^sub>w y"
   shows "(x \<le>\<^sub>o\<^sub>w y) = (x = y)"
     is order_class.antisym_conv1.
 
 tts_lemma antisym_conv2:
   assumes "x \<in> U" and "y \<in> U" and "x \<le>\<^sub>o\<^sub>w y"
   shows "(\<not> x <\<^sub>o\<^sub>w y) = (x = y)"
     is order_class.antisym_conv2.
     
 tts_lemma greaterThanLessThan_empty:
   assumes "l \<in> U" and "k \<in> U" and "l \<le>\<^sub>o\<^sub>w k"
   shows "{k<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wl} = {}"
     is order_class.greaterThanLessThan_empty.
     
 tts_lemma atLeastLessThan_eq_atLeastAtMost_diff:
   assumes "a \<in> U" and "b \<in> U"
   shows "(on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {a..<b}) = {a..\<^sub>o\<^sub>wb} - {b}"
     is order_class.atLeastLessThan_eq_atLeastAtMost_diff.
     
 tts_lemma greaterThanAtMost_eq_atLeastAtMost_diff:
   assumes "a \<in> U" and "b \<in> U"
   shows "{a<\<^sub>o\<^sub>w..b} = {a..\<^sub>o\<^sub>wb} - {a}"
     is order_class.greaterThanAtMost_eq_atLeastAtMost_diff.
 
 tts_lemma less_separate:
   assumes "x \<in> U" and "y \<in> U" and "x <\<^sub>o\<^sub>w y"
   shows 
     "\<exists>x'\<in>U. \<exists>y'\<in>U. x \<in> {..<\<^sub>o\<^sub>wx'} \<and> y \<in> {y'<\<^sub>o\<^sub>w..} \<and> {..<\<^sub>o\<^sub>wx'} \<inter> {y'<\<^sub>o\<^sub>w..} = {}"
     is order_class.less_separate.
 
 tts_lemma order_iff_strict:
   assumes "a \<in> U" and "b \<in> U"
   shows "(a \<le>\<^sub>o\<^sub>w b) = (a <\<^sub>o\<^sub>w b \<or> a = b)"
     is order_class.order.order_iff_strict.
     
 tts_lemma le_less:
   assumes "x \<in> U" and "y \<in> U"
   shows "(x \<le>\<^sub>o\<^sub>w y) = (x <\<^sub>o\<^sub>w y \<or> x = y)"
     is order_class.le_less.
     
 tts_lemma strict_iff_order:
   assumes "a \<in> U" and "b \<in> U"
   shows "(a <\<^sub>o\<^sub>w b) = (a \<le>\<^sub>o\<^sub>w b \<and> a \<noteq> b)"
     is order_class.order.strict_iff_order.
     
 tts_lemma less_le:
   assumes "x \<in> U" and "y \<in> U"
   shows "(x <\<^sub>o\<^sub>w y) = (x \<le>\<^sub>o\<^sub>w y \<and> x \<noteq> y)"
     is order_class.less_le.
 
 tts_lemma atLeastAtMost_singleton':
   assumes "b \<in> U" and "a = b"
   shows "{a..\<^sub>o\<^sub>wb} = {a}"
     is order_class.atLeastAtMost_singleton'.
     
 tts_lemma le_imp_less_or_eq:
   assumes "x \<in> U" and "y \<in> U" and "x \<le>\<^sub>o\<^sub>w y"
   shows "x <\<^sub>o\<^sub>w y \<or> x = y"
     is order_class.le_imp_less_or_eq.
   
 tts_lemma antisym_conv:
   assumes "y \<in> U" and "x \<in> U" and "y \<le>\<^sub>o\<^sub>w x"
   shows "(x \<le>\<^sub>o\<^sub>w y) = (x = y)"
     is order_class.antisym_conv.
 
 tts_lemma le_neq_trans:
   assumes "a \<in> U" and "b \<in> U" and "a \<le>\<^sub>o\<^sub>w b" and "a \<noteq> b"
   shows "a <\<^sub>o\<^sub>w b"
     is order_class.le_neq_trans.
 
 tts_lemma neq_le_trans:
   assumes "a \<in> U" and "b \<in> U" and "a \<noteq> b" and "a \<le>\<^sub>o\<^sub>w b"
   shows "a <\<^sub>o\<^sub>w b"
     is order_class.neq_le_trans.
     
 tts_lemma Iio_Int_singleton:
   assumes "k \<in> U" and "x \<in> U"
   shows "{..<\<^sub>o\<^sub>wk} \<inter> {x} = (if x <\<^sub>o\<^sub>w k then {x} else {})"
     is order_class.Iio_Int_singleton.
     
 tts_lemma atLeastAtMost_singleton_iff:
   assumes "a \<in> U" and "b \<in> U" and "c \<in> U"
   shows "({a..\<^sub>o\<^sub>wb} = {c}) = (a = b \<and> b = c)"
     is order_class.atLeastAtMost_singleton_iff.
     
 tts_lemma Icc_eq_Icc:
   assumes "l \<in> U" and "h \<in> U" and "l' \<in> U" and "h' \<in> U"
   shows "({l..\<^sub>o\<^sub>wh} = {l'..\<^sub>o\<^sub>wh'}) = (h = h' \<and> l = l' \<or> \<not> l' \<le>\<^sub>o\<^sub>w h' \<and> \<not> l \<le>\<^sub>o\<^sub>w h)"
     is order_class.Icc_eq_Icc.
     
 tts_lemma lift_Suc_mono_less_iff:
   assumes "range f \<subseteq> U" and "\<And>n. f n <\<^sub>o\<^sub>w f (Suc n)"
   shows "(f n <\<^sub>o\<^sub>w f m) = (n < m)"
     is order_class.lift_Suc_mono_less_iff.
 
 tts_lemma lift_Suc_mono_less:
   assumes "range f \<subseteq> U" and "\<And>n. f n <\<^sub>o\<^sub>w f (Suc n)" and "n < n'"
   shows "f n <\<^sub>o\<^sub>w f n'"
     is order_class.lift_Suc_mono_less.
   
 tts_lemma lift_Suc_mono_le:
   assumes "range f \<subseteq> U" and "\<And>n. f n \<le>\<^sub>o\<^sub>w f (Suc n)" and "n \<le> n'"
   shows "f n \<le>\<^sub>o\<^sub>w f n'"
     is order_class.lift_Suc_mono_le.
     
 tts_lemma lift_Suc_antimono_le:
   assumes "range f \<subseteq> U" and "\<And>n. f (Suc n) \<le>\<^sub>o\<^sub>w f n" and "n \<le> n'"
   shows "f n' \<le>\<^sub>o\<^sub>w f n"
     is order_class.lift_Suc_antimono_le.
 
 tts_lemma ivl_disj_int_two:
   assumes "l \<in> U" and "m \<in> U" and "u \<in> U"
   shows 
     "{l<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wm} \<inter> (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {m..<u}) = {}"
     "{l<\<^sub>o\<^sub>w..m} \<inter> {m<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wu} = {}"
     "(on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {l..<m}) \<inter> (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {m..<u}) = {}"
     "{l..\<^sub>o\<^sub>wm} \<inter> {m<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wu} = {}"
     "{l<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wm} \<inter> {m..\<^sub>o\<^sub>wu} = {}"
     "{l<\<^sub>o\<^sub>w..m} \<inter> {m<\<^sub>o\<^sub>w..u} = {}"
     "(on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {l..<m}) \<inter> {m..\<^sub>o\<^sub>wu} = {}"
     "{l..\<^sub>o\<^sub>wm} \<inter> {m<\<^sub>o\<^sub>w..u} = {}"
     is Set_Interval.ivl_disj_int_two.
   
 tts_lemma ivl_disj_int_one:
   assumes "l \<in> U" and "u \<in> U"
   shows 
     "{..\<^sub>o\<^sub>wl} \<inter> {l<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wu} = {}"
     "{..<\<^sub>o\<^sub>wl} \<inter> (on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {l..<u}) = {}"
     "{..\<^sub>o\<^sub>wl} \<inter> {l<\<^sub>o\<^sub>w..u} = {}"
     "{..<\<^sub>o\<^sub>wl} \<inter> {l..\<^sub>o\<^sub>wu} = {}"
     "{l<\<^sub>o\<^sub>w..u} \<inter> {u<\<^sub>o\<^sub>w..} = {}"
     "{l<\<^sub>o\<^sub>w..<\<^sub>o\<^sub>wu} \<inter> {u..\<^sub>o\<^sub>w} = {}"
     "{l..\<^sub>o\<^sub>wu} \<inter> {u<\<^sub>o\<^sub>w..} = {}"
     "(on U with (\<le>\<^sub>o\<^sub>w) (<\<^sub>o\<^sub>w) : {l..<u}) \<inter> {u..\<^sub>o\<^sub>w} = {}"
     is Set_Interval.ivl_disj_int_one.
 
 tts_lemma min_absorb2:
   assumes "y \<in> U" and "x \<in> U" and "y \<le>\<^sub>o\<^sub>w x"
   shows "local.min x y = y"
     is Orderings.min_absorb2.
     
 tts_lemma max_absorb1:
   assumes "y \<in> U" and "x \<in> U" and "y \<le>\<^sub>o\<^sub>w x"
   shows "local.max x y = x"
     is Orderings.max_absorb1.
-
-tts_lemma finite_mono_remains_stable_implies_strict_prefix:
-  assumes "range f \<subseteq> U"
-    and "finite (range f)"
-    and "on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>mono\<guillemotright> f"
-    and "\<forall>n. f n = f (Suc n) \<longrightarrow> f (Suc n) = f (Suc (Suc n))"
-  shows "\<exists>N. (\<forall>n\<ge>N. f N = f n) \<and> (\<forall>n\<le>N. \<forall>m\<le>N. m < n \<longrightarrow> f m <\<^sub>o\<^sub>w f n)"
-    is Hilbert_Choice.finite_mono_remains_stable_implies_strict_prefix.
-    
-tts_lemma incseq_imp_monoseq:
-  assumes "range X \<subseteq> U" and "on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>mono\<guillemotright> X"
-  shows "with (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>monoseq\<guillemotright> X"
-    is Topological_Spaces.incseq_imp_monoseq.
     
 tts_lemma decseq_imp_monoseq:
   assumes "range X \<subseteq> U" and "on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>antimono\<guillemotright> X"
   shows "with (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>monoseq\<guillemotright> X"
     is Topological_Spaces.decseq_imp_monoseq.
     
-tts_lemma incseq_Suc_iff:
-  assumes "range f \<subseteq> U"
-  shows "(on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>mono\<guillemotright> f) = (\<forall>x. f x \<le>\<^sub>o\<^sub>w f (Suc x))"
-    is Topological_Spaces.incseq_Suc_iff.
-    
 tts_lemma decseq_Suc_iff:
   assumes "range f \<subseteq> U"
   shows "(on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>antimono\<guillemotright> f) = (\<forall>x. f (Suc x) \<le>\<^sub>o\<^sub>w f x)"
     is Topological_Spaces.decseq_Suc_iff.
 
-tts_lemma incseq_const:
-  assumes "k \<in> U"
-  shows "on (UNIV::nat set) with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>mono\<guillemotright> (\<lambda>x. k)"
-    is Topological_Spaces.incseq_const.
-
 tts_lemma decseq_const:
   assumes "k \<in> U"
   shows "on (UNIV::nat set) with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>antimono\<guillemotright> (\<lambda>x. k)"
     is Topological_Spaces.decseq_const.
 
 tts_lemma atMost_Int_atLeast:
   assumes "n \<in> U"
   shows "{..\<^sub>o\<^sub>wn} \<inter> {n..\<^sub>o\<^sub>w} = {n}"
     is Set_Interval.atMost_Int_atLeast.
 
-tts_lemma monoseq_iff:
-  assumes "range X \<subseteq> U"
-  shows 
-    "(with (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>monoseq\<guillemotright> X) = 
-      (
-        (on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>mono\<guillemotright> X) \<or> 
-        (on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>antimono\<guillemotright> X)
-      )"
-    is Topological_Spaces.monoseq_iff.
-
 tts_lemma monoseq_Suc:
   assumes "range X \<subseteq> U"
   shows 
     "(with (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>monoseq\<guillemotright> X) = 
       ((\<forall>x. X x \<le>\<^sub>o\<^sub>w X (Suc x)) \<or> (\<forall>x. X (Suc x) \<le>\<^sub>o\<^sub>w X x))"
     is Topological_Spaces.monoseq_Suc.
 
-tts_lemma incseq_SucI:
-  assumes "range X \<subseteq> U" and "\<And>n. X n \<le>\<^sub>o\<^sub>w X (Suc n)"
-  shows "on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>mono\<guillemotright> X"
-    is Topological_Spaces.incseq_SucI.
-
-tts_lemma incseq_SucD:
-  assumes "range A \<subseteq> U" and "on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>mono\<guillemotright> A"
-  shows "A i \<le>\<^sub>o\<^sub>w A (Suc i)"
-    is Topological_Spaces.incseq_SucD.
-
 tts_lemma decseq_SucI:
   assumes "range X \<subseteq> U" and "\<And>n. X (Suc n) \<le>\<^sub>o\<^sub>w X n"
   shows "on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>antimono\<guillemotright> X"
     is Topological_Spaces.decseq_SucI.
 
 tts_lemma decseq_SucD:
   assumes "range A \<subseteq> U" and "on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>antimono\<guillemotright> A"
   shows "A (Suc i) \<le>\<^sub>o\<^sub>w A i"
     is Topological_Spaces.decseq_SucD.
 
 tts_lemma mono_SucI2:
   assumes "range X \<subseteq> U" and "\<forall>x. X (Suc x) \<le>\<^sub>o\<^sub>w X x"
   shows "with (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>monoseq\<guillemotright> X"
     is Topological_Spaces.mono_SucI2.
 
 tts_lemma mono_SucI1:
   assumes "range X \<subseteq> U" and "\<forall>x. X x \<le>\<^sub>o\<^sub>w X (Suc x)"
   shows "with (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>monoseq\<guillemotright> X"
     is Topological_Spaces.mono_SucI1.
 
-tts_lemma incseqD:
-  assumes "range f \<subseteq> U" 
-    and "on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>mono\<guillemotright> f" 
-    and "(i::nat) \<le> j"
-  shows "f i \<le>\<^sub>o\<^sub>w f j"
-    is Topological_Spaces.incseqD.
-
 tts_lemma decseqD:
   assumes "range f \<subseteq> U"
     and "on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>antimono\<guillemotright> f"
     and "(i::nat) \<le> j"
   shows "f j \<le>\<^sub>o\<^sub>w f i"
     is Topological_Spaces.decseqD.
 
 tts_lemma monoI2:
   assumes "range X \<subseteq> U" and "\<forall>x y. x \<le> y \<longrightarrow> X y \<le>\<^sub>o\<^sub>w X x"
   shows "with (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>monoseq\<guillemotright> X"
     is Topological_Spaces.monoI2.
 
 tts_lemma monoI1:
   assumes "range X \<subseteq> U" and "\<forall>x y. x \<le> y \<longrightarrow> X x \<le>\<^sub>o\<^sub>w X y"
   shows "with (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>monoseq\<guillemotright> X"
     is Topological_Spaces.monoI1.
 
 tts_lemma antimono_iff_le_Suc:
   assumes "range f \<subseteq> U"
   shows "(on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>antimono\<guillemotright> f) = (\<forall>x. f (Suc x) \<le>\<^sub>o\<^sub>w f x)"
     is Nat.antimono_iff_le_Suc.
 
-tts_lemma mono_iff_le_Suc:
-  assumes "range f \<subseteq> U"
-  shows "(on UNIV with (\<le>\<^sub>o\<^sub>w) (\<le>) : \<guillemotleft>mono\<guillemotright> f) = (\<forall>x. f x \<le>\<^sub>o\<^sub>w f (Suc x))"
-    is Nat.mono_iff_le_Suc.
-
-tts_lemma funpow_mono2:
-  assumes "\<forall>x\<in>U. f x \<in> U"
-    and "x \<in> U"
-    and "y \<in> U"
-    and "on U with (\<le>\<^sub>o\<^sub>w) (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>mono\<guillemotright> f"
-    and "i \<le> j"
-    and "x \<le>\<^sub>o\<^sub>w y"
-    and "x \<le>\<^sub>o\<^sub>w f x"
-  shows "(f ^^ i) x \<le>\<^sub>o\<^sub>w (f ^^ j) y"
-    is Nat.funpow_mono2.
-
-tts_lemma funpow_mono:
-  assumes "\<forall>x\<in>U. f x \<in> U"
-    and "A \<in> U"
-    and "B \<in> U"
-    and "on U with (\<le>\<^sub>o\<^sub>w) (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>mono\<guillemotright> f"
-    and "A \<le>\<^sub>o\<^sub>w B"
-  shows "(f ^^ n) A \<le>\<^sub>o\<^sub>w (f ^^ n) B"
-    is Nat.funpow_mono.
-
 end
 
 tts_context
   tts: (?'a to U)
   rewriting ctr_simps
   substituting order_ow_axioms
   eliminating through clarsimp
 begin
 
 tts_lemma ex_min_if_finite:
   assumes "S \<subseteq> U"
     and "finite S"
     and "S \<noteq> {}"
   shows "\<exists>x\<in>S. \<not> (\<exists>y\<in>S. y <\<^sub>o\<^sub>w x)"
     is Lattices_Big.ex_min_if_finite.
     
 end
 
 tts_context
   tts: (?'a to U)
   sbterms: (\<open>(\<le>)::['a::order, 'a::order] \<Rightarrow> bool\<close> to \<open>(\<le>\<^sub>o\<^sub>w)\<close>) 
     and (\<open>(<)::['a::order, 'a::order] \<Rightarrow> bool\<close> to \<open>(<\<^sub>o\<^sub>w)\<close>)
   substituting order_ow_axioms
   eliminating through clarsimp
 begin
 
 tts_lemma xt1:
   shows 
     "\<lbrakk>a = b; c <\<^sub>o\<^sub>w b\<rbrakk> \<Longrightarrow> c <\<^sub>o\<^sub>w a"
     "\<lbrakk>b <\<^sub>o\<^sub>w a; b = c\<rbrakk> \<Longrightarrow> c <\<^sub>o\<^sub>w a"
     "\<lbrakk>a = b; c \<le>\<^sub>o\<^sub>w b\<rbrakk> \<Longrightarrow> c \<le>\<^sub>o\<^sub>w a"
     "\<lbrakk>b \<le>\<^sub>o\<^sub>w a; b = c\<rbrakk> \<Longrightarrow> c \<le>\<^sub>o\<^sub>w a"
     "\<lbrakk>y \<in> U; x \<in> U; y \<le>\<^sub>o\<^sub>w x; x \<le>\<^sub>o\<^sub>w y\<rbrakk> \<Longrightarrow> x = y"
     "\<lbrakk>y \<in> U; x \<in> U; z \<in> U; y \<le>\<^sub>o\<^sub>w x; z \<le>\<^sub>o\<^sub>w y\<rbrakk> \<Longrightarrow> z \<le>\<^sub>o\<^sub>w x"
     "\<lbrakk>y \<in> U; x \<in> U; z \<in> U; y <\<^sub>o\<^sub>w x; z \<le>\<^sub>o\<^sub>w y\<rbrakk> \<Longrightarrow> z <\<^sub>o\<^sub>w x"
     "\<lbrakk>y \<in> U; x \<in> U; z \<in> U; y \<le>\<^sub>o\<^sub>w x; z <\<^sub>o\<^sub>w y\<rbrakk> \<Longrightarrow> z <\<^sub>o\<^sub>w x"
     "\<lbrakk>b \<in> U; a \<in> U; b <\<^sub>o\<^sub>w a; a <\<^sub>o\<^sub>w b\<rbrakk> \<Longrightarrow> P"
     "\<lbrakk>y \<in> U; x \<in> U; z \<in> U; y <\<^sub>o\<^sub>w x; z <\<^sub>o\<^sub>w y\<rbrakk> \<Longrightarrow> z <\<^sub>o\<^sub>w x"
     "\<lbrakk>b \<in> U; a \<in> U; b \<le>\<^sub>o\<^sub>w a; a \<noteq> b\<rbrakk> \<Longrightarrow> b <\<^sub>o\<^sub>w a"
     "\<lbrakk>a \<in> U; b \<in> U; a \<noteq> b; b \<le>\<^sub>o\<^sub>w a\<rbrakk> \<Longrightarrow> b <\<^sub>o\<^sub>w a"
     "\<lbrakk>
       b \<in> U;
       c \<in> U;
       a = f b;
       c <\<^sub>o\<^sub>w b;
       \<And>x y. \<lbrakk>x \<in> U; y \<in> U; y <\<^sub>o\<^sub>w x\<rbrakk> \<Longrightarrow> f y <\<^sub>o\<^sub>w f x
      \<rbrakk> \<Longrightarrow> f c <\<^sub>o\<^sub>w a"
     "\<lbrakk>
       b \<in> U;
       a \<in> U;
       b <\<^sub>o\<^sub>w a;
       f b = c;
       \<And>x y. \<lbrakk>x \<in> U; y \<in> U; y <\<^sub>o\<^sub>w x\<rbrakk> \<Longrightarrow> f y <\<^sub>o\<^sub>w f x
       \<rbrakk> \<Longrightarrow> c <\<^sub>o\<^sub>w f a"
     "\<lbrakk>
       b \<in> U;
       c \<in> U;
       a = f b;
       c \<le>\<^sub>o\<^sub>w b;
       \<And>x y. \<lbrakk>x \<in> U; y \<in> U; y \<le>\<^sub>o\<^sub>w x\<rbrakk> \<Longrightarrow> f y \<le>\<^sub>o\<^sub>w f x
      \<rbrakk> \<Longrightarrow> f c \<le>\<^sub>o\<^sub>w a"
     "\<lbrakk>
       b \<in> U; 
       a \<in> U; 
       b \<le>\<^sub>o\<^sub>w a; 
       f b = c; 
       \<And>x y. \<lbrakk>x \<in> U; y \<in> U; y \<le>\<^sub>o\<^sub>w x\<rbrakk> \<Longrightarrow> f y \<le>\<^sub>o\<^sub>w f x
      \<rbrakk> \<Longrightarrow> c \<le>\<^sub>o\<^sub>w f a"
     is Orderings.xt1.
 
 end
 
-tts_context
-  tts: (?'a to U) and (?'b to \<open>U\<^sub>2::'b set\<close>)
-  rewriting ctr_simps
-  substituting order_ow_axioms
-  eliminating through (simp add: mono_ow_def)
-begin
-
-tts_lemma coinduct3_mono_lemma:
-  assumes "\<forall>x\<in>U. f x \<subseteq> U\<^sub>2"
-    and "X \<subseteq> U\<^sub>2"
-    and "B \<subseteq> U\<^sub>2"
-    and "on U with (\<subseteq>) (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>mono\<guillemotright> f"
-  shows "on U with (\<subseteq>) (\<le>\<^sub>o\<^sub>w) : \<guillemotleft>mono\<guillemotright> (\<lambda>x. f x \<union> (X \<union> B))"
-    is Inductive.coinduct3_mono_lemma.
-
-end
-
 end
 
 context ord_order_ow 
 begin
 
 tts_context
   tts: (?'a to U\<^sub>2) and (?'b to U\<^sub>1)
   sbterms: (\<open>(\<le>)::[?'a::order, ?'a::order] \<Rightarrow> bool\<close> to \<open>(\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2)\<close>) 
     and (\<open>(<)::[?'a::order, ?'a::order] \<Rightarrow> bool\<close> to \<open>(<\<^sub>o\<^sub>w\<^sub>.\<^sub>2)\<close>) 
     and (\<open>(\<le>)::[?'b::ord, ?'b::ord] \<Rightarrow> bool\<close> to \<open>(\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1)\<close>) 
     and (\<open>(<)::[?'b::ord, ?'b::ord] \<Rightarrow> bool\<close> to \<open>(<\<^sub>o\<^sub>w\<^sub>.\<^sub>1)\<close>) 
   rewriting ctr_simps
   substituting ord\<^sub>2.order_ow_axioms
   eliminating through clarsimp
 begin
 
 tts_lemma xt2:
   assumes "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
     and "b \<in> U\<^sub>1"
     and "a \<in> U\<^sub>2"
     and "c \<in> U\<^sub>1"
     and "f b \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 a"
     and "c \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 b"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; y \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 x\<rbrakk> \<Longrightarrow> f y \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f x"
   shows "f c \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 a"
   is Orderings.xt2.
     
 tts_lemma xt6:
   assumes "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
     and "b \<in> U\<^sub>1"
     and "a \<in> U\<^sub>2"
     and "c \<in> U\<^sub>1"
     and "f b \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 a"
     and "c <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 b"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; y <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 x\<rbrakk> \<Longrightarrow> f y <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f x"
   shows "f c <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 a"
     is Orderings.xt6.
 
 end
 
 end
 
 context order_pair_ow 
 begin
 
 tts_context
   tts: (?'a to U\<^sub>1) and (?'b to U\<^sub>2)
   rewriting ctr_simps
   substituting ord\<^sub>1.order_ow_axioms and ord\<^sub>2.order_ow_axioms
   eliminating through
     (
       unfold
         strict_mono_ow_def
         mono_ow_def
         antimono_ow_def
         bdd_above_ow_def
         bdd_below_ow_def
         bdd_ow_def,
       clarsimp
     )
 begin
 
 tts_lemma antimonoD:
   assumes "x \<in> U\<^sub>1"
     and "y \<in> U\<^sub>1"
     and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>antimono\<guillemotright> f"
     and "x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 y"
   shows "f y \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f x"
     is Orderings.antimonoD.
     
-tts_lemma monoD:
-  assumes "x \<in> U\<^sub>1"
-    and "y \<in> U\<^sub>1"
-    and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-    and "x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 y"
-  shows "f x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f y"
-    is Orderings.monoD.
-    
-tts_lemma strict_monoD:
-  assumes "x \<in> U\<^sub>1"
-    and "y \<in> U\<^sub>1"
-    and "on U\<^sub>1 with (<\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (<\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>strict_mono\<guillemotright> f"
-    and "x <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 y"
-  shows "f x <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f y"
-    is Orderings.strict_monoD.
-    
-tts_lemma strict_monoI:
-  assumes "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; x <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 y\<rbrakk> \<Longrightarrow> f x <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f y"
-  shows "on U\<^sub>1 with (<\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (<\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>strict_mono\<guillemotright> f"
-    is Orderings.strict_monoI.
-    
 tts_lemma antimonoI:
   assumes "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 y\<rbrakk> \<Longrightarrow> f y \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f x"
   shows "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>antimono\<guillemotright> f"
     is Orderings.antimonoI.
     
-tts_lemma monoI:
-  assumes "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 y\<rbrakk> \<Longrightarrow> f x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f y"
-  shows "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-    is Orderings.monoI.
-    
 tts_lemma antimonoE:
   assumes "x \<in> U\<^sub>1"
     and "y \<in> U\<^sub>1"
     and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>antimono\<guillemotright> f"
     and "x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 y"
     and "f y \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f x \<Longrightarrow> thesis"
   shows thesis
     is Orderings.antimonoE.
 
-tts_lemma monoE:
-  assumes "x \<in> U\<^sub>1"
-    and "y \<in> U\<^sub>1"
-    and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-    and "x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 y"
-    and "f x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f y \<Longrightarrow> thesis"
-  shows thesis
-    is Orderings.monoE.
-
-tts_lemma strict_mono_mono:
-  assumes "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
-    and "on U\<^sub>1 with (<\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (<\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>strict_mono\<guillemotright> f"
-  shows "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-    is Orderings.strict_mono_mono.
-
 tts_lemma bdd_below_image_antimono:
   assumes "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
     and "A \<subseteq> U\<^sub>1"
     and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>antimono\<guillemotright> f"
     and "ord\<^sub>1.bdd_above A"
   shows "ord\<^sub>2.bdd_below (f ` A)"
     is Conditionally_Complete_Lattices.bdd_below_image_antimono.
 
 tts_lemma bdd_above_image_antimono:
   assumes "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
     and "A \<subseteq> U\<^sub>1"
     and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>antimono\<guillemotright> f"
     and "ord\<^sub>1.bdd_below A"
   shows "ord\<^sub>2.bdd_above (f ` A)"
     is Conditionally_Complete_Lattices.bdd_above_image_antimono.
 
-tts_lemma bdd_below_image_mono:
-  assumes "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
-    and "A \<subseteq> U\<^sub>1"
-    and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-    and "ord\<^sub>1.bdd_below A"
-  shows "ord\<^sub>2.bdd_below (f ` A)"
-    is Conditionally_Complete_Lattices.bdd_below_image_mono.
-    
-tts_lemma bdd_above_image_mono:
-  assumes "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
-    and "A \<subseteq> U\<^sub>1"
-    and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-    and "ord\<^sub>1.bdd_above A"
-  shows "ord\<^sub>2.bdd_above (f ` A)"
-    is Conditionally_Complete_Lattices.bdd_above_image_mono.
-
-tts_lemma strict_mono_leD:
-  assumes "\<forall>x\<in>U\<^sub>1. r x \<in> U\<^sub>2"
-    and "m \<in> U\<^sub>1"
-    and "n \<in> U\<^sub>1"
-    and "on U\<^sub>1 with (<\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (<\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>strict_mono\<guillemotright> r"
-    and "m \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 n"
-  shows "r m \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 r n"
-    is Topological_Spaces.strict_mono_leD.
-
-tts_lemma mono_image_least:
-  assumes "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
-    and "m \<in> U\<^sub>1"
-    and "n \<in> U\<^sub>1"
-    and "m' \<in> U\<^sub>2"
-    and "n' \<in> U\<^sub>2"
-    and "on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : \<guillemotleft>mono\<guillemotright> f"
-    and "f ` (on U\<^sub>1 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1) (<\<^sub>o\<^sub>w\<^sub>.\<^sub>1) : {m..<n}) = 
-      (on U\<^sub>2 with (\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2) (<\<^sub>o\<^sub>w\<^sub>.\<^sub>2) : {m'..<n'})"
-    and "m <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 n"
-  shows "f m = m'"
-    is Set_Interval.mono_image_least.
-
 end
 
 tts_context
   tts: (?'a to U\<^sub>1) and (?'b to U\<^sub>2)
   sbterms: (\<open>(\<le>)::[?'a::order, ?'a::order] \<Rightarrow> bool\<close> to \<open>(\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1)\<close>) 
     and (\<open>(<)::[?'a::order, ?'a::order] \<Rightarrow> bool\<close> to \<open>(<\<^sub>o\<^sub>w\<^sub>.\<^sub>1)\<close>) 
     and (\<open>(\<le>)::[?'b::order, ?'b::order] \<Rightarrow> bool\<close> to \<open>(\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2)\<close>) 
     and (\<open>(<)::[?'b::order, ?'b::order] \<Rightarrow> bool\<close> to \<open>(<\<^sub>o\<^sub>w\<^sub>.\<^sub>2)\<close>)
   rewriting ctr_simps
   substituting ord\<^sub>1.order_ow_axioms and ord\<^sub>2.order_ow_axioms
   eliminating through clarsimp
 begin
 
 tts_lemma xt3:
   assumes "b \<in> U\<^sub>1"
     and "a \<in> U\<^sub>1"
     and "c \<in> U\<^sub>2"
     and "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
     and "b \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 a"
     and "c \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f b"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; y \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 x\<rbrakk> \<Longrightarrow> f y \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f x"
   shows "c \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f a"
     is Orderings.xt3.
     
 tts_lemma xt4:
   assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U\<^sub>1"
     and "b \<in> U\<^sub>2"
     and "a \<in> U\<^sub>1"
     and "c \<in> U\<^sub>2"
     and "f b <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 a"
     and "c \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 b"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>2; y \<in> U\<^sub>2; y \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 x\<rbrakk> \<Longrightarrow> f y \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 f x"
   shows "f c <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 a"
     is Orderings.xt4.
     
 tts_lemma xt5:
   assumes "b \<in> U\<^sub>1"
     and "a \<in> U\<^sub>1"
     and "c \<in> U\<^sub>2"
     and "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
     and "b <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 a"
     and "c \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f b"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; y <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 x\<rbrakk> \<Longrightarrow> f y <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f x"
   shows "c <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f a"
     is Orderings.xt5.
     
 tts_lemma xt7:
   assumes "b \<in> U\<^sub>1"
     and "a \<in> U\<^sub>1"
     and "c \<in> U\<^sub>2"
     and "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
     and "b \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 a"
     and "c <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f b"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; y \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 x\<rbrakk> \<Longrightarrow> f y \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f x"
   shows "c <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f a"
     is Orderings.xt7.
 
 tts_lemma xt8:
   assumes "\<forall>x\<in>U\<^sub>2. f x \<in> U\<^sub>1"
     and "b \<in> U\<^sub>2"
     and "a \<in> U\<^sub>1"
     and "c \<in> U\<^sub>2"
     and "f b <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 a"
     and "c <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 b"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>2; y \<in> U\<^sub>2; y <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 x\<rbrakk> \<Longrightarrow> f y <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 f x"
   shows "f c <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 a"
     is Orderings.xt8.
 
 tts_lemma xt9:
   assumes "b \<in> U\<^sub>1"
     and "a \<in> U\<^sub>1"
     and "c \<in> U\<^sub>2"
     and "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
     and "b <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 a"
     and "c <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f b"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; y <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 x\<rbrakk> \<Longrightarrow> f y <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f x"
   shows "c <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f a"
     is Orderings.xt9.
 
 end
 
 tts_context
   tts: (?'a to U\<^sub>1) and (?'b to U\<^sub>2)
   sbterms: (\<open>(\<le>)::[?'a::order, ?'a::order] \<Rightarrow> bool\<close> to \<open>(\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1)\<close>) 
     and (\<open>(<)::[?'a::order, ?'a::order] \<Rightarrow> bool\<close> to \<open>(<\<^sub>o\<^sub>w\<^sub>.\<^sub>1)\<close>)  
     and (\<open>(\<le>)::[?'b::order, ?'b::order] \<Rightarrow> bool\<close> to \<open>(\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2)\<close>) 
     and (\<open>(<)::[?'b::order, ?'b::order] \<Rightarrow> bool\<close> to \<open>(<\<^sub>o\<^sub>w\<^sub>.\<^sub>2)\<close>)
   rewriting ctr_simps
   substituting ord\<^sub>1.order_ow_axioms and ord\<^sub>2.order_ow_axioms
   eliminating through simp
 begin
 
 tts_lemma order_less_subst1:
   assumes "a \<in> U\<^sub>1"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U\<^sub>1"
     and "b \<in> U\<^sub>2"
     and "c \<in> U\<^sub>2"
     and "a <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 f b"
     and "b <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 c"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>2; y \<in> U\<^sub>2; x <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 y\<rbrakk> \<Longrightarrow> f x <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 f y"
   shows "a <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 f c"
     is Orderings.order_less_subst1.
     
 tts_lemma order_subst1:
   assumes "a \<in> U\<^sub>1"
     and "\<forall>x\<in>U\<^sub>2. f x \<in> U\<^sub>1"
     and "b \<in> U\<^sub>2"
     and "c \<in> U\<^sub>2"
     and "a \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 f b"
     and "b \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 c"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>2; y \<in> U\<^sub>2; x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 y\<rbrakk> \<Longrightarrow> f x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 f y"
   shows "a \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 f c"
     is Orderings.order_subst1.
 
 end
 
 tts_context
   tts: (?'a to U\<^sub>1) and (?'c to U\<^sub>2)
   sbterms: (\<open>(\<le>)::[?'a::order, ?'a::order] \<Rightarrow> bool\<close> to \<open>(\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1)\<close>) 
     and (\<open>(<)::[?'a::order, ?'a::order] \<Rightarrow> bool\<close> to \<open>(<\<^sub>o\<^sub>w\<^sub>.\<^sub>1)\<close>) 
     and (\<open>(\<le>)::[?'c::order, ?'c::order] \<Rightarrow> bool\<close> to \<open>(\<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2)\<close>) 
     and (\<open>(<)::[?'c::order, ?'c::order] \<Rightarrow> bool\<close> to \<open>(<\<^sub>o\<^sub>w\<^sub>.\<^sub>2)\<close>)
   rewriting ctr_simps
   substituting ord\<^sub>1.order_ow_axioms and ord\<^sub>2.order_ow_axioms
   eliminating through simp
 begin
 
 tts_lemma order_less_le_subst2:
   assumes "a \<in> U\<^sub>1"
     and "b \<in> U\<^sub>1"
     and "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
     and "c \<in> U\<^sub>2"
     and "a <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 b"
     and "f b \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 c"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; x <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 y\<rbrakk> \<Longrightarrow> f x <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f y"
   shows "f a <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 c"
     is Orderings.order_less_le_subst2.
     
 tts_lemma order_le_less_subst2:
   assumes "a \<in> U\<^sub>1"
     and "b \<in> U\<^sub>1"
     and "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
     and "c \<in> U\<^sub>2"
     and "a \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 b"
     and "f b <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 c"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 y\<rbrakk> \<Longrightarrow> f x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f y"
   shows "f a <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 c"
     is Orderings.order_le_less_subst2.
     
 tts_lemma order_less_subst2:
   assumes "a \<in> U\<^sub>1"
     and "b \<in> U\<^sub>1"
     and "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
     and "c \<in> U\<^sub>2"
     and "a <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 b"
     and "f b <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 c"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; x <\<^sub>o\<^sub>w\<^sub>.\<^sub>1 y\<rbrakk> \<Longrightarrow> f x <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f y"
   shows "f a <\<^sub>o\<^sub>w\<^sub>.\<^sub>2 c"
     is Orderings.order_less_subst2.
 
 tts_lemma order_subst2:
   assumes "a \<in> U\<^sub>1"
     and "b \<in> U\<^sub>1"
     and "\<forall>x\<in>U\<^sub>1. f x \<in> U\<^sub>2"
     and "c \<in> U\<^sub>2"
     and "a \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 b"
     and "f b \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 c"
     and "\<And>x y. \<lbrakk>x \<in> U\<^sub>1; y \<in> U\<^sub>1; x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>1 y\<rbrakk> \<Longrightarrow> f x \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 f y"
   shows "f a \<le>\<^sub>o\<^sub>w\<^sub>.\<^sub>2 c"
     is Orderings.order_subst2.
 
 end
 
 end
 
 
 
 subsection\<open>Dense orders\<close>
 
 
 subsubsection\<open>Definitions and common properties\<close>
 
 locale dense_order_ow = order_ow U le ls
   for U :: "'ao set" and le ls +
   assumes dense: "\<lbrakk> x \<in> U; y \<in> U; x <\<^sub>o\<^sub>w y \<rbrakk> \<Longrightarrow> (\<exists>z\<in>U. x <\<^sub>o\<^sub>w z \<and> z <\<^sub>o\<^sub>w y)"
 
 
 subsubsection\<open>Transfer rules\<close>
 
 context
   includes lifting_syntax
 begin
 
 lemma dense_order_transfer[transfer_rule]:
   assumes [transfer_rule]: "bi_unique A" "right_total A" 
   shows 
     "((A ===> A ===> (=)) ===> (A ===> A ===> (=)) ===> (=)) 
       (dense_order_ow (Collect (Domainp A))) class.dense_order"
   unfolding 
     dense_order_ow_def class.dense_order_def
     dense_order_ow_axioms_def class.dense_order_axioms_def
   apply transfer_prover_start
   apply transfer_step+
   by simp
   
 end
 
 
 
 subsection\<open>
 Partial orders with the greatest element and 
 partial orders with the least elements
 \<close>
 
 
 subsubsection\<open>Definitions and common properties\<close>
 
 locale ordering_top_ow = ordering_ow U le ls 
   for U :: "'ao set" and le ls  +
   fixes top :: "'ao" ("\<^bold>\<top>\<^sub>o\<^sub>w")
   assumes top_closed[simp]: "\<^bold>\<top>\<^sub>o\<^sub>w \<in> U"
   assumes extremum[simp]: "a \<in> U \<Longrightarrow> a \<^bold>\<le>\<^sub>o\<^sub>w \<^bold>\<top>\<^sub>o\<^sub>w"
 begin
 
 notation top ("\<^bold>\<top>\<^sub>o\<^sub>w")
 
 end
 
 locale bot_ow = 
   fixes U :: "'ao set" and bot (\<open>\<bottom>\<^sub>o\<^sub>w\<close>)
   assumes bot_closed[simp]: "\<bottom>\<^sub>o\<^sub>w \<in> U"
 begin
 
 notation bot (\<open>\<bottom>\<^sub>o\<^sub>w\<close>)
 
 end
 
 locale bot_pair_ow = ord\<^sub>1: bot_ow U\<^sub>1 bot\<^sub>1 + ord\<^sub>2: bot_ow U\<^sub>2 bot\<^sub>2
   for U\<^sub>1 :: "'ao set" and bot\<^sub>1 and U\<^sub>2 :: "'bo set" and bot\<^sub>2
 begin
 
 notation bot\<^sub>1 (\<open>\<bottom>\<^sub>o\<^sub>w\<^sub>.\<^sub>1\<close>)
 notation bot\<^sub>2 (\<open>\<bottom>\<^sub>o\<^sub>w\<^sub>.\<^sub>2\<close>)
 
 end
 
 locale order_bot_ow = order_ow U le ls + bot_ow U bot
   for U :: "'ao set" and bot le ls  +
   assumes bot_least: "a \<in> U \<Longrightarrow> \<bottom>\<^sub>o\<^sub>w \<le>\<^sub>o\<^sub>w a"
 begin
 
 sublocale bot: ordering_top_ow U \<open>(\<ge>\<^sub>o\<^sub>w)\<close> \<open>(>\<^sub>o\<^sub>w)\<close> \<open>\<bottom>\<^sub>o\<^sub>w\<close>
   apply unfold_locales
   subgoal by simp
   subgoal by (simp add: bot_least)
   done
 
 no_notation le (infix "\<^bold>\<le>\<^sub>o\<^sub>w" 50)
   and ls (infix "\<^bold><\<^sub>o\<^sub>w" 50)
   and top ("\<^bold>\<top>\<^sub>o\<^sub>w")
 
 end
 
 locale order_bot_pair_ow = 
   ord\<^sub>1: order_bot_ow U\<^sub>1 bot\<^sub>1 le\<^sub>1 ls\<^sub>1 + ord\<^sub>2: order_bot_ow U\<^sub>2 bot\<^sub>2 le\<^sub>2 ls\<^sub>2 
   for U\<^sub>1 :: "'ao set" and bot\<^sub>1 le\<^sub>1 ls\<^sub>1 and U\<^sub>2 :: "'bo set" and bot\<^sub>2 le\<^sub>2 ls\<^sub>2  
 begin
 
 sublocale bot_pair_ow ..
 sublocale order_pair_ow ..
 
 end
 
 
 locale top_ow = 
   fixes U :: "'ao set" and top (\<open>\<top>\<^sub>o\<^sub>w\<close>)
   assumes top_closed[simp]: "\<top>\<^sub>o\<^sub>w \<in> U"
 begin
 
 notation top (\<open>\<top>\<^sub>o\<^sub>w\<close>)
 
 end
 
 locale top_pair_ow = ord\<^sub>1: top_ow U\<^sub>1 top\<^sub>1 + ord\<^sub>2: top_ow U\<^sub>2 top\<^sub>2
   for U\<^sub>1 :: "'ao set" and top\<^sub>1 and U\<^sub>2 :: "'bo set" and top\<^sub>2
 begin
 
 notation top\<^sub>1 (\<open>\<top>\<^sub>o\<^sub>w\<^sub>.\<^sub>1\<close>)
 notation top\<^sub>2 (\<open>\<top>\<^sub>o\<^sub>w\<^sub>.\<^sub>2\<close>)
 
 end
 
 locale order_top_ow = order_ow U le ls + top_ow U top
   for U :: "'ao set" and le ls top  +
   assumes top_greatest: "a \<in> U \<Longrightarrow> a \<le>\<^sub>o\<^sub>w \<top>\<^sub>o\<^sub>w"
 begin
 
 sublocale top: ordering_top_ow U \<open>(\<le>\<^sub>o\<^sub>w)\<close> \<open>(<\<^sub>o\<^sub>w)\<close> \<open>\<top>\<^sub>o\<^sub>w\<close>
   apply unfold_locales
   subgoal by simp
   subgoal by (simp add: top_greatest)
   done
 
 no_notation le (infix "\<^bold>\<le>\<^sub>o\<^sub>w" 50)
   and ls (infix "\<^bold><\<^sub>o\<^sub>w" 50)
   and top ("\<^bold>\<top>\<^sub>o\<^sub>w")
 
 end
 
 locale order_top_pair_ow = 
   ord\<^sub>1: order_top_ow U\<^sub>1 le\<^sub>1 ls\<^sub>1 top\<^sub>1 + ord\<^sub>2: order_top_ow U\<^sub>2 le\<^sub>2 ls\<^sub>2 top\<^sub>2
   for U\<^sub>1 :: "'ao set" and le\<^sub>1 ls\<^sub>1 top\<^sub>1 and U\<^sub>2 :: "'bo set" and le\<^sub>2 ls\<^sub>2 top\<^sub>2 
 begin
 
 sublocale top_pair_ow ..
 sublocale order_pair_ow ..
 
 end
 
 
 subsubsection\<open>Transfer rules\<close>
 
 context
   includes lifting_syntax
 begin
 
 lemma ordering_top_transfer[transfer_rule]:
   assumes [transfer_rule]: "bi_unique A" "right_total A" 
   shows 
     "((A ===> A ===> (=)) ===> (A ===> A ===> (=)) ===> A ===> (=)) 
       (ordering_top_ow (Collect (Domainp A))) ordering_top"
 proof-
   let ?P = "((A ===> A ===> (=)) ===> (A ===> A ===> (=)) ===> A ===> (=))"
   let ?ordering_top_ow = "ordering_top_ow (Collect (Domainp A))"
   have 
     "?P ?ordering_top_ow (\<lambda>le ls ext. ext \<in> UNIV \<and> ordering_top le ls ext)"
     unfolding 
       ordering_top_ow_def ordering_top_def
       ordering_top_ow_axioms_def ordering_top_axioms_def
     apply transfer_prover_start
     apply transfer_step+
     by blast 
   thus ?thesis by simp
 qed
 
 lemma order_bot_transfer[transfer_rule]:
   assumes [transfer_rule]: "bi_unique A" "right_total A"
   shows 
     "(A ===> (A ===> A ===> (=)) ===> (A ===> A ===> (=)) ===> (=)) 
       (order_bot_ow (Collect (Domainp A))) class.order_bot"
 proof-
   let ?P = "(A ===> (A ===> A ===> (=)) ===> (A ===> A ===> (=)) ===> (=))"
   let ?order_bot_ow = "order_bot_ow (Collect (Domainp A))"
   have 
     "?P ?order_bot_ow (\<lambda>bot le ls. bot \<in> UNIV \<and> class.order_bot bot le ls)"
     unfolding 
       class.order_bot_def order_bot_ow_def 
       class.order_bot_axioms_def order_bot_ow_axioms_def
       bot_ow_def
     apply transfer_prover_start
     apply transfer_step+
     by blast 
   thus ?thesis by simp
 qed
 
 lemma order_top_transfer[transfer_rule]:
   assumes [transfer_rule]: "bi_unique A" "right_total A" 
   shows 
     "((A ===> A ===> (=)) ===> (A ===> A ===> (=)) ===> A ===> (=)) 
       (order_top_ow (Collect (Domainp A))) class.order_top"
 proof-
   let ?P = "((A ===> A ===> (=)) ===> (A ===> A ===> (=)) ===> A ===> (=))"
   let ?order_top_ow = "order_top_ow (Collect (Domainp A))"
   have 
     "?P ?order_top_ow (\<lambda>le ls top. top \<in> UNIV \<and> class.order_top le ls top)"
     unfolding 
       class.order_top_def order_top_ow_def 
       class.order_top_axioms_def order_top_ow_axioms_def
       top_ow_def
     apply transfer_prover_start
     apply transfer_step+
     by blast 
   thus ?thesis by simp
 qed
   
 end
 
 
 subsubsection\<open>Relativization\<close>
 
 context ordering_top_ow 
 begin
 
 tts_context
   tts: (?'a to U)
   rewriting ctr_simps
   substituting ordering_top_ow_axioms
   eliminating through simp
   applying [OF top_closed]
 begin
 
 tts_lemma extremum_uniqueI:
   assumes "\<^bold>\<top>\<^sub>o\<^sub>w \<^bold>\<le>\<^sub>o\<^sub>w \<^bold>\<top>\<^sub>o\<^sub>w"
   shows "\<^bold>\<top>\<^sub>o\<^sub>w = \<^bold>\<top>\<^sub>o\<^sub>w"
     is ordering_top.extremum_uniqueI.
     
 tts_lemma extremum_unique:
   shows "(\<^bold>\<top>\<^sub>o\<^sub>w \<^bold>\<le>\<^sub>o\<^sub>w \<^bold>\<top>\<^sub>o\<^sub>w) = (\<^bold>\<top>\<^sub>o\<^sub>w = \<^bold>\<top>\<^sub>o\<^sub>w)"
     is ordering_top.extremum_unique.
     
 tts_lemma extremum_strict:
   shows "\<not> \<^bold>\<top>\<^sub>o\<^sub>w \<^bold><\<^sub>o\<^sub>w \<^bold>\<top>\<^sub>o\<^sub>w"
     is ordering_top.extremum_strict.
     
 tts_lemma not_eq_extremum:
   shows "(\<^bold>\<top>\<^sub>o\<^sub>w \<noteq> \<^bold>\<top>\<^sub>o\<^sub>w) = (\<^bold>\<top>\<^sub>o\<^sub>w \<^bold><\<^sub>o\<^sub>w \<^bold>\<top>\<^sub>o\<^sub>w)"
     is ordering_top.not_eq_extremum.
 
 end
   
 end
 
 context order_bot_ow 
 begin
 
 tts_context
   tts: (?'a to U)
   rewriting ctr_simps
   substituting order_bot_ow_axioms
   eliminating through simp
 begin
 
 tts_lemma bdd_above_bot:
   assumes "A \<subseteq> U"
   shows "bdd_below A"
     is order_bot_class.bdd_below_bot.
 
 tts_lemma not_less_bot:
   assumes "a \<in> U"
   shows "\<not> a <\<^sub>o\<^sub>w \<bottom>\<^sub>o\<^sub>w"
   is order_bot_class.not_less_bot.
     
 tts_lemma max_bot:
   assumes "x \<in> U"
   shows "max \<bottom>\<^sub>o\<^sub>w x = x"
     is order_bot_class.max_bot.
 
 tts_lemma max_bot2:
   assumes "x \<in> U"
   shows "max x \<bottom>\<^sub>o\<^sub>w = x"
     is order_bot_class.max_bot2.
 
 tts_lemma min_bot:
   assumes "x \<in> U"
   shows "min \<bottom>\<^sub>o\<^sub>w x = \<bottom>\<^sub>o\<^sub>w"
     is order_bot_class.min_bot.
 
 tts_lemma min_bot2:
   assumes "x \<in> U"
   shows "min x \<bottom>\<^sub>o\<^sub>w = \<bottom>\<^sub>o\<^sub>w"
     is order_bot_class.min_bot2.
 
 tts_lemma bot_unique:
   assumes "a \<in> U"
   shows "(a \<le>\<^sub>o\<^sub>w \<bottom>\<^sub>o\<^sub>w) = (a = \<bottom>\<^sub>o\<^sub>w)"
     is order_bot_class.bot_unique.
 
 tts_lemma bot_less:
   assumes "a \<in> U"
   shows "(a \<noteq> \<bottom>\<^sub>o\<^sub>w) = (\<bottom>\<^sub>o\<^sub>w <\<^sub>o\<^sub>w a)"
     is order_bot_class.bot_less.
 
 tts_lemma atLeast_eq_UNIV_iff:
   assumes "x \<in> U"
   shows "({x..\<^sub>o\<^sub>w} = U) = (x = \<bottom>\<^sub>o\<^sub>w)"
     is order_bot_class.atLeast_eq_UNIV_iff.
 
 tts_lemma le_bot:
   assumes "a \<in> U" and "a \<le>\<^sub>o\<^sub>w \<bottom>\<^sub>o\<^sub>w"
   shows "a = \<bottom>\<^sub>o\<^sub>w"
     is order_bot_class.le_bot.
 
 end
 
 end
 
 context order_top_ow 
 begin
 
 tts_context
   tts: (?'a to U)
   rewriting ctr_simps
   substituting order_top_ow_axioms
   eliminating through simp
 begin
 
 tts_lemma bdd_above_top:
   assumes "A \<subseteq> U"
   shows "bdd_above A"
   is order_top_class.bdd_above_top.
 
 tts_lemma not_top_less:
   assumes "a \<in> U"
   shows "\<not> \<top>\<^sub>o\<^sub>w <\<^sub>o\<^sub>w a"
     is order_top_class.not_top_less.
 
 tts_lemma max_top:
   assumes "x \<in> U"
   shows "max \<top>\<^sub>o\<^sub>w x = \<top>\<^sub>o\<^sub>w"
     is order_top_class.max_top.
 
 tts_lemma max_top2:
   assumes "x \<in> U"
   shows "max x \<top>\<^sub>o\<^sub>w = \<top>\<^sub>o\<^sub>w"
     is order_top_class.max_top2.
 
 tts_lemma min_top:
   assumes "x \<in> U"
   shows "min \<top>\<^sub>o\<^sub>w x = x"
     is order_top_class.min_top.
 
 tts_lemma min_top2:
   assumes "x \<in> U"
   shows "min x \<top>\<^sub>o\<^sub>w = x"
     is order_top_class.min_top2.
 
 tts_lemma top_unique:
   assumes "a \<in> U"
   shows "(\<top>\<^sub>o\<^sub>w \<le>\<^sub>o\<^sub>w a) = (a = \<top>\<^sub>o\<^sub>w)"
     is order_top_class.top_unique.
 
 tts_lemma less_top:
   assumes "a \<in> U"
   shows "(a \<noteq> \<top>\<^sub>o\<^sub>w) = (a <\<^sub>o\<^sub>w \<top>\<^sub>o\<^sub>w)"
     is order_top_class.less_top.
 
 tts_lemma atMost_eq_UNIV_iff:
   assumes "x \<in> U"
   shows "({..\<^sub>o\<^sub>wx} = U) = (x = \<top>\<^sub>o\<^sub>w)"
     is order_top_class.atMost_eq_UNIV_iff.
 
 tts_lemma top_le:
   assumes "a \<in> U" and "\<top>\<^sub>o\<^sub>w \<le>\<^sub>o\<^sub>w a"
   shows "a = \<top>\<^sub>o\<^sub>w"
     is order_top_class.top_le.
 
 end
 
 end
 
 text\<open>\newpage\<close>
 
 end
\ No newline at end of file