merged; resolved conflicts manually (esp. lemmas that have been moved from Linear_Algebra and Cartesian_Euclidean_Space)
authorimmler
Thu May 03 15:07:14 2018 +0200 (14 months ago)
changeset 68073fad29d2a17a5
parent 68072 493b818e8e10
parent 68070 8dc792d440b9
child 68074 8d50467f7555
merged; resolved conflicts manually (esp. lemmas that have been moved from Linear_Algebra and Cartesian_Euclidean_Space)
CONTRIBUTORS
NEWS
src/HOL/Algebra/Order.thy
src/HOL/Analysis/Bochner_Integration.thy
src/HOL/Analysis/Cartesian_Euclidean_Space.thy
src/HOL/Analysis/Cartesian_Space.thy
src/HOL/Analysis/Change_Of_Vars.thy
src/HOL/Analysis/Convex_Euclidean_Space.thy
src/HOL/Analysis/Derivative.thy
src/HOL/Analysis/Determinants.thy
src/HOL/Analysis/Equivalence_Lebesgue_Henstock_Integration.thy
src/HOL/Analysis/Finite_Cartesian_Product.thy
src/HOL/Analysis/Henstock_Kurzweil_Integration.thy
src/HOL/Analysis/Homeomorphism.thy
src/HOL/Analysis/Inner_Product.thy
src/HOL/Analysis/Linear_Algebra.thy
src/HOL/Analysis/Polytope.thy
src/HOL/Analysis/Sigma_Algebra.thy
src/HOL/Analysis/Starlike.thy
src/HOL/Codegenerator_Test/Generate_Pretty_Char.thy
src/HOL/Hull.thy
src/HOL/Library/Code_Char.thy
src/HOL/Library/Library.thy
src/HOL/Modules.thy
src/HOL/Tools/string_code.ML
src/HOL/Vector_Spaces.thy
src/Tools/Adhoc_Overloading.thy
src/Tools/adhoc_overloading.ML
     1.1 --- a/Admin/PLATFORMS	Wed May 02 13:49:38 2018 +0200
     1.2 +++ b/Admin/PLATFORMS	Thu May 03 15:07:14 2018 +0200
     1.3 @@ -5,8 +5,8 @@
     1.4  --------
     1.5  
     1.6  The general programming model is that of a stylized ML + Scala + POSIX
     1.7 -environment, with as little system-specific code in user-space tools
     1.8 -as possible.
     1.9 +environment, with a minimum of system-specific code in user-space
    1.10 +tools.
    1.11  
    1.12  The Isabelle system infrastructure provides some facilities to make
    1.13  this work, e.g. see the ML and Scala modules File and Path, or
    1.14 @@ -19,8 +19,8 @@
    1.15  When producing add-on tools, it is important to stay within this clean
    1.16  room of Isabelle, and refrain from non-portable access to operating
    1.17  system functions. The Isabelle environment uses peculiar scripts for
    1.18 -GNU bash and perl to get the plumbing right. This style should be
    1.19 -imitated as far as possible.
    1.20 +GNU bash and perl as system glue: this style should be observed as far
    1.21 +as possible.
    1.22  
    1.23  
    1.24  Supported platforms
    1.25 @@ -36,6 +36,7 @@
    1.26    x86_64-darwin     Mac OS X 10.10 Yosemite (macbroy31 MacBookPro6,2)
    1.27                      Mac OS X 10.11 El Capitan (macbroy2 MacPro4,1)
    1.28                      macOS 10.12 Sierra (macbroy30 MacBookPro6,2)
    1.29 +                    macOS 10.13 High Sierra
    1.30  
    1.31    x86_64-windows    Windows 7
    1.32    x86_64-cygwin     Cygwin 2.8 http://isabelle.in.tum.de/cygwin_2017 (x86_64/release)
    1.33 @@ -43,7 +44,7 @@
    1.34  All of the above platforms are 100% supported by Isabelle -- end-users
    1.35  should not have to care about the differences (at least in theory).
    1.36  
    1.37 -Fringe platforms like BSD or Solaris are not supported.
    1.38 +Exotic platforms like BSD, Solaris, NixOS are not supported.
    1.39  
    1.40  
    1.41  64 bit vs. 32 bit platform personality
    1.42 @@ -52,42 +53,41 @@
    1.43  Isabelle requires 64 bit hardware running a 64 bit operating
    1.44  system. Windows and Mac OS X allow x86 executables as well, but for
    1.45  Linux this requires separate installation of 32 bit shared
    1.46 -libraries. The POSIX emulation on Windows via Cygwin64 is exclusively
    1.47 -for x86_64.
    1.48 +libraries. The POSIX emulation on Windows via Cygwin64 works
    1.49 +exclusively for x86_64.
    1.50  
    1.51 -ML works both for x86_64 and x86, and the latter is preferred for space
    1.52 -and performance reasons. Java is always for x86_64 on all platforms.
    1.53 +Poly/ML supports both for x86_64 and x86, and the latter is preferred
    1.54 +for space and performance reasons. Java is always the x86_64 version
    1.55 +on all platforms.
    1.56  
    1.57  Add-on executables are expected to work without manual user
    1.58  configuration. Each component settings script needs to determine the
    1.59  platform details appropriately.
    1.60  
    1.61  
    1.62 -The Isabelle settings environment provides the following variables to
    1.63 -help configuring platform-dependent tools:
    1.64 +The Isabelle settings environment provides the following important
    1.65 +variables to help configuring platform-dependent tools:
    1.66  
    1.67    ISABELLE_PLATFORM64  (potentially empty)
    1.68    ISABELLE_PLATFORM32  (potentially empty)
    1.69 -  ISABELLE_PLATFORM
    1.70  
    1.71 -The ISABELLE_PLATFORM setting variable prefers the 32 bit personality of
    1.72 -the platform, if possible. Using regular bash notation, tools may
    1.73 -express their preference for 64 bit with a fall-back for 32 bit as
    1.74 -follows:
    1.75 +Each can be empty, but not both at the same time. Using GNU bash
    1.76 +notation, tools may express their platform preference, e.g. first 64
    1.77 +bit and second 32 bit, or the opposite:
    1.78  
    1.79    "${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}"
    1.80 +  "${ISABELLE_PLATFORM32:-$ISABELLE_PLATFORM64}"
    1.81  
    1.82  
    1.83 -There is a second set of settings for native Windows (instead of the
    1.84 +There is a another set of settings for native Windows (instead of the
    1.85  POSIX emulation of Cygwin used before):
    1.86  
    1.87    ISABELLE_WINDOWS_PLATFORM64
    1.88    ISABELLE_WINDOWS_PLATFORM32
    1.89 -  ISABELLE_WINDOWS_PLATFORM
    1.90  
    1.91 -It can be used like this:
    1.92 -
    1.93 -  "${ISABELLE_WINDOWS_PLATFORM:-$ISABELLE_PLATFORM}"
    1.94 +These are always empty on Linux and Mac OS X, and non-empty on
    1.95 +Windows. They can be used like this to prefer native Windows and then
    1.96 +Unix (first 64 bit second 32 bit):
    1.97  
    1.98    "${ISABELLE_WINDOWS_PLATFORM64:-${ISABELLE_WINDOWS_PLATFORM32:-${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}}}"
    1.99  
   1.100 @@ -97,13 +97,13 @@
   1.101  
   1.102  The following portable system tools can be taken for granted:
   1.103  
   1.104 -* Scala on top of Java 8.  Isabelle/Scala irons out many oddities and
   1.105 +* Scala on top of Java.  Isabelle/Scala irons out many oddities and
   1.106    portability issues of the Java platform.
   1.107  
   1.108 -* GNU bash as uniform shell on all platforms. The POSIX "standard" shell
   1.109 -  /bin/sh does *not* work -- there are too many non-standard
   1.110 -  implementations of it. On Debian and Ubuntu /bin/sh is actually
   1.111 -  /bin/dash and thus introduces many oddities.
   1.112 +* GNU bash as uniform shell on all platforms. The POSIX "standard"
   1.113 +  shell /bin/sh does *not* work portably -- there are too many
   1.114 +  non-standard implementations of it. On Debian and Ubuntu /bin/sh is
   1.115 +  actually /bin/dash and introduces many oddities.
   1.116  
   1.117  * Perl as largely portable system programming language, with its
   1.118    fairly robust support for processes, signals, sockets etc.
   1.119 @@ -123,12 +123,6 @@
   1.120    Such add-ons are usually included in Apple's /usr/bin/perl by
   1.121    default.
   1.122  
   1.123 -* The Java runtime has its own idea about the underlying platform, which
   1.124 -  affects Java native libraries in particular. In Isabelle/Scala the
   1.125 -  function isabelle.Platform.jvm_platform identifies the JVM platform.
   1.126 -  In the settings environment, ISABELLE_JAVA_PLATFORM provides the same
   1.127 -  information without running the JVM.
   1.128 -
   1.129  * Common Unix tools like /bin/sh, /bin/kill, sed, ulimit are
   1.130    notoriously non-portable an should be avoided.
   1.131  
     2.1 --- a/Admin/components/components.sha1	Wed May 02 13:49:38 2018 +0200
     2.2 +++ b/Admin/components/components.sha1	Thu May 03 15:07:14 2018 +0200
     2.3 @@ -88,6 +88,7 @@
     2.4  e45edcf184f608d6f4a7b966d65a5d3289462693  jdk-8u144.tar.gz
     2.5  264e806b9300a4fb3b6e15ba0e2c664d4ea698c8  jdk-8u152.tar.gz
     2.6  84b04d877a2ea3a4e2082297b540e14f76722bc5  jdk-8u162.tar.gz
     2.7 +87303a0de3fd595aa3857c8f7cececa036d6ed18  jdk-8u172.tar.gz
     2.8  cfecb1383faaf027ffbabfcd77a0b6a6521e0969  jdk-8u20.tar.gz
     2.9  44ffeeae219782d40ce6822b580e608e72fd4c76  jdk-8u31.tar.gz
    2.10  4132cf52d5025bf330d53b96a5c6466fef432377  jdk-8u51.tar.gz
    2.11 @@ -127,6 +128,7 @@
    2.12  7bcb202e13358dd750e964b2f747664428b5d8b3  jedit_build-20180417.tar.gz
    2.13  0bd2bc2d9a491ba5fc8dd99df27c04f11a72e8fa  jfreechart-1.0.14-1.tar.gz
    2.14  8122526f1fc362ddae1a328bdbc2152853186fee  jfreechart-1.0.14.tar.gz
    2.15 +d911f63a5c9b4c7335bb73f805cb1711ce017a84  jfreechart-1.5.0.tar.gz
    2.16  c8a19a36adf6cefa779d85f22ded2f4654e68ea5  jortho-1.0-1.tar.gz
    2.17  2155e0bdbd29cd3d2905454de2e7203b9661d239  jortho-1.0-2.tar.gz
    2.18  ffe179867cf5ffaabbb6bb096db9bdc0d7110065  jortho-1.0.tar.gz
    2.19 @@ -175,6 +177,7 @@
    2.20  a619177143fea42a464f49bb864665407c07a16c  polyml-test-fb4f42af00fa.tar.gz
    2.21  53123dc011b2d4b4e8fe307f3c9fa355718ad01a  postgresql-42.1.1.tar.gz
    2.22  3a5d31377ec07a5069957f5477a4848cfc89a594  postgresql-42.1.4.tar.gz
    2.23 +e7cd5c7955e9eb5ce8cd07feb97230b23d2eec40  postgresql-42.2.2.tar.gz
    2.24  f132329ca1045858ef456cc08b197c9eeea6881b  postgresql-9.4.1212.tar.gz
    2.25  8ee375cfc38972f080dbc78f07b68dac03efe968  ProofGeneral-3.7.1.1.tar.gz
    2.26  847b52c0676b5eb0fbf0476f64fc08c2d72afd0c  ProofGeneral-4.1.tar.gz
     3.1 --- a/Admin/components/main	Wed May 02 13:49:38 2018 +0200
     3.2 +++ b/Admin/components/main	Thu May 03 15:07:14 2018 +0200
     3.3 @@ -5,14 +5,14 @@
     3.4  cvc4-1.5-3
     3.5  e-2.0-1
     3.6  isabelle_fonts-20180113
     3.7 -jdk-8u162
     3.8 +jdk-8u172
     3.9  jedit_build-20180417
    3.10 -jfreechart-1.0.14-1
    3.11 +jfreechart-1.5.0
    3.12  jortho-1.0-2
    3.13  kodkodi-1.5.2
    3.14  nunchaku-0.5
    3.15  polyml-5.7.1-5
    3.16 -postgresql-42.1.4
    3.17 +postgresql-42.2.2
    3.18  scala-2.12.5
    3.19  smbc-0.4.1
    3.20  ssh-java-20161009
     4.1 --- a/CONTRIBUTORS	Wed May 02 13:49:38 2018 +0200
     4.2 +++ b/CONTRIBUTORS	Thu May 03 15:07:14 2018 +0200
     4.3 @@ -6,14 +6,16 @@
     4.4  Contributions to this Isabelle version
     4.5  --------------------------------------
     4.6  
     4.7 -* April 2018: Jose Divasón (Universidad de la Rioja),
     4.8 +* May 2018: Jose Divasón (Universidad de la Rioja),
     4.9    Jesús Aransay (Universidad de la Rioja), Johannes Hölzl (VU Amsterdam),
    4.10    Fabian Immler (TUM)
    4.11    Generalizations in the formalization of linear algebra.
    4.12  
    4.13 +* May 2018: Florian Haftmann
    4.14 +  Consolidation of string-like types in HOL.
    4.15  
    4.16  * March 2018: Florian Haftmann
    4.17 -  Abstract bit operations push_bit, push_take, push_drop, alongside
    4.18 +  Abstract bit operations push_bit, take_bit, drop_bit, alongside
    4.19    with an algebraic foundation for bit strings and word types in
    4.20    HOL-ex.
    4.21  
     5.1 --- a/NEWS	Wed May 02 13:49:38 2018 +0200
     5.2 +++ b/NEWS	Thu May 03 15:07:14 2018 +0200
     5.3 @@ -110,7 +110,8 @@
     5.4  notably bibtex database files and ML files.
     5.5  
     5.6  * Action "isabelle.draft" is similar to "isabelle.preview", but shows a
     5.7 -plain-text document draft.
     5.8 +plain-text document draft. Both are available via the menu "Plugins /
     5.9 +Isabelle".
    5.10  
    5.11  * When loading text files, the Isabelle symbols encoding UTF-8-Isabelle
    5.12  is only used if there is no conflict with existing Unicode sequences in
    5.13 @@ -196,8 +197,38 @@
    5.14  
    5.15  *** HOL ***
    5.16  
    5.17 -* Abstract bit operations as part of Main: push_bit, push_take,
    5.18 -push_drop.
    5.19 +* Clarified relationship of characters, strings and code generation:
    5.20 +
    5.21 +  * Type "char" is now a proper datatype of 8-bit values.
    5.22 +
    5.23 +  * Conversions "nat_of_char" and "char_of_nat" are gone; use more
    5.24 +    general conversions "of_char" and "char_of" with suitable
    5.25 +    type constraints instead.
    5.26 +
    5.27 +  * The zero character is just written "CHR 0x00", not
    5.28 +    "0" any longer.
    5.29 +
    5.30 +  * Type "String.literal" (for code generation) is now isomorphic
    5.31 +    to lists of 7-bit (ASCII) values; concrete values can be written
    5.32 +    as "STR ''...''" for sequences of printable characters and
    5.33 +    "STR 0x..." for one single ASCII code point given
    5.34 +    as hexadecimal numeral.
    5.35 +
    5.36 +  * Type "String.literal" supports concatenation "... + ..."
    5.37 +    for all standard target languages.
    5.38 +
    5.39 +  * Theory Library/Code_Char is gone; study the explanations concerning
    5.40 +    "String.literal" in the tutorial on code generation to get an idea
    5.41 +    how target-language string literals can be converted to HOL string
    5.42 +    values and vice versa.
    5.43 +
    5.44 +  * Imperative-HOL: operation "raise" directly takes a value of type
    5.45 +    "String.literal" as argument, not type "string".
    5.46 +
    5.47 +INCOMPATIBILITY.
    5.48 +
    5.49 +* Abstract bit operations as part of Main: push_bit, take_bit,
    5.50 +drop_bit.
    5.51  
    5.52  * New, more general, axiomatization of complete_distrib_lattice. 
    5.53  The former axioms:
    5.54 @@ -317,6 +348,20 @@
    5.55  been renamed to ISABELLE_TOOL_JAVA_OPTIONS and JEDIT_JAVA_OPTIONS,
    5.56  instead of former 32/64 variants. INCOMPATIBILITY.
    5.57  
    5.58 +* Old settings ISABELLE_PLATFORM and ISABELLE_WINDOWS_PLATFORM should be
    5.59 +phased out due to unclear preference of 32bit vs. 64bit architecture.
    5.60 +Explicit GNU bash expressions are now preferred, for example (with
    5.61 +quotes):
    5.62 +
    5.63 +  #Posix executables (Unix or Cygwin), with preference for 64bit
    5.64 +  "${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}"
    5.65 +
    5.66 +  #native Windows or Unix executables, with preference for 64bit
    5.67 +  "${ISABELLE_WINDOWS_PLATFORM64:-${ISABELLE_WINDOWS_PLATFORM32:-${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}}}"
    5.68 +
    5.69 +  #native Windows (32bit) or Unix executables (preference for 64bit)
    5.70 +  "${ISABELLE_WINDOWS_PLATFORM32:-${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}}"
    5.71 +
    5.72  * Command-line tool "isabelle build" supports new options:
    5.73    - option -B NAME: include session NAME and all descendants
    5.74    - option -S: only observe changes of sources, not heap images
     6.1 --- a/lib/browser/build	Wed May 02 13:49:38 2018 +0200
     6.2 +++ b/lib/browser/build	Thu May 03 15:07:14 2018 +0200
     6.3 @@ -63,7 +63,7 @@
     6.4  
     6.5    rm -rf classes && mkdir classes
     6.6  
     6.7 -  isabelle_jdk javac -d classes -source 1.4 "${SOURCES[@]}" || \
     6.8 +  isabelle_jdk javac -d classes -source 1.6 "${SOURCES[@]}" || \
     6.9      fail "Failed to compile sources"
    6.10    isabelle_jdk jar cf "$(platform_path "$TARGET")" -C classes . ||
    6.11      fail "Failed to produce $TARGET"
     7.1 --- a/lib/scripts/getsettings	Wed May 02 13:49:38 2018 +0200
     7.2 +++ b/lib/scripts/getsettings	Thu May 03 15:07:14 2018 +0200
     7.3 @@ -102,7 +102,12 @@
     7.4  ISABELLE_OUTPUT="$ISABELLE_OUTPUT/$ML_IDENTIFIER"
     7.5  
     7.6  #enforce JAVA_HOME
     7.7 -export JAVA_HOME="$ISABELLE_JDK_HOME/jre"
     7.8 +if [ -d "$ISABELLE_JDK_HOME/jre" ]
     7.9 +then
    7.10 +  export JAVA_HOME="$ISABELLE_JDK_HOME/jre"
    7.11 +else
    7.12 +  export JAVA_HOME="$ISABELLE_JDK_HOME"
    7.13 +fi
    7.14  
    7.15  set +o allexport
    7.16  
     8.1 --- a/src/Doc/Codegen/Adaptation.thy	Wed May 02 13:49:38 2018 +0200
     8.2 +++ b/src/Doc/Codegen/Adaptation.thy	Thu May 03 15:07:14 2018 +0200
     8.3 @@ -168,6 +168,35 @@
     8.4         Useful for code setups which involve e.g.~indexing
     8.5         of target-language arrays.  Part of @{text "HOL-Main"}.
     8.6  
     8.7 +    \item[@{theory "String"}] provides an additional datatype @{typ
     8.8 +       String.literal} which is isomorphic to lists of 7-bit (ASCII) characters;
     8.9 +       @{typ String.literal}s are mapped to target-language strings.
    8.10 +
    8.11 +       Literal values of type @{typ String.literal} can be written
    8.12 +       as @{text "STR ''\<dots>''"} for sequences of printable characters and
    8.13 +       @{text "STR 0x\<dots>"} for one single ASCII code point given
    8.14 +       as hexadecimal numeral; @{typ String.literal} supports concatenation
    8.15 +       @{text "\<dots> + \<dots>"} for all standard target languages.
    8.16 +
    8.17 +       Note that the particular notion of \qt{string} is target-language
    8.18 +       specific (sequence of 8-bit units, sequence of unicode code points, \ldots);
    8.19 +       hence ASCII is the only reliable common base e.g.~for
    8.20 +       printing (error) messages; more sophisticated applications
    8.21 +       like verifying parsing algorithms require a dedicated
    8.22 +       target-language specific model.
    8.23 +
    8.24 +       Nevertheless @{typ String.literal}s can be analyzed; the core operations
    8.25 +       for this are @{term_type String.asciis_of_literal} and
    8.26 +       @{term_type String.literal_of_asciis} which are implemented
    8.27 +       in a target-language-specific way; particularly @{const String.asciis_of_literal}
    8.28 +       checks its argument at runtime to make sure that it does
    8.29 +       not contain non-ASCII-characters, to safeguard consistency.
    8.30 +       On top of these, more abstract conversions like @{term_type
    8.31 +       String.explode} and @{term_type String.implode}
    8.32 +       are implemented.
    8.33 +       
    8.34 +       Part of @{text "HOL-Main"}.
    8.35 +
    8.36      \item[@{text "Code_Target_Int"}] implements type @{typ int}
    8.37         by @{typ integer} and thus by target-language built-in integers.
    8.38  
    8.39 @@ -186,17 +215,6 @@
    8.40         containing both @{text "Code_Target_Nat"} and
    8.41         @{text "Code_Target_Int"}.
    8.42  
    8.43 -    \item[@{theory "String"}] provides an additional datatype @{typ
    8.44 -       String.literal} which is isomorphic to strings; @{typ
    8.45 -       String.literal}s are mapped to target-language strings.  Useful
    8.46 -       for code setups which involve e.g.~printing (error) messages.
    8.47 -       Part of @{text "HOL-Main"}.
    8.48 -
    8.49 -    \item[@{text "Code_Char"}] represents @{text HOL} characters by
    8.50 -       character literals in target languages.  \emph{Warning:} This
    8.51 -       modifies adaptation in a non-conservative manner and thus
    8.52 -       should always be imported \emph{last} in a theory header.
    8.53 -
    8.54      \item[@{theory "IArray"}] provides a type @{typ "'a iarray"}
    8.55         isomorphic to lists but implemented by (effectively immutable)
    8.56         arrays \emph{in SML only}.
     9.1 --- a/src/Doc/Codegen/Computations.thy	Wed May 02 13:49:38 2018 +0200
     9.2 +++ b/src/Doc/Codegen/Computations.thy	Thu May 03 15:07:14 2018 +0200
     9.3 @@ -472,20 +472,20 @@
     9.4    check_int @{context} @{cprop "even ((0::int) + 1 + 2 + 3 + -1 + -2 + -3)"}
     9.5  \<close>
     9.6    
     9.7 -paragraph \<open>An example for @{typ char}\<close>
     9.8 +paragraph \<open>An example for @{typ String.literal}\<close>
     9.9  
    9.10 -definition %quote is_cap_letter :: "char \<Rightarrow> bool"
    9.11 -  where "is_cap_letter c \<longleftrightarrow> (let n = nat_of_char c in 65 \<le> n \<and> n \<le> 90)" (*<*)
    9.12 +definition %quote is_cap_letter :: "String.literal \<Rightarrow> bool"
    9.13 +  where "is_cap_letter s \<longleftrightarrow> (case String.asciis_of_literal s
    9.14 +    of [] \<Rightarrow> False | k # _ \<Rightarrow> 65 \<le> k \<and> k \<le> 90)" (*<*)
    9.15  
    9.16  (*>*) ML %quotetypewriter \<open>
    9.17 -  val check_char = @{computation_check terms:
    9.18 -    Trueprop is_cap_letter
    9.19 -    Char datatypes: num
    9.20 +  val check_literal = @{computation_check terms:
    9.21 +    Trueprop is_cap_letter datatypes: bool String.literal
    9.22    }
    9.23  \<close>
    9.24  
    9.25  ML_val %quotetypewriter \<open>
    9.26 -  check_char @{context} @{cprop "is_cap_letter (CHR ''Y'')"}
    9.27 +  check_literal @{context} @{cprop "is_cap_letter (STR ''Q'')"}
    9.28  \<close>
    9.29  
    9.30    
    10.1 --- a/src/Doc/JEdit/JEdit.thy	Wed May 02 13:49:38 2018 +0200
    10.2 +++ b/src/Doc/JEdit/JEdit.thy	Thu May 03 15:07:14 2018 +0200
    10.3 @@ -73,9 +73,9 @@
    10.4    Isabelle/jEdit (\figref{fig:isabelle-jedit}) consists of some plugins for
    10.5    the jEdit text editor, while preserving its general look-and-feel as far as
    10.6    possible. The main plugin is called ``Isabelle'' and has its own menu
    10.7 -  \<^emph>\<open>Plugins~/ Isabelle\<close> with access to several panels (see also
    10.8 -  \secref{sec:dockables}), as well as \<^emph>\<open>Plugins~/ Plugin Options~/ Isabelle\<close>
    10.9 -  (see also \secref{sec:options}).
   10.10 +  \<^emph>\<open>Plugins~/ Isabelle\<close> with access to several actions and add-on panels (see
   10.11 +  also \secref{sec:dockables}), as well as \<^emph>\<open>Plugins~/ Plugin Options~/
   10.12 +  Isabelle\<close> (see also \secref{sec:options}).
   10.13  
   10.14    The options allow to specify a logic session name, but the same selector is
   10.15    also accessible in the \<^emph>\<open>Theories\<close> panel (\secref{sec:theories}). After
   10.16 @@ -1154,7 +1154,7 @@
   10.17  text \<open>
   10.18    The \<^emph>\<open>Query\<close> panel in \<^emph>\<open>Find Theorems\<close> mode retrieves facts from the theory
   10.19    or proof context matching all of given criteria in the \<^emph>\<open>Find\<close> text field. A
   10.20 -  single criterium has the following syntax:
   10.21 +  single criterion has the following syntax:
   10.22  
   10.23    @{rail \<open>
   10.24      ('-'?) ('name' ':' @{syntax name} | 'intro' | 'elim' | 'dest' |
   10.25 @@ -1171,7 +1171,7 @@
   10.26  text \<open>
   10.27    The \<^emph>\<open>Query\<close> panel in \<^emph>\<open>Find Constants\<close> mode prints all constants whose type
   10.28    meets all of the given criteria in the \<^emph>\<open>Find\<close> text field. A single
   10.29 -  criterium has the following syntax:
   10.30 +  criterion has the following syntax:
   10.31  
   10.32    @{rail \<open>
   10.33      ('-'?)
    11.1 --- a/src/Doc/System/Environment.thy	Wed May 02 13:49:38 2018 +0200
    11.2 +++ b/src/Doc/System/Environment.thy	Thu May 03 15:07:14 2018 +0200
    11.3 @@ -118,38 +118,37 @@
    11.4    \<^descr>[@{setting_def ISABELLE_PLATFORM_FAMILY}\<open>\<^sup>*\<close>] is automatically set to the
    11.5    general platform family: \<^verbatim>\<open>linux\<close>, \<^verbatim>\<open>macos\<close>, \<^verbatim>\<open>windows\<close>. Note that
    11.6    platform-dependent tools usually need to refer to the more specific
    11.7 -  identification according to @{setting ISABELLE_PLATFORM} etc.
    11.8 +  identification according to @{setting ISABELLE_PLATFORM64}, @{setting
    11.9 +  ISABELLE_PLATFORM32}, @{setting ISABELLE_WINDOWS_PLATFORM64}, @{setting
   11.10 +  ISABELLE_WINDOWS_PLATFORM32}.
   11.11  
   11.12 -  \<^descr>[@{setting_def ISABELLE_PLATFORM32}\<open>\<^sup>*\<close>, @{setting_def
   11.13 -  ISABELLE_PLATFORM64}\<open>\<^sup>*\<close>, @{setting_def ISABELLE_PLATFORM}\<open>\<^sup>*\<close>] indicate the
   11.14 -  standard Posix platform: \<^verbatim>\<open>x86\<close> for 32 bit and \<^verbatim>\<open>x86_64\<close> for 64 bit,
   11.15 -  together with a symbolic name for the operating system (\<^verbatim>\<open>linux\<close>, \<^verbatim>\<open>darwin\<close>,
   11.16 -  \<^verbatim>\<open>cygwin\<close>). Some platforms support both 32 bit and 64 bit executables, but
   11.17 -  this depends on various side-conditions.
   11.18 +  \<^descr>[@{setting_def ISABELLE_PLATFORM64}\<open>\<^sup>*\<close>, @{setting_def
   11.19 +  ISABELLE_PLATFORM32}\<open>\<^sup>*\<close>] indicate the standard Posix platform: \<^verbatim>\<open>x86_64\<close>
   11.20 +  for 64 bit and \<^verbatim>\<open>x86\<close> for 32 bit, together with a symbolic name for the
   11.21 +  operating system (\<^verbatim>\<open>linux\<close>, \<^verbatim>\<open>darwin\<close>, \<^verbatim>\<open>cygwin\<close>). All platforms support 64
   11.22 +  bit executables, some platforms also support 32 bit executables.
   11.23  
   11.24 -  In GNU bash scripts, it is possible to use the following expressions
   11.25 -  (including the quotes) to specify a preference of 64 bit over 32 bit:
   11.26 +  In GNU bash scripts, it is possible to use the following expressions (with
   11.27 +  quotes) to specify a preference of 64 bit over 32 bit:
   11.28  
   11.29    @{verbatim [display] \<open>"${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}"\<close>}
   11.30  
   11.31 -  In contrast, the subsequent expression prefers the 32 bit variant; this is
   11.32 -  how @{setting ISABELLE_PLATFORM} is defined:
   11.33 +  In contrast, the subsequent expression prefers the old 32 bit variant (which
   11.34 +  is only relevant for unusual applications):
   11.35  
   11.36    @{verbatim [display] \<open>"${ISABELLE_PLATFORM32:-$ISABELLE_PLATFORM64}"\<close>}
   11.37  
   11.38 -  \<^descr>[@{setting_def ISABELLE_WINDOWS_PLATFORM32}\<open>\<^sup>*\<close>, @{setting_def
   11.39 -  ISABELLE_WINDOWS_PLATFORM64}\<open>\<^sup>*\<close>,] @{setting_def
   11.40 -  ISABELLE_WINDOWS_PLATFORM}\<open>\<^sup>*\<close> indicate the native Windows platform. These
   11.41 -  settings are analogous (but independent) of those for the standard Posix
   11.42 -  subsystem: @{setting ISABELLE_PLATFORM32}, @{setting ISABELLE_PLATFORM64},
   11.43 -  @{setting ISABELLE_PLATFORM}.
   11.44 +  \<^descr>[@{setting_def ISABELLE_WINDOWS_PLATFORM64}\<open>\<^sup>*\<close>, @{setting_def
   11.45 +  ISABELLE_WINDOWS_PLATFORM32}\<open>\<^sup>*\<close>] indicate the native Windows platform.
   11.46 +  These settings are analogous (but independent) of those for the standard
   11.47 +  Posix subsystem: @{setting ISABELLE_PLATFORM64}, @{setting
   11.48 +  ISABELLE_PLATFORM32}.
   11.49  
   11.50    In GNU bash scripts, a preference for native Windows platform variants may
   11.51 -  be specified like this:
   11.52 +  be specified like this (first 64 bit, second 32 bit):
   11.53  
   11.54 -  @{verbatim [display] \<open>"${ISABELLE_WINDOWS_PLATFORM:-$ISABELLE_PLATFORM}"\<close>}
   11.55 -
   11.56 -  @{verbatim [display] \<open>"${ISABELLE_WINDOWS_PLATFORM64:-${ISABELLE_WINDOWS_PLATFORM32:-${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}}}"\<close>}
   11.57 +  @{verbatim [display] \<open>"${ISABELLE_WINDOWS_PLATFORM64:-${ISABELLE_WINDOWS_PLATFORM32:-
   11.58 +  ${ISABELLE_PLATFORM64:-$ISABELLE_PLATFORM32}}}"\<close>}
   11.59  
   11.60    \<^descr>[@{setting ISABELLE_TOOL}\<open>\<^sup>*\<close>] is automatically set to the full path name
   11.61    of the @{executable isabelle} executable.
    12.1 --- a/src/HOL/Algebra/Divisibility.thy	Wed May 02 13:49:38 2018 +0200
    12.2 +++ b/src/HOL/Algebra/Divisibility.thy	Thu May 03 15:07:14 2018 +0200
    12.3 @@ -2491,11 +2491,7 @@
    12.4    have "a' \<in> carrier G \<and> a' gcdof b c"
    12.5      apply (simp add: gcdof_greatestLower carr')
    12.6      apply (subst greatest_Lower_cong_l[of _ a])
    12.7 -        apply (simp add: a'a)
    12.8 -       apply (simp add: carr)
    12.9 -      apply (simp add: carr)
   12.10 -     apply (simp add: carr)
   12.11 -    apply (simp add: gcdof_greatestLower[symmetric] agcd carr)
   12.12 +        apply (simp_all add: a'a carr gcdof_greatestLower[symmetric] agcd)
   12.13      done
   12.14    then show ?thesis ..
   12.15  qed
    13.1 --- a/src/HOL/Algebra/Order.thy	Wed May 02 13:49:38 2018 +0200
    13.2 +++ b/src/HOL/Algebra/Order.thy	Thu May 03 15:07:14 2018 +0200
    13.3 @@ -30,34 +30,33 @@
    13.4  
    13.5  locale weak_partial_order = equivalence L for L (structure) +
    13.6    assumes le_refl [intro, simp]:
    13.7 -      "x \<in> carrier L ==> x \<sqsubseteq> x"
    13.8 +      "x \<in> carrier L \<Longrightarrow> x \<sqsubseteq> x"
    13.9      and weak_le_antisym [intro]:
   13.10 -      "[| x \<sqsubseteq> y; y \<sqsubseteq> x; x \<in> carrier L; y \<in> carrier L |] ==> x .= y"
   13.11 +      "\<lbrakk>x \<sqsubseteq> y; y \<sqsubseteq> x; x \<in> carrier L; y \<in> carrier L\<rbrakk> \<Longrightarrow> x .= y"
   13.12      and le_trans [trans]:
   13.13 -      "[| x \<sqsubseteq> y; y \<sqsubseteq> z; x \<in> carrier L; y \<in> carrier L; z \<in> carrier L |] ==> x \<sqsubseteq> z"
   13.14 +      "\<lbrakk>x \<sqsubseteq> y; y \<sqsubseteq> z; x \<in> carrier L; y \<in> carrier L; z \<in> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> z"
   13.15      and le_cong:
   13.16 -      "\<lbrakk> x .= y; z .= w; x \<in> carrier L; y \<in> carrier L; z \<in> carrier L; w \<in> carrier L \<rbrakk> \<Longrightarrow>
   13.17 +      "\<lbrakk>x .= y; z .= w; x \<in> carrier L; y \<in> carrier L; z \<in> carrier L; w \<in> carrier L\<rbrakk> \<Longrightarrow>
   13.18        x \<sqsubseteq> z \<longleftrightarrow> y \<sqsubseteq> w"
   13.19  
   13.20  definition
   13.21    lless :: "[_, 'a, 'a] => bool" (infixl "\<sqsubset>\<index>" 50)
   13.22    where "x \<sqsubset>\<^bsub>L\<^esub> y \<longleftrightarrow> x \<sqsubseteq>\<^bsub>L\<^esub> y \<and> x .\<noteq>\<^bsub>L\<^esub> y"
   13.23  
   13.24 -
   13.25  subsubsection \<open>The order relation\<close>
   13.26  
   13.27  context weak_partial_order
   13.28  begin
   13.29  
   13.30  lemma le_cong_l [intro, trans]:
   13.31 -  "\<lbrakk> x .= y; y \<sqsubseteq> z; x \<in> carrier L; y \<in> carrier L; z \<in> carrier L \<rbrakk> \<Longrightarrow> x \<sqsubseteq> z"
   13.32 +  "\<lbrakk>x .= y; y \<sqsubseteq> z; x \<in> carrier L; y \<in> carrier L; z \<in> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> z"
   13.33    by (auto intro: le_cong [THEN iffD2])
   13.34  
   13.35  lemma le_cong_r [intro, trans]:
   13.36 -  "\<lbrakk> x \<sqsubseteq> y; y .= z; x \<in> carrier L; y \<in> carrier L; z \<in> carrier L \<rbrakk> \<Longrightarrow> x \<sqsubseteq> z"
   13.37 +  "\<lbrakk>x \<sqsubseteq> y; y .= z; x \<in> carrier L; y \<in> carrier L; z \<in> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> z"
   13.38    by (auto intro: le_cong [THEN iffD1])
   13.39  
   13.40 -lemma weak_refl [intro, simp]: "\<lbrakk> x .= y; x \<in> carrier L; y \<in> carrier L \<rbrakk> \<Longrightarrow> x \<sqsubseteq> y"
   13.41 +lemma weak_refl [intro, simp]: "\<lbrakk>x .= y; x \<in> carrier L; y \<in> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> y"
   13.42    by (simp add: le_cong_l)
   13.43  
   13.44  end
   13.45 @@ -142,93 +141,86 @@
   13.46    Lower :: "[_, 'a set] => 'a set"
   13.47    where "Lower L A = {l. (\<forall>x. x \<in> A \<inter> carrier L \<longrightarrow> l \<sqsubseteq>\<^bsub>L\<^esub> x)} \<inter> carrier L"
   13.48  
   13.49 -lemma Upper_closed [intro!, simp]:
   13.50 +lemma Lower_dual [simp]:
   13.51 +  "Lower (inv_gorder L) A = Upper L A"
   13.52 +  by (simp add:Upper_def Lower_def)
   13.53 +
   13.54 +lemma Upper_dual [simp]:
   13.55 +  "Upper (inv_gorder L) A = Lower L A"
   13.56 +  by (simp add:Upper_def Lower_def)
   13.57 +
   13.58 +lemma (in weak_partial_order) equivalence_dual: "equivalence (inv_gorder L)"
   13.59 +  by (rule equivalence.intro) (auto simp: intro: sym trans)
   13.60 +
   13.61 +lemma  (in weak_partial_order) dual_weak_order: "weak_partial_order (inv_gorder L)"
   13.62 +  by intro_locales (auto simp add: weak_partial_order_axioms_def le_cong intro: equivalence_dual le_trans)
   13.63 +
   13.64 +lemma (in weak_partial_order) dual_eq_iff [simp]: "A {.=}\<^bsub>inv_gorder L\<^esub> A' \<longleftrightarrow> A {.=} A'"
   13.65 +  by (auto simp: set_eq_def elem_def)
   13.66 +
   13.67 +lemma dual_weak_order_iff:
   13.68 +  "weak_partial_order (inv_gorder A) \<longleftrightarrow> weak_partial_order A"
   13.69 +proof
   13.70 +  assume "weak_partial_order (inv_gorder A)"
   13.71 +  then interpret dpo: weak_partial_order "inv_gorder A"
   13.72 +  rewrites "carrier (inv_gorder A) = carrier A"
   13.73 +  and   "le (inv_gorder A)      = (\<lambda> x y. le A y x)"
   13.74 +  and   "eq (inv_gorder A)      = eq A"
   13.75 +    by (simp_all)
   13.76 +  show "weak_partial_order A"
   13.77 +    by (unfold_locales, auto intro: dpo.sym dpo.trans dpo.le_trans)
   13.78 +next
   13.79 +  assume "weak_partial_order A"
   13.80 +  thus "weak_partial_order (inv_gorder A)"
   13.81 +    by (metis weak_partial_order.dual_weak_order)
   13.82 +qed
   13.83 +
   13.84 +lemma Upper_closed [iff]:
   13.85    "Upper L A \<subseteq> carrier L"
   13.86    by (unfold Upper_def) clarify
   13.87  
   13.88  lemma Upper_memD [dest]:
   13.89    fixes L (structure)
   13.90 -  shows "[| u \<in> Upper L A; x \<in> A; A \<subseteq> carrier L |] ==> x \<sqsubseteq> u \<and> u \<in> carrier L"
   13.91 +  shows "\<lbrakk>u \<in> Upper L A; x \<in> A; A \<subseteq> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> u \<and> u \<in> carrier L"
   13.92    by (unfold Upper_def) blast
   13.93  
   13.94  lemma (in weak_partial_order) Upper_elemD [dest]:
   13.95 -  "[| u .\<in> Upper L A; u \<in> carrier L; x \<in> A; A \<subseteq> carrier L |] ==> x \<sqsubseteq> u"
   13.96 +  "\<lbrakk>u .\<in> Upper L A; u \<in> carrier L; x \<in> A; A \<subseteq> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> u"
   13.97    unfolding Upper_def elem_def
   13.98    by (blast dest: sym)
   13.99  
  13.100  lemma Upper_memI:
  13.101    fixes L (structure)
  13.102 -  shows "[| !! y. y \<in> A ==> y \<sqsubseteq> x; x \<in> carrier L |] ==> x \<in> Upper L A"
  13.103 +  shows "\<lbrakk>!! y. y \<in> A \<Longrightarrow> y \<sqsubseteq> x; x \<in> carrier L\<rbrakk> \<Longrightarrow> x \<in> Upper L A"
  13.104    by (unfold Upper_def) blast
  13.105  
  13.106  lemma (in weak_partial_order) Upper_elemI:
  13.107 -  "[| !! y. y \<in> A ==> y \<sqsubseteq> x; x \<in> carrier L |] ==> x .\<in> Upper L A"
  13.108 +  "\<lbrakk>!! y. y \<in> A \<Longrightarrow> y \<sqsubseteq> x; x \<in> carrier L\<rbrakk> \<Longrightarrow> x .\<in> Upper L A"
  13.109    unfolding Upper_def by blast
  13.110  
  13.111  lemma Upper_antimono:
  13.112 -  "A \<subseteq> B ==> Upper L B \<subseteq> Upper L A"
  13.113 +  "A \<subseteq> B \<Longrightarrow> Upper L B \<subseteq> Upper L A"
  13.114    by (unfold Upper_def) blast
  13.115  
  13.116  lemma (in weak_partial_order) Upper_is_closed [simp]:
  13.117 -  "A \<subseteq> carrier L ==> is_closed (Upper L A)"
  13.118 +  "A \<subseteq> carrier L \<Longrightarrow> is_closed (Upper L A)"
  13.119    by (rule is_closedI) (blast intro: Upper_memI)+
  13.120  
  13.121  lemma (in weak_partial_order) Upper_mem_cong:
  13.122 -  assumes a'carr: "a' \<in> carrier L" and Acarr: "A \<subseteq> carrier L"
  13.123 -    and aa': "a .= a'"
  13.124 -    and aelem: "a \<in> Upper L A"
  13.125 +  assumes  "a' \<in> carrier L" "A \<subseteq> carrier L" "a .= a'" "a \<in> Upper L A"
  13.126    shows "a' \<in> Upper L A"
  13.127 -proof (rule Upper_memI[OF _ a'carr])
  13.128 -  fix y
  13.129 -  assume yA: "y \<in> A"
  13.130 -  hence "y \<sqsubseteq> a" by (intro Upper_memD[OF aelem, THEN conjunct1] Acarr)
  13.131 -  also note aa'
  13.132 -  finally
  13.133 -      show "y \<sqsubseteq> a'"
  13.134 -      by (simp add: a'carr subsetD[OF Acarr yA] subsetD[OF Upper_closed aelem])
  13.135 -qed
  13.136 +  by (metis assms Upper_closed Upper_is_closed closure_of_eq complete_classes)
  13.137 +
  13.138 +lemma (in weak_partial_order) Upper_semi_cong:
  13.139 +  assumes "A \<subseteq> carrier L" "A {.=} A'"
  13.140 +  shows "Upper L A \<subseteq> Upper L A'"
  13.141 +  unfolding Upper_def
  13.142 +   by clarsimp (meson assms equivalence.refl equivalence_axioms le_cong set_eqD2 subset_eq)
  13.143  
  13.144  lemma (in weak_partial_order) Upper_cong:
  13.145 -  assumes Acarr: "A \<subseteq> carrier L" and A'carr: "A' \<subseteq> carrier L"
  13.146 -    and AA': "A {.=} A'"
  13.147 +  assumes "A \<subseteq> carrier L" "A' \<subseteq> carrier L" "A {.=} A'"
  13.148    shows "Upper L A = Upper L A'"
  13.149 -unfolding Upper_def
  13.150 -apply rule
  13.151 - apply (rule, clarsimp) defer 1
  13.152 - apply (rule, clarsimp) defer 1
  13.153 -proof -
  13.154 -  fix x a'
  13.155 -  assume carr: "x \<in> carrier L" "a' \<in> carrier L"
  13.156 -    and a'A': "a' \<in> A'"
  13.157 -  assume aLxCond[rule_format]: "\<forall>a. a \<in> A \<and> a \<in> carrier L \<longrightarrow> a \<sqsubseteq> x"
  13.158 -
  13.159 -  from AA' and a'A' have "\<exists>a\<in>A. a' .= a" by (rule set_eqD2)
  13.160 -  from this obtain a
  13.161 -      where aA: "a \<in> A"
  13.162 -      and a'a: "a' .= a"
  13.163 -      by auto
  13.164 -  note [simp] = subsetD[OF Acarr aA] carr
  13.165 -
  13.166 -  note a'a
  13.167 -  also have "a \<sqsubseteq> x" by (simp add: aLxCond aA)
  13.168 -  finally show "a' \<sqsubseteq> x" by simp
  13.169 -next
  13.170 -  fix x a
  13.171 -  assume carr: "x \<in> carrier L" "a \<in> carrier L"
  13.172 -    and aA: "a \<in> A"
  13.173 -  assume a'LxCond[rule_format]: "\<forall>a'. a' \<in> A' \<and> a' \<in> carrier L \<longrightarrow> a' \<sqsubseteq> x"
  13.174 -
  13.175 -  from AA' and aA have "\<exists>a'\<in>A'. a .= a'" by (rule set_eqD1)
  13.176 -  from this obtain a'
  13.177 -      where a'A': "a' \<in> A'"
  13.178 -      and aa': "a .= a'"
  13.179 -      by auto
  13.180 -  note [simp] = subsetD[OF A'carr a'A'] carr
  13.181 -
  13.182 -  note aa'
  13.183 -  also have "a' \<sqsubseteq> x" by (simp add: a'LxCond a'A')
  13.184 -  finally show "a \<sqsubseteq> x" by simp
  13.185 -qed
  13.186 +  using assms by (simp add: Upper_semi_cong set_eq_sym subset_antisym)
  13.187  
  13.188  lemma Lower_closed [intro!, simp]:
  13.189    "Lower L A \<subseteq> carrier L"
  13.190 @@ -236,16 +228,16 @@
  13.191  
  13.192  lemma Lower_memD [dest]:
  13.193    fixes L (structure)
  13.194 -  shows "[| l \<in> Lower L A; x \<in> A; A \<subseteq> carrier L |] ==> l \<sqsubseteq> x \<and> l \<in> carrier L"
  13.195 +  shows "\<lbrakk>l \<in> Lower L A; x \<in> A; A \<subseteq> carrier L\<rbrakk> \<Longrightarrow> l \<sqsubseteq> x \<and> l \<in> carrier L"
  13.196    by (unfold Lower_def) blast
  13.197  
  13.198  lemma Lower_memI:
  13.199    fixes L (structure)
  13.200 -  shows "[| !! y. y \<in> A ==> x \<sqsubseteq> y; x \<in> carrier L |] ==> x \<in> Lower L A"
  13.201 +  shows "\<lbrakk>!! y. y \<in> A \<Longrightarrow> x \<sqsubseteq> y; x \<in> carrier L\<rbrakk> \<Longrightarrow> x \<in> Lower L A"
  13.202    by (unfold Lower_def) blast
  13.203  
  13.204  lemma Lower_antimono:
  13.205 -  "A \<subseteq> B ==> Lower L B \<subseteq> Lower L A"
  13.206 +  "A \<subseteq> B \<Longrightarrow> Lower L B \<subseteq> Lower L A"
  13.207    by (unfold Lower_def) blast
  13.208  
  13.209  lemma (in weak_partial_order) Lower_is_closed [simp]:
  13.210 @@ -253,56 +245,15 @@
  13.211    by (rule is_closedI) (blast intro: Lower_memI dest: sym)+
  13.212  
  13.213  lemma (in weak_partial_order) Lower_mem_cong:
  13.214 -  assumes a'carr: "a' \<in> carrier L" and Acarr: "A \<subseteq> carrier L"
  13.215 -    and aa': "a .= a'"
  13.216 -    and aelem: "a \<in> Lower L A"
  13.217 +  assumes "a' \<in> carrier L"  "A \<subseteq> carrier L" "a .= a'" "a \<in> Lower L A"
  13.218    shows "a' \<in> Lower L A"
  13.219 -using assms Lower_closed[of L A]
  13.220 -by (intro Lower_memI) (blast intro: le_cong_l[OF aa'[symmetric]])
  13.221 +  by (meson assms Lower_closed Lower_is_closed is_closed_eq subsetCE)
  13.222  
  13.223  lemma (in weak_partial_order) Lower_cong:
  13.224 -  assumes Acarr: "A \<subseteq> carrier L" and A'carr: "A' \<subseteq> carrier L"
  13.225 -    and AA': "A {.=} A'"
  13.226 +  assumes "A \<subseteq> carrier L" "A' \<subseteq> carrier L" "A {.=} A'"
  13.227    shows "Lower L A = Lower L A'"
  13.228 -unfolding Lower_def
  13.229 -apply rule
  13.230 - apply clarsimp defer 1
  13.231 - apply clarsimp defer 1
  13.232 -proof -
  13.233 -  fix x a'
  13.234 -  assume carr: "x \<in> carrier L" "a' \<in> carrier L"
  13.235 -    and a'A': "a' \<in> A'"
  13.236 -  assume "\<forall>a. a \<in> A \<and> a \<in> carrier L \<longrightarrow> x \<sqsubseteq> a"
  13.237 -  hence aLxCond: "\<And>a. \<lbrakk>a \<in> A; a \<in> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> a" by fast
  13.238 -
  13.239 -  from AA' and a'A' have "\<exists>a\<in>A. a' .= a" by (rule set_eqD2)
  13.240 -  from this obtain a
  13.241 -      where aA: "a \<in> A"
  13.242 -      and a'a: "a' .= a"
  13.243 -      by auto
  13.244 -
  13.245 -  from aA and subsetD[OF Acarr aA]
  13.246 -      have "x \<sqsubseteq> a" by (rule aLxCond)
  13.247 -  also note a'a[symmetric]
  13.248 -  finally
  13.249 -      show "x \<sqsubseteq> a'" by (simp add: carr subsetD[OF Acarr aA])
  13.250 -next
  13.251 -  fix x a
  13.252 -  assume carr: "x \<in> carrier L" "a \<in> carrier L"
  13.253 -    and aA: "a \<in> A"
  13.254 -  assume "\<forall>a'. a' \<in> A' \<and> a' \<in> carrier L \<longrightarrow> x \<sqsubseteq> a'"
  13.255 -  hence a'LxCond: "\<And>a'. \<lbrakk>a' \<in> A'; a' \<in> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> a'" by fast+
  13.256 -
  13.257 -  from AA' and aA have "\<exists>a'\<in>A'. a .= a'" by (rule set_eqD1)
  13.258 -  from this obtain a'
  13.259 -      where a'A': "a' \<in> A'"
  13.260 -      and aa': "a .= a'"
  13.261 -      by auto
  13.262 -  from a'A' and subsetD[OF A'carr a'A']
  13.263 -      have "x \<sqsubseteq> a'" by (rule a'LxCond)
  13.264 -  also note aa'[symmetric]
  13.265 -  finally show "x \<sqsubseteq> a" by (simp add: carr subsetD[OF A'carr a'A'])
  13.266 -qed
  13.267 +  unfolding Upper_dual [symmetric]
  13.268 +  by (rule weak_partial_order.Upper_cong [OF dual_weak_order]) (simp_all add: assms)
  13.269  
  13.270  text \<open>Jacobson: Theorem 8.1\<close>
  13.271  
  13.272 @@ -325,29 +276,37 @@
  13.273    greatest :: "[_, 'a, 'a set] => bool"
  13.274    where "greatest L g A \<longleftrightarrow> A \<subseteq> carrier L \<and> g \<in> A \<and> (\<forall>x\<in>A. x \<sqsubseteq>\<^bsub>L\<^esub> g)"
  13.275  
  13.276 -text (in weak_partial_order) \<open>Could weaken these to @{term "l \<in> carrier L \<and> l
  13.277 -  .\<in> A"} and @{term "g \<in> carrier L \<and> g .\<in> A"}.\<close>
  13.278 +text (in weak_partial_order) \<open>Could weaken these to @{term "l \<in> carrier L \<and> l .\<in> A"} and @{term "g \<in> carrier L \<and> g .\<in> A"}.\<close>
  13.279 +
  13.280 +lemma least_dual [simp]:
  13.281 +  "least (inv_gorder L) x A = greatest L x A"
  13.282 +  by (simp add:least_def greatest_def)
  13.283 +
  13.284 +lemma greatest_dual [simp]:
  13.285 +  "greatest (inv_gorder L) x A = least L x A"
  13.286 +  by (simp add:least_def greatest_def)
  13.287  
  13.288  lemma least_closed [intro, simp]:
  13.289 -  "least L l A ==> l \<in> carrier L"
  13.290 +  "least L l A \<Longrightarrow> l \<in> carrier L"
  13.291    by (unfold least_def) fast
  13.292  
  13.293  lemma least_mem:
  13.294 -  "least L l A ==> l \<in> A"
  13.295 +  "least L l A \<Longrightarrow> l \<in> A"
  13.296    by (unfold least_def) fast
  13.297  
  13.298  lemma (in weak_partial_order) weak_least_unique:
  13.299 -  "[| least L x A; least L y A |] ==> x .= y"
  13.300 +  "\<lbrakk>least L x A; least L y A\<rbrakk> \<Longrightarrow> x .= y"
  13.301    by (unfold least_def) blast
  13.302  
  13.303  lemma least_le:
  13.304    fixes L (structure)
  13.305 -  shows "[| least L x A; a \<in> A |] ==> x \<sqsubseteq> a"
  13.306 +  shows "\<lbrakk>least L x A; a \<in> A\<rbrakk> \<Longrightarrow> x \<sqsubseteq> a"
  13.307    by (unfold least_def) fast
  13.308  
  13.309  lemma (in weak_partial_order) least_cong:
  13.310 -  "[| x .= x'; x \<in> carrier L; x' \<in> carrier L; is_closed A |] ==> least L x A = least L x' A"
  13.311 -  by (unfold least_def) (auto dest: sym)
  13.312 +  "\<lbrakk>x .= x'; x \<in> carrier L; x' \<in> carrier L; is_closed A\<rbrakk> \<Longrightarrow> least L x A = least L x' A"
  13.313 +  unfolding least_def
  13.314 +  by (meson is_closed_eq is_closed_eq_rev le_cong local.refl subset_iff)
  13.315  
  13.316  abbreviation is_lub :: "[_, 'a, 'a set] => bool"
  13.317  where "is_lub L x A \<equiv> least L x (Upper L A)"
  13.318 @@ -363,16 +322,14 @@
  13.319    apply (rule least_cong) using assms by auto
  13.320  
  13.321  lemma (in weak_partial_order) least_Upper_cong_r:
  13.322 -  assumes Acarrs: "A \<subseteq> carrier L" "A' \<subseteq> carrier L" (* unneccessary with current Upper? *)
  13.323 -    and AA': "A {.=} A'"
  13.324 +  assumes "A \<subseteq> carrier L" "A' \<subseteq> carrier L" "A {.=} A'"
  13.325    shows "least L x (Upper L A) = least L x (Upper L A')"
  13.326 -apply (subgoal_tac "Upper L A = Upper L A'", simp)
  13.327 -by (rule Upper_cong) fact+
  13.328 +  using Upper_cong assms by auto
  13.329  
  13.330  lemma least_UpperI:
  13.331    fixes L (structure)
  13.332 -  assumes above: "!! x. x \<in> A ==> x \<sqsubseteq> s"
  13.333 -    and below: "!! y. y \<in> Upper L A ==> s \<sqsubseteq> y"
  13.334 +  assumes above: "!! x. x \<in> A \<Longrightarrow> x \<sqsubseteq> s"
  13.335 +    and below: "!! y. y \<in> Upper L A \<Longrightarrow> s \<sqsubseteq> y"
  13.336      and L: "A \<subseteq> carrier L"  "s \<in> carrier L"
  13.337    shows "least L s (Upper L A)"
  13.338  proof -
  13.339 @@ -384,30 +341,31 @@
  13.340  
  13.341  lemma least_Upper_above:
  13.342    fixes L (structure)
  13.343 -  shows "[| least L s (Upper L A); x \<in> A; A \<subseteq> carrier L |] ==> x \<sqsubseteq> s"
  13.344 +  shows "\<lbrakk>least L s (Upper L A); x \<in> A; A \<subseteq> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> s"
  13.345    by (unfold least_def) blast
  13.346  
  13.347  lemma greatest_closed [intro, simp]:
  13.348 -  "greatest L l A ==> l \<in> carrier L"
  13.349 +  "greatest L l A \<Longrightarrow> l \<in> carrier L"
  13.350    by (unfold greatest_def) fast
  13.351  
  13.352  lemma greatest_mem:
  13.353 -  "greatest L l A ==> l \<in> A"
  13.354 +  "greatest L l A \<Longrightarrow> l \<in> A"
  13.355    by (unfold greatest_def) fast
  13.356  
  13.357  lemma (in weak_partial_order) weak_greatest_unique:
  13.358 -  "[| greatest L x A; greatest L y A |] ==> x .= y"
  13.359 +  "\<lbrakk>greatest L x A; greatest L y A\<rbrakk> \<Longrightarrow> x .= y"
  13.360    by (unfold greatest_def) blast
  13.361  
  13.362  lemma greatest_le:
  13.363    fixes L (structure)
  13.364 -  shows "[| greatest L x A; a \<in> A |] ==> a \<sqsubseteq> x"
  13.365 +  shows "\<lbrakk>greatest L x A; a \<in> A\<rbrakk> \<Longrightarrow> a \<sqsubseteq> x"
  13.366    by (unfold greatest_def) fast
  13.367  
  13.368  lemma (in weak_partial_order) greatest_cong:
  13.369 -  "[| x .= x'; x \<in> carrier L; x' \<in> carrier L; is_closed A |] ==>
  13.370 +  "\<lbrakk>x .= x'; x \<in> carrier L; x' \<in> carrier L; is_closed A\<rbrakk> \<Longrightarrow>
  13.371    greatest L x A = greatest L x' A"
  13.372 -  by (unfold greatest_def) (auto dest: sym)
  13.373 +  unfolding greatest_def
  13.374 +  by (meson is_closed_eq_rev le_cong_r local.sym subset_eq)
  13.375  
  13.376  abbreviation is_glb :: "[_, 'a, 'a set] => bool"
  13.377  where "is_glb L x A \<equiv> greatest L x (Lower L A)"
  13.378 @@ -418,21 +376,23 @@
  13.379  lemma (in weak_partial_order) greatest_Lower_cong_l:
  13.380    assumes "x .= x'"
  13.381      and "x \<in> carrier L" "x' \<in> carrier L"
  13.382 -    and "A \<subseteq> carrier L" (* unneccessary with current Lower *)
  13.383    shows "greatest L x (Lower L A) = greatest L x' (Lower L A)"
  13.384 -  apply (rule greatest_cong) using assms by auto
  13.385 +proof -
  13.386 +  have "\<forall>A. is_closed (Lower L (A \<inter> carrier L))"
  13.387 +    by simp
  13.388 +  then show ?thesis
  13.389 +    by (simp add: Lower_def assms greatest_cong)
  13.390 +qed
  13.391  
  13.392  lemma (in weak_partial_order) greatest_Lower_cong_r:
  13.393 -  assumes Acarrs: "A \<subseteq> carrier L" "A' \<subseteq> carrier L"
  13.394 -    and AA': "A {.=} A'"
  13.395 +  assumes "A \<subseteq> carrier L" "A' \<subseteq> carrier L" "A {.=} A'"
  13.396    shows "greatest L x (Lower L A) = greatest L x (Lower L A')"
  13.397 -apply (subgoal_tac "Lower L A = Lower L A'", simp)
  13.398 -by (rule Lower_cong) fact+
  13.399 +  using Lower_cong assms by auto
  13.400  
  13.401  lemma greatest_LowerI:
  13.402    fixes L (structure)
  13.403 -  assumes below: "!! x. x \<in> A ==> i \<sqsubseteq> x"
  13.404 -    and above: "!! y. y \<in> Lower L A ==> y \<sqsubseteq> i"
  13.405 +  assumes below: "!! x. x \<in> A \<Longrightarrow> i \<sqsubseteq> x"
  13.406 +    and above: "!! y. y \<in> Lower L A \<Longrightarrow> y \<sqsubseteq> i"
  13.407      and L: "A \<subseteq> carrier L"  "i \<in> carrier L"
  13.408    shows "greatest L i (Lower L A)"
  13.409  proof -
  13.410 @@ -444,53 +404,9 @@
  13.411  
  13.412  lemma greatest_Lower_below:
  13.413    fixes L (structure)
  13.414 -  shows "[| greatest L i (Lower L A); x \<in> A; A \<subseteq> carrier L |] ==> i \<sqsubseteq> x"
  13.415 +  shows "\<lbrakk>greatest L i (Lower L A); x \<in> A; A \<subseteq> carrier L\<rbrakk> \<Longrightarrow> i \<sqsubseteq> x"
  13.416    by (unfold greatest_def) blast
  13.417  
  13.418 -lemma Lower_dual [simp]:
  13.419 -  "Lower (inv_gorder L) A = Upper L A"
  13.420 -  by (simp add:Upper_def Lower_def)
  13.421 -
  13.422 -lemma Upper_dual [simp]:
  13.423 -  "Upper (inv_gorder L) A = Lower L A"
  13.424 -  by (simp add:Upper_def Lower_def)
  13.425 -
  13.426 -lemma least_dual [simp]:
  13.427 -  "least (inv_gorder L) x A = greatest L x A"
  13.428 -  by (simp add:least_def greatest_def)
  13.429 -
  13.430 -lemma greatest_dual [simp]:
  13.431 -  "greatest (inv_gorder L) x A = least L x A"
  13.432 -  by (simp add:least_def greatest_def)
  13.433 -
  13.434 -lemma (in weak_partial_order) dual_weak_order:
  13.435 -  "weak_partial_order (inv_gorder L)"
  13.436 -  apply (unfold_locales)
  13.437 -  apply (simp_all)
  13.438 -  apply (metis sym)
  13.439 -  apply (metis trans)
  13.440 -  apply (metis weak_le_antisym)
  13.441 -  apply (metis le_trans)
  13.442 -  apply (metis le_cong_l le_cong_r sym)
  13.443 -done
  13.444 -
  13.445 -lemma dual_weak_order_iff:
  13.446 -  "weak_partial_order (inv_gorder A) \<longleftrightarrow> weak_partial_order A"
  13.447 -proof
  13.448 -  assume "weak_partial_order (inv_gorder A)"
  13.449 -  then interpret dpo: weak_partial_order "inv_gorder A"
  13.450 -  rewrites "carrier (inv_gorder A) = carrier A"
  13.451 -  and   "le (inv_gorder A)      = (\<lambda> x y. le A y x)"
  13.452 -  and   "eq (inv_gorder A)      = eq A"
  13.453 -    by (simp_all)
  13.454 -  show "weak_partial_order A"
  13.455 -    by (unfold_locales, auto intro: dpo.sym dpo.trans dpo.le_trans)
  13.456 -next
  13.457 -  assume "weak_partial_order A"
  13.458 -  thus "weak_partial_order (inv_gorder A)"
  13.459 -    by (metis weak_partial_order.dual_weak_order)
  13.460 -qed
  13.461 -
  13.462  
  13.463  subsubsection \<open>Intervals\<close>
  13.464  
  13.465 @@ -513,7 +429,7 @@
  13.466      by (auto simp add: at_least_at_most_def)
  13.467  
  13.468    lemma at_least_at_most_member [intro]: 
  13.469 -    "\<lbrakk> x \<in> carrier L; a \<sqsubseteq> x; x \<sqsubseteq> b \<rbrakk> \<Longrightarrow> x \<in> \<lbrace>a..b\<rbrace>"
  13.470 +    "\<lbrakk>x \<in> carrier L; a \<sqsubseteq> x; x \<sqsubseteq> b\<rbrakk> \<Longrightarrow> x \<in> \<lbrace>a..b\<rbrace>"
  13.471      by (simp add: at_least_at_most_def)
  13.472  
  13.473  end
  13.474 @@ -531,7 +447,7 @@
  13.475    fixes f :: "'a \<Rightarrow> 'b"
  13.476    assumes "weak_partial_order L1"
  13.477            "weak_partial_order L2"
  13.478 -          "(\<And>x y. \<lbrakk> x \<in> carrier L1; y \<in> carrier L1; x \<sqsubseteq>\<^bsub>L1\<^esub> y \<rbrakk> 
  13.479 +          "(\<And>x y. \<lbrakk>x \<in> carrier L1; y \<in> carrier L1; x \<sqsubseteq>\<^bsub>L1\<^esub> y\<rbrakk> 
  13.480                     \<Longrightarrow> f x \<sqsubseteq>\<^bsub>L2\<^esub> f y)"
  13.481    shows "isotone L1 L2 f"
  13.482    using assms by (auto simp add:isotone_def)
  13.483 @@ -566,7 +482,7 @@
  13.484    "idempotent L f \<equiv> \<forall>x\<in>carrier L. f (f x) .=\<^bsub>L\<^esub> f x"
  13.485  
  13.486  lemma (in weak_partial_order) idempotent:
  13.487 -  "\<lbrakk> Idem f; x \<in> carrier L \<rbrakk> \<Longrightarrow> f (f x) .= f x"
  13.488 +  "\<lbrakk>Idem f; x \<in> carrier L\<rbrakk> \<Longrightarrow> f (f x) .= f x"
  13.489    by (auto simp add: idempotent_def)
  13.490  
  13.491  
  13.492 @@ -596,7 +512,7 @@
  13.493  declare weak_le_antisym [rule del]
  13.494  
  13.495  lemma le_antisym [intro]:
  13.496 -  "[| x \<sqsubseteq> y; y \<sqsubseteq> x; x \<in> carrier L; y \<in> carrier L |] ==> x = y"
  13.497 +  "\<lbrakk>x \<sqsubseteq> y; y \<sqsubseteq> x; x \<in> carrier L; y \<in> carrier L\<rbrakk> \<Longrightarrow> x = y"
  13.498    using weak_le_antisym unfolding eq_is_equal .
  13.499  
  13.500  lemma lless_eq:
  13.501 @@ -627,8 +543,8 @@
  13.502    and   "eq (inv_gorder A)      = eq A"
  13.503      by (simp_all)
  13.504    show "partial_order A"
  13.505 -    apply (unfold_locales, simp_all)
  13.506 -    apply (metis po.sym, metis po.trans)
  13.507 +    apply (unfold_locales, simp_all add: po.sym)
  13.508 +    apply (metis po.trans)
  13.509      apply (metis po.weak_le_antisym, metis po.le_trans)
  13.510      apply (metis (full_types) po.eq_is_equal, metis po.eq_is_equal)
  13.511    done
  13.512 @@ -641,11 +557,11 @@
  13.513  text \<open>Least and greatest, as predicate\<close>
  13.514  
  13.515  lemma (in partial_order) least_unique:
  13.516 -  "[| least L x A; least L y A |] ==> x = y"
  13.517 +  "\<lbrakk>least L x A; least L y A\<rbrakk> \<Longrightarrow> x = y"
  13.518    using weak_least_unique unfolding eq_is_equal .
  13.519  
  13.520  lemma (in partial_order) greatest_unique:
  13.521 -  "[| greatest L x A; greatest L y A |] ==> x = y"
  13.522 +  "\<lbrakk>greatest L x A; greatest L y A\<rbrakk> \<Longrightarrow> x = y"
  13.523    using weak_greatest_unique unfolding eq_is_equal .
  13.524  
  13.525  
  13.526 @@ -709,12 +625,12 @@
  13.527  subsection \<open>Total Orders\<close>
  13.528  
  13.529  locale weak_total_order = weak_partial_order +
  13.530 -  assumes total: "\<lbrakk> x \<in> carrier L; y \<in> carrier L \<rbrakk> \<Longrightarrow> x \<sqsubseteq> y \<or> y \<sqsubseteq> x"
  13.531 +  assumes total: "\<lbrakk>x \<in> carrier L; y \<in> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> y \<or> y \<sqsubseteq> x"
  13.532  
  13.533  text \<open>Introduction rule: the usual definition of total order\<close>
  13.534  
  13.535  lemma (in weak_partial_order) weak_total_orderI:
  13.536 -  assumes total: "!!x y. \<lbrakk> x \<in> carrier L; y \<in> carrier L \<rbrakk> \<Longrightarrow> x \<sqsubseteq> y \<or> y \<sqsubseteq> x"
  13.537 +  assumes total: "!!x y. \<lbrakk>x \<in> carrier L; y \<in> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> y \<or> y \<sqsubseteq> x"
  13.538    shows "weak_total_order L"
  13.539    by unfold_locales (rule total)
  13.540  
  13.541 @@ -722,7 +638,7 @@
  13.542  subsection \<open>Total orders where \<open>eq\<close> is the Equality\<close>
  13.543  
  13.544  locale total_order = partial_order +
  13.545 -  assumes total_order_total: "\<lbrakk> x \<in> carrier L; y \<in> carrier L \<rbrakk> \<Longrightarrow> x \<sqsubseteq> y \<or> y \<sqsubseteq> x"
  13.546 +  assumes total_order_total: "\<lbrakk>x \<in> carrier L; y \<in> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> y \<or> y \<sqsubseteq> x"
  13.547  
  13.548  sublocale total_order < weak?: weak_total_order
  13.549    by unfold_locales (rule total_order_total)
  13.550 @@ -730,7 +646,7 @@
  13.551  text \<open>Introduction rule: the usual definition of total order\<close>
  13.552  
  13.553  lemma (in partial_order) total_orderI:
  13.554 -  assumes total: "!!x y. \<lbrakk> x \<in> carrier L; y \<in> carrier L \<rbrakk> \<Longrightarrow> x \<sqsubseteq> y \<or> y \<sqsubseteq> x"
  13.555 +  assumes total: "!!x y. \<lbrakk>x \<in> carrier L; y \<in> carrier L\<rbrakk> \<Longrightarrow> x \<sqsubseteq> y \<or> y \<sqsubseteq> x"
  13.556    shows "total_order L"
  13.557    by unfold_locales (rule total)
  13.558  
    14.1 --- a/src/HOL/Analysis/Bochner_Integration.thy	Wed May 02 13:49:38 2018 +0200
    14.2 +++ b/src/HOL/Analysis/Bochner_Integration.thy	Thu May 03 15:07:14 2018 +0200
    14.3 @@ -475,8 +475,8 @@
    14.4      by (subst simple_bochner_integral_partition[OF f(1), where g="\<lambda>x. ennreal (f x)" and v=enn2real])
    14.5         (auto intro: f simple_function_compose1 elim: simple_bochner_integrable.cases
    14.6               intro!: sum.cong ennreal_cong_mult
    14.7 -             simp: sum_ennreal[symmetric] ac_simps ennreal_mult
    14.8 -             simp del: sum_ennreal)
    14.9 +             simp: ac_simps ennreal_mult
   14.10 +             reorient: sum_ennreal)
   14.11    also have "\<dots> = (\<integral>\<^sup>+x. f x \<partial>M)"
   14.12      using f
   14.13      by (intro nn_integral_eq_simple_integral[symmetric])
   14.14 @@ -504,7 +504,7 @@
   14.15      using simple_bochner_integrable_compose2[of "\<lambda>x y. norm (x - y)" M "s" "t"] s t
   14.16      by (auto intro!: simple_bochner_integral_eq_nn_integral)
   14.17    also have "\<dots> \<le> (\<integral>\<^sup>+x. ennreal (norm (f x - s x)) + ennreal (norm (f x - t x)) \<partial>M)"
   14.18 -    by (auto intro!: nn_integral_mono simp: ennreal_plus[symmetric] simp del: ennreal_plus)
   14.19 +    by (auto intro!: nn_integral_mono reorient: ennreal_plus)
   14.20         (metis (erased, hide_lams) add_diff_cancel_left add_diff_eq diff_add_eq order_trans
   14.21                norm_minus_commute norm_triangle_ineq4 order_refl)
   14.22    also have "\<dots> = ?S + ?T"
   14.23 @@ -594,7 +594,7 @@
   14.24      proof (intro always_eventually allI)
   14.25        fix i have "?f i \<le> (\<integral>\<^sup>+ x. (norm (f x - sf i x)) + ennreal (norm (g x - sg i x)) \<partial>M)"
   14.26          by (auto intro!: nn_integral_mono norm_diff_triangle_ineq
   14.27 -                 simp del: ennreal_plus simp add: ennreal_plus[symmetric])
   14.28 +                 reorient: ennreal_plus)
   14.29        also have "\<dots> = ?g i"
   14.30          by (intro nn_integral_add) auto
   14.31        finally show "?f i \<le> ?g i" .
   14.32 @@ -747,7 +747,7 @@
   14.33    finally have s_fin: "(\<integral>\<^sup>+x. norm (s i x) \<partial>M) < \<infinity>" .
   14.34  
   14.35    have "(\<integral>\<^sup>+ x. norm (f x) \<partial>M) \<le> (\<integral>\<^sup>+ x. ennreal (norm (f x - s i x)) + ennreal (norm (s i x)) \<partial>M)"
   14.36 -    by (auto intro!: nn_integral_mono simp del: ennreal_plus simp add: ennreal_plus[symmetric])
   14.37 +    by (auto intro!: nn_integral_mono reorient: ennreal_plus)
   14.38         (metis add.commute norm_triangle_sub)
   14.39    also have "\<dots> = (\<integral>\<^sup>+x. norm (f x - s i x) \<partial>M) + (\<integral>\<^sup>+x. norm (s i x) \<partial>M)"
   14.40      by (rule nn_integral_add) auto
   14.41 @@ -783,7 +783,7 @@
   14.42          by (intro simple_bochner_integral_eq_nn_integral)
   14.43             (auto intro: s simple_bochner_integrable_compose2)
   14.44        also have "\<dots> \<le> (\<integral>\<^sup>+x. ennreal (norm (f x - s n x)) + norm (f x) \<partial>M)"
   14.45 -        by (auto intro!: nn_integral_mono simp del: ennreal_plus simp add: ennreal_plus[symmetric])
   14.46 +        by (auto intro!: nn_integral_mono reorient: ennreal_plus)
   14.47             (metis add.commute norm_minus_commute norm_triangle_sub)
   14.48        also have "\<dots> = ?t n"
   14.49          by (rule nn_integral_add) auto
   14.50 @@ -828,7 +828,7 @@
   14.51        using tendsto_add[OF \<open>?S \<longlonglongrightarrow> 0\<close> \<open>?T \<longlonglongrightarrow> 0\<close>] by simp
   14.52    qed
   14.53    then have "(\<lambda>i. norm (?s i - ?t i)) \<longlonglongrightarrow> 0"
   14.54 -    by (simp add: ennreal_0[symmetric] del: ennreal_0)
   14.55 +    by (simp reorient: ennreal_0)
   14.56    ultimately have "norm (x - y) = 0"
   14.57      by (rule LIMSEQ_unique)
   14.58    then show "x = y" by simp
   14.59 @@ -1174,7 +1174,7 @@
   14.60          by (intro simple_bochner_integral_bounded s f)
   14.61        also have "\<dots> < ennreal (e / 2) + e / 2"
   14.62          by (intro add_strict_mono M n m)
   14.63 -      also have "\<dots> = e" using \<open>0<e\<close> by (simp del: ennreal_plus add: ennreal_plus[symmetric])
   14.64 +      also have "\<dots> = e" using \<open>0<e\<close> by (simp reorient: ennreal_plus)
   14.65        finally show "dist (?s n) (?s m) < e"
   14.66          using \<open>0<e\<close> by (simp add: dist_norm ennreal_less_iff)
   14.67      qed
   14.68 @@ -1219,7 +1219,7 @@
   14.69        fix x assume "(\<lambda>i. u i x) \<longlonglongrightarrow> u' x"
   14.70        from tendsto_diff[OF tendsto_const[of "u' x"] this]
   14.71        show "(\<lambda>i. ennreal (norm (u' x - u i x))) \<longlonglongrightarrow> 0"
   14.72 -        by (simp add: tendsto_norm_zero_iff ennreal_0[symmetric] del: ennreal_0)
   14.73 +        by (simp add: tendsto_norm_zero_iff reorient: ennreal_0)
   14.74      qed
   14.75    qed (insert bnd w_nonneg, auto)
   14.76    then show ?thesis by simp
   14.77 @@ -2117,7 +2117,7 @@
   14.78        by auto
   14.79    qed
   14.80    then have "((\<lambda>n. norm((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M))) \<longlongrightarrow> 0) F"
   14.81 -    by (simp add: ennreal_0[symmetric] del: ennreal_0)
   14.82 +    by (simp reorient: ennreal_0)
   14.83    then have "((\<lambda>n. ((\<integral>x. u n x \<partial>M) - (\<integral>x. f x \<partial>M))) \<longlongrightarrow> 0) F" using tendsto_norm_zero_iff by blast
   14.84    then show ?thesis using Lim_null by auto
   14.85  qed
   14.86 @@ -2215,7 +2215,7 @@
   14.87      ultimately have "(\<lambda>n. ennreal (norm(u (r n) x))) \<longlonglongrightarrow> 0"
   14.88        using tendsto_Limsup[of sequentially "\<lambda>n. ennreal (norm(u (r n) x))"] by auto
   14.89      then have "(\<lambda>n. norm(u (r n) x)) \<longlonglongrightarrow> 0"
   14.90 -      by (simp add: ennreal_0[symmetric] del: ennreal_0)
   14.91 +      by (simp reorient: ennreal_0)
   14.92      then have "(\<lambda>n. u (r n) x) \<longlonglongrightarrow> 0"
   14.93        by (simp add: tendsto_norm_zero_iff)
   14.94    }
    15.1 --- a/src/HOL/Analysis/Brouwer_Fixpoint.thy	Wed May 02 13:49:38 2018 +0200
    15.2 +++ b/src/HOL/Analysis/Brouwer_Fixpoint.thy	Thu May 03 15:07:14 2018 +0200
    15.3 @@ -2,9 +2,6 @@
    15.4      Author:     Robert Himmelmann, TU Muenchen (Translation from HOL light) and LCP
    15.5  *)
    15.6  
    15.7 -(* ========================================================================= *)
    15.8 -(* Results connected with topological dimension.                             *)
    15.9 -(*                                                                           *)
   15.10  (* At the moment this is just Brouwer's fixpoint theorem. The proof is from  *)
   15.11  (* Kuhn: "some combinatorial lemmas in topology", IBM J. v4. (1960) p. 518   *)
   15.12  (* See "http://www.research.ibm.com/journal/rd/045/ibmrd0405K.pdf".          *)
   15.13 @@ -14,7 +11,6 @@
   15.14  (* the big advantage of Kuhn's proof over the usual Sperner's lemma one.     *)
   15.15  (*                                                                           *)
   15.16  (*              (c) Copyright, John Harrison 1998-2008                       *)
   15.17 -(* ========================================================================= *)
   15.18  
   15.19  section \<open>Results connected with topological dimension\<close>
   15.20  
   15.21 @@ -40,11 +36,7 @@
   15.22  lemma swap_image:
   15.23    "Fun.swap i j f ` A = (if i \<in> A then (if j \<in> A then f ` A else f ` ((A - {i}) \<union> {j}))
   15.24                                    else (if j \<in> A then f ` ((A - {j}) \<union> {i}) else f ` A))"
   15.25 -  apply (auto simp: Fun.swap_def image_iff)
   15.26 -  apply metis
   15.27 -  apply (metis member_remove remove_def)
   15.28 -  apply (metis member_remove remove_def)
   15.29 -  done
   15.30 +  by (auto simp: swap_def image_def) metis
   15.31  
   15.32  lemmas swap_apply1 = swap_apply(1)
   15.33  lemmas swap_apply2 = swap_apply(2)
   15.34 @@ -191,9 +183,9 @@
   15.35      moreover obtain a where "rl a = Suc n" "a \<in> s"
   15.36        by (metis atMost_iff image_iff le_Suc_eq rl)
   15.37      ultimately have n: "{..n} = rl ` (s - {a})"
   15.38 -      by (auto simp add: inj_on_image_set_diff Diff_subset rl)
   15.39 +      by (auto simp: inj_on_image_set_diff Diff_subset rl)
   15.40      have "{a\<in>s. rl ` (s - {a}) = {..n}} = {a}"
   15.41 -      using inj_rl \<open>a \<in> s\<close> by (auto simp add: n inj_on_image_eq_iff[OF inj_rl] Diff_subset)
   15.42 +      using inj_rl \<open>a \<in> s\<close> by (auto simp: n inj_on_image_eq_iff[OF inj_rl] Diff_subset)
   15.43      then show "card ?S = 1"
   15.44        unfolding card_S by simp }
   15.45  
   15.46 @@ -202,7 +194,7 @@
   15.47      proof cases
   15.48        assume *: "{..n} \<subseteq> rl ` s"
   15.49        with rl rl_bd[OF s] have rl_s: "rl ` s = {..n}"
   15.50 -        by (auto simp add: atMost_Suc subset_insert_iff split: if_split_asm)
   15.51 +        by (auto simp: atMost_Suc subset_insert_iff split: if_split_asm)
   15.52        then have "\<not> inj_on rl s"
   15.53          by (intro pigeonhole) simp
   15.54        then obtain a b where ab: "a \<in> s" "b \<in> s" "rl a = rl b" "a \<noteq> b"
   15.55 @@ -210,7 +202,7 @@
   15.56        then have eq: "rl ` (s - {a}) = rl ` s"
   15.57          by auto
   15.58        with ab have inj: "inj_on rl (s - {a})"
   15.59 -        by (intro eq_card_imp_inj_on) (auto simp add: rl_s card_Diff_singleton_if)
   15.60 +        by (intro eq_card_imp_inj_on) (auto simp: rl_s card_Diff_singleton_if)
   15.61  
   15.62        { fix x assume "x \<in> s" "x \<notin> {a, b}"
   15.63          then have "rl ` s - {rl x} = rl ` ((s - {a}) - {x})"
   15.64 @@ -275,7 +267,7 @@
   15.65      with upd have "upd ` {..< x} \<noteq> upd ` {..< y}"
   15.66        by (subst inj_on_image_eq_iff[where C="{..< n}"]) (auto simp: bij_betw_def)
   15.67      then have "enum x \<noteq> enum y"
   15.68 -      by (auto simp add: enum_def fun_eq_iff) }
   15.69 +      by (auto simp: enum_def fun_eq_iff) }
   15.70    then show ?thesis
   15.71      by (auto simp: inj_on_def)
   15.72  qed
   15.73 @@ -325,7 +317,7 @@
   15.74    by (auto simp: enum_def le_fun_def in_upd_image Ball_def[symmetric])
   15.75  
   15.76  lemma enum_strict_mono: "i \<le> n \<Longrightarrow> j \<le> n \<Longrightarrow> enum i < enum j \<longleftrightarrow> i < j"
   15.77 -  using enum_mono[of i j] enum_inj[of i j] by (auto simp add: le_less)
   15.78 +  using enum_mono[of i j] enum_inj[of i j] by (auto simp: le_less)
   15.79  
   15.80  lemma chain: "a \<in> s \<Longrightarrow> b \<in> s \<Longrightarrow> a \<le> b \<or> b \<le> a"
   15.81    by (auto simp: s_eq enum_mono)
   15.82 @@ -346,7 +338,7 @@
   15.83    by (induct i) (auto simp: enum_Suc enum_0 base_out upd_space not_less[symmetric])
   15.84  
   15.85  lemma out_eq_p: "a \<in> s \<Longrightarrow> n \<le> j \<Longrightarrow> a j = p"
   15.86 -  unfolding s_eq by (auto simp add: enum_eq_p)
   15.87 +  unfolding s_eq by (auto simp: enum_eq_p)
   15.88  
   15.89  lemma s_le_p: "a \<in> s \<Longrightarrow> a j \<le> p"
   15.90    using out_eq_p[of a j] s_space by (cases "j < n") auto
   15.91 @@ -578,7 +570,7 @@
   15.92          by (auto simp: image_iff Ball_def) arith
   15.93        then have upd_Suc: "\<And>i. i \<le> n \<Longrightarrow> (upd\<circ>Suc) ` {..< i} = upd ` {..< Suc i} - {n}"
   15.94          using \<open>upd 0 = n\<close> upd_inj
   15.95 -        by (auto simp add: image_comp[symmetric] inj_on_image_set_diff[OF inj_upd])
   15.96 +        by (auto simp: image_comp[symmetric] inj_on_image_set_diff[OF inj_upd])
   15.97        have n_in_upd: "\<And>i. n \<in> upd ` {..< Suc i}"
   15.98          using \<open>upd 0 = n\<close> by auto
   15.99  
  15.100 @@ -685,7 +677,7 @@
  15.101  qed
  15.102  
  15.103  lemma card_2_exists: "card s = 2 \<longleftrightarrow> (\<exists>x\<in>s. \<exists>y\<in>s. x \<noteq> y \<and> (\<forall>z\<in>s. z = x \<or> z = y))"
  15.104 -  by (auto simp add: card_Suc_eq eval_nat_numeral)
  15.105 +  by (auto simp: card_Suc_eq eval_nat_numeral)
  15.106  
  15.107  lemma ksimplex_replace_2:
  15.108    assumes s: "ksimplex p n s" and "a \<in> s" and "n \<noteq> 0"
  15.109 @@ -723,11 +715,11 @@
  15.110        obtain i' where "i' \<le> n" "enum i' \<noteq> enum 0" "enum i' (upd 0) \<noteq> p"
  15.111          unfolding s_eq by (auto intro: upd_space simp: enum_inj)
  15.112        then have "enum 1 \<le> enum i'" "enum i' (upd 0) < p"
  15.113 -        using enum_le_p[of i' "upd 0"] by (auto simp add: enum_inj enum_mono upd_space)
  15.114 +        using enum_le_p[of i' "upd 0"] by (auto simp: enum_inj enum_mono upd_space)
  15.115        then have "enum 1 (upd 0) < p"
  15.116 -        by (auto simp add: le_fun_def intro: le_less_trans)
  15.117 +        by (auto simp: le_fun_def intro: le_less_trans)
  15.118        then show "enum (Suc 0) \<in> {..<n} \<rightarrow> {..<p}"
  15.119 -        using base \<open>n \<noteq> 0\<close> by (auto simp add: enum_0 enum_Suc PiE_iff extensional_def upd_space)
  15.120 +        using base \<open>n \<noteq> 0\<close> by (auto simp: enum_0 enum_Suc PiE_iff extensional_def upd_space)
  15.121  
  15.122        { fix i assume "n \<le> i" then show "enum (Suc 0) i = p"
  15.123          using \<open>n \<noteq> 0\<close> by (auto simp: enum_eq_p) }
  15.124 @@ -745,7 +737,7 @@
  15.125  
  15.126      { fix j assume j: "j < n"
  15.127        from j \<open>n \<noteq> 0\<close> have "f' j = enum (Suc j)"
  15.128 -        by (auto simp add: f'_def enum_def upd_inj in_upd_image image_comp[symmetric] fun_eq_iff) }
  15.129 +        by (auto simp: f'_def enum_def upd_inj in_upd_image image_comp[symmetric] fun_eq_iff) }
  15.130      note f'_eq_enum = this
  15.131      then have "enum ` Suc ` {..< n} = f' ` {..< n}"
  15.132        by (force simp: enum_inj)
  15.133 @@ -859,10 +851,10 @@
  15.134        by (simp_all add: rot_def)
  15.135  
  15.136      { fix j assume j: "Suc j \<le> n" then have "b.enum (Suc j) = enum j"
  15.137 -        by (induct j) (auto simp add: benum1 enum_0 b.enum_Suc enum_Suc rot_simps) }
  15.138 +        by (induct j) (auto simp: benum1 enum_0 b.enum_Suc enum_Suc rot_simps) }
  15.139      note b_enum_eq_enum = this
  15.140      then have "enum ` {..< n} = b.enum ` Suc ` {..< n}"
  15.141 -      by (auto simp add: image_comp intro!: image_cong)
  15.142 +      by (auto simp: image_comp intro!: image_cong)
  15.143      also have "Suc ` {..< n} = {.. n} - {0}"
  15.144        by (auto simp: image_iff Ball_def) arith
  15.145      also have "{..< n} = {.. n} - {n}"
  15.146 @@ -871,7 +863,7 @@
  15.147        unfolding s_eq \<open>a = enum i\<close> \<open>i = n\<close>
  15.148        using inj_on_image_set_diff[OF inj_enum Diff_subset, of "{n}"]
  15.149              inj_on_image_set_diff[OF b.inj_enum Diff_subset, of "{0}"]
  15.150 -      by (simp add: comp_def )
  15.151 +      by (simp add: comp_def)
  15.152  
  15.153      have "b.enum 0 \<le> b.enum n"
  15.154        by (simp add: b.enum_mono)
  15.155 @@ -956,7 +948,7 @@
  15.156        moreover note i
  15.157        ultimately have "enum j = b.enum j \<longleftrightarrow> j \<noteq> i"
  15.158          unfolding enum_def[abs_def] b.enum_def[abs_def]
  15.159 -        by (auto simp add: fun_eq_iff swap_image i'_def
  15.160 +        by (auto simp: fun_eq_iff swap_image i'_def
  15.161                             in_upd_image inj_on_image_set_diff[OF inj_upd]) }
  15.162      note enum_eq_benum = this
  15.163      then have "enum ` ({.. n} - {i}) = b.enum ` ({.. n} - {i})"
  15.164 @@ -1001,7 +993,7 @@
  15.165          then obtain j where "t.enum (Suc l) = enum j" "j \<le> n" "enum j \<noteq> enum i"
  15.166            unfolding s_eq \<open>a = enum i\<close> by auto
  15.167          with i have "t.enum (Suc l) \<le> t.enum l \<or> t.enum k \<le> t.enum (Suc l)"
  15.168 -          by (auto simp add: i'_def enum_mono enum_inj l k)
  15.169 +          by (auto simp: i'_def enum_mono enum_inj l k)
  15.170          with \<open>Suc l < k\<close> \<open>k \<le> n\<close> show False
  15.171            by (simp add: t.enum_mono)
  15.172        qed
  15.173 @@ -1041,7 +1033,7 @@
  15.174          assume u: "u l = upd (Suc i')"
  15.175          define B where "B = b.enum ` {..n}"
  15.176          have "b.enum i' = enum i'"
  15.177 -          using enum_eq_benum[of i'] i by (auto simp add: i'_def gr0_conv_Suc)
  15.178 +          using enum_eq_benum[of i'] i by (auto simp: i'_def gr0_conv_Suc)
  15.179          have "c = t.enum (Suc l)" unfolding c_eq ..
  15.180          also have "t.enum (Suc l) = b.enum (Suc i')"
  15.181            using u \<open>l < k\<close> \<open>k \<le> n\<close> \<open>Suc i' < n\<close>
  15.182 @@ -1432,7 +1424,7 @@
  15.183  proof (rule ccontr)
  15.184    define n where "n = DIM('a)"
  15.185    have n: "1 \<le> n" "0 < n" "n \<noteq> 0"
  15.186 -    unfolding n_def by (auto simp add: Suc_le_eq DIM_positive)
  15.187 +    unfolding n_def by (auto simp: Suc_le_eq DIM_positive)
  15.188    assume "\<not> ?thesis"
  15.189    then have *: "\<not> (\<exists>x\<in>unit_cube. f x - x = 0)"
  15.190      by auto
  15.191 @@ -1447,73 +1439,45 @@
  15.192      using assms(2)[unfolded image_subset_iff Ball_def]
  15.193      unfolding mem_unit_cube
  15.194      by auto
  15.195 -  obtain label :: "'a \<Rightarrow> 'a \<Rightarrow> nat" where
  15.196 +  obtain label :: "'a \<Rightarrow> 'a \<Rightarrow> nat" where label [rule_format]:
  15.197      "\<forall>x. \<forall>i\<in>Basis. label x i \<le> 1"
  15.198 -    "\<forall>x. \<forall>i\<in>Basis. x \<in> unit_cube \<and> True \<and> x \<bullet> i = 0 \<longrightarrow> label x i = 0"
  15.199 -    "\<forall>x. \<forall>i\<in>Basis. x \<in> unit_cube \<and> True \<and> x \<bullet> i = 1 \<longrightarrow> label x i = 1"
  15.200 -    "\<forall>x. \<forall>i\<in>Basis. x \<in> unit_cube \<and> True \<and> label x i = 0 \<longrightarrow> x \<bullet> i \<le> f x \<bullet> i"
  15.201 -    "\<forall>x. \<forall>i\<in>Basis. x \<in> unit_cube \<and> True \<and> label x i = 1 \<longrightarrow> f x \<bullet> i \<le> x \<bullet> i"
  15.202 -    using kuhn_labelling_lemma[OF *] by blast
  15.203 +    "\<forall>x. \<forall>i\<in>Basis. x \<in> unit_cube \<and> x \<bullet> i = 0 \<longrightarrow> label x i = 0"
  15.204 +    "\<forall>x. \<forall>i\<in>Basis. x \<in> unit_cube \<and> x \<bullet> i = 1 \<longrightarrow> label x i = 1"
  15.205 +    "\<forall>x. \<forall>i\<in>Basis. x \<in> unit_cube \<and> label x i = 0 \<longrightarrow> x \<bullet> i \<le> f x \<bullet> i"
  15.206 +    "\<forall>x. \<forall>i\<in>Basis. x \<in> unit_cube \<and> label x i = 1 \<longrightarrow> f x \<bullet> i \<le> x \<bullet> i"
  15.207 +    using kuhn_labelling_lemma[OF *] by auto
  15.208    note label = this [rule_format]
  15.209    have lem1: "\<forall>x\<in>unit_cube. \<forall>y\<in>unit_cube. \<forall>i\<in>Basis. label x i \<noteq> label y i \<longrightarrow>
  15.210      \<bar>f x \<bullet> i - x \<bullet> i\<bar> \<le> norm (f y - f x) + norm (y - x)"
  15.211    proof safe
  15.212      fix x y :: 'a
  15.213 -    assume x: "x \<in> unit_cube"
  15.214 -    assume y: "y \<in> unit_cube"
  15.215 +    assume x: "x \<in> unit_cube" and y: "y \<in> unit_cube"
  15.216      fix i
  15.217      assume i: "label x i \<noteq> label y i" "i \<in> Basis"
  15.218      have *: "\<And>x y fx fy :: real. x \<le> fx \<and> fy \<le> y \<or> fx \<le> x \<and> y \<le> fy \<Longrightarrow>
  15.219        \<bar>fx - x\<bar> \<le> \<bar>fy - fx\<bar> + \<bar>y - x\<bar>" by auto
  15.220      have "\<bar>(f x - x) \<bullet> i\<bar> \<le> \<bar>(f y - f x)\<bullet>i\<bar> + \<bar>(y - x)\<bullet>i\<bar>"
  15.221 -      unfolding inner_simps
  15.222 -      apply (rule *)
  15.223 -      apply (cases "label x i = 0")
  15.224 -      apply (rule disjI1)
  15.225 -      apply rule
  15.226 -      prefer 3
  15.227 -      apply (rule disjI2)
  15.228 -      apply rule
  15.229 -    proof -
  15.230 -      assume lx: "label x i = 0"
  15.231 -      then have ly: "label y i = 1"
  15.232 -        using i label(1)[of i y]
  15.233 -        by auto
  15.234 -      show "x \<bullet> i \<le> f x \<bullet> i"
  15.235 -        apply (rule label(4)[rule_format])
  15.236 -        using x y lx i(2)
  15.237 -        apply auto
  15.238 -        done
  15.239 -      show "f y \<bullet> i \<le> y \<bullet> i"
  15.240 -        apply (rule label(5)[rule_format])
  15.241 -        using x y ly i(2)
  15.242 -        apply auto
  15.243 -        done
  15.244 +    proof (cases "label x i = 0")
  15.245 +      case True
  15.246 +      then have fxy: "\<not> f y \<bullet> i \<le> y \<bullet> i \<Longrightarrow> f x \<bullet> i \<le> x \<bullet> i"
  15.247 +        by (metis True i label(1) label(5) le_antisym less_one not_le_imp_less y)
  15.248 +      show ?thesis
  15.249 +      unfolding inner_simps         
  15.250 +      by (rule *) (auto simp: True i label x y fxy)
  15.251      next
  15.252 -      assume "label x i \<noteq> 0"
  15.253 -      then have l: "label x i = 1" "label y i = 0"
  15.254 -        using i label(1)[of i x] label(1)[of i y]
  15.255 -        by auto
  15.256 -      show "f x \<bullet> i \<le> x \<bullet> i"
  15.257 -        apply (rule label(5)[rule_format])
  15.258 -        using x y l i(2)
  15.259 -        apply auto
  15.260 -        done
  15.261 -      show "y \<bullet> i \<le> f y \<bullet> i"
  15.262 -        apply (rule label(4)[rule_format])
  15.263 -        using x y l i(2)
  15.264 -        apply auto
  15.265 -        done
  15.266 +      case False
  15.267 +      then show ?thesis
  15.268 +        using label [OF \<open>i \<in> Basis\<close>] i(1) x y
  15.269 +        apply (auto simp: inner_diff_left le_Suc_eq)
  15.270 +        by (metis "*")
  15.271      qed
  15.272      also have "\<dots> \<le> norm (f y - f x) + norm (y - x)"
  15.273 -      apply (rule add_mono)
  15.274 -      apply (rule Basis_le_norm[OF i(2)])+
  15.275 -      done
  15.276 +      by (simp add: add_mono i(2) norm_bound_Basis_le)
  15.277      finally show "\<bar>f x \<bullet> i - x \<bullet> i\<bar> \<le> norm (f y - f x) + norm (y - x)"
  15.278        unfolding inner_simps .
  15.279    qed
  15.280    have "\<exists>e>0. \<forall>x\<in>unit_cube. \<forall>y\<in>unit_cube. \<forall>z\<in>unit_cube. \<forall>i\<in>Basis.
  15.281 -    norm (x - z) < e \<and> norm (y - z) < e \<and> label x i \<noteq> label y i \<longrightarrow>
  15.282 +    norm (x - z) < e \<longrightarrow> norm (y - z) < e \<longrightarrow> label x i \<noteq> label y i \<longrightarrow>
  15.283        \<bar>(f(z) - z)\<bullet>i\<bar> < d / (real n)"
  15.284    proof -
  15.285      have d': "d / real n / 8 > 0"
  15.286 @@ -1530,9 +1494,7 @@
  15.287        unfolding dist_norm
  15.288        by blast
  15.289      show ?thesis
  15.290 -      apply (rule_tac x="min (e/2) (d/real n/8)" in exI)
  15.291 -      apply safe
  15.292 -    proof -
  15.293 +    proof (intro exI conjI ballI impI)
  15.294        show "0 < min (e / 2) (d / real n / 8)"
  15.295          using d' e by auto
  15.296        fix x y z i
  15.297 @@ -1551,10 +1513,9 @@
  15.298          unfolding inner_simps
  15.299        proof (rule *)
  15.300          show "\<bar>f x \<bullet> i - x \<bullet> i\<bar> \<le> norm (f y -f x) + norm (y - x)"
  15.301 -          apply (rule lem1[rule_format])
  15.302 -          using as i
  15.303 -          apply auto
  15.304 -          done
  15.305 +          using as(1) as(2) as(6) i lem1 by blast
  15.306 +        show "norm (f x - f z) < d / real n / 8"
  15.307 +          using d' e as by auto
  15.308          show "\<bar>f x \<bullet> i - f z \<bullet> i\<bar> \<le> norm (f x - f z)" "\<bar>x \<bullet> i - z \<bullet> i\<bar> \<le> norm (x - z)"
  15.309            unfolding inner_diff_left[symmetric]
  15.310            by (rule Basis_le_norm[OF i])+
  15.311 @@ -1563,30 +1524,14 @@
  15.312            unfolding norm_minus_commute
  15.313            by auto
  15.314          also have "\<dots> < e / 2 + e / 2"
  15.315 -          apply (rule add_strict_mono)
  15.316 -          using as(4,5)
  15.317 -          apply auto
  15.318 -          done
  15.319 +          using as(4) as(5) by auto
  15.320          finally show "norm (f y - f x) < d / real n / 8"
  15.321 -          apply -
  15.322 -          apply (rule e(2))
  15.323 -          using as
  15.324 -          apply auto
  15.325 -          done
  15.326 +          using as(1) as(2) e(2) by auto
  15.327          have "norm (y - z) + norm (x - z) < d / real n / 8 + d / real n / 8"
  15.328 -          apply (rule add_strict_mono)
  15.329 -          using as
  15.330 -          apply auto
  15.331 -          done
  15.332 -        then show "norm (y - x) < 2 * (d / real n / 8)"
  15.333 -          using tria
  15.334 +          using as(4) as(5) by auto
  15.335 +        with tria show "norm (y - x) < 2 * (d / real n / 8)"
  15.336            by auto
  15.337 -        show "norm (f x - f z) < d / real n / 8"
  15.338 -          apply (rule e(2))
  15.339 -          using as e(1)
  15.340 -          apply auto
  15.341 -          done
  15.342 -      qed (insert as, auto)
  15.343 +      qed (use as in auto)
  15.344      qed
  15.345    qed
  15.346    then
  15.347 @@ -1635,14 +1580,14 @@
  15.348    { fix x :: "nat \<Rightarrow> nat" and i assume "\<forall>i<n. x i \<le> p" "i < n" "x i = p \<or> x i = 0"
  15.349      then have "(\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<in> (unit_cube::'a set)"
  15.350        using b'_Basis
  15.351 -      by (auto simp add: mem_unit_cube inner_simps bij_betw_def zero_le_divide_iff divide_le_eq_1) }
  15.352 +      by (auto simp: mem_unit_cube inner_simps bij_betw_def zero_le_divide_iff divide_le_eq_1) }
  15.353    note cube = this
  15.354    have q2: "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> (\<forall>i<n. x i = 0 \<longrightarrow>
  15.355        (label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 0)"
  15.356 -    unfolding o_def using cube \<open>p > 0\<close> by (intro allI impI label(2)) (auto simp add: b'')
  15.357 +    unfolding o_def using cube \<open>p > 0\<close> by (intro allI impI label(2)) (auto simp: b'')
  15.358    have q3: "\<forall>x. (\<forall>i<n. x i \<le> p) \<longrightarrow> (\<forall>i<n. x i = p \<longrightarrow>
  15.359        (label (\<Sum>i\<in>Basis. (real (x (b' i)) / real p) *\<^sub>R i) \<circ> b) i = 1)"
  15.360 -    using cube \<open>p > 0\<close> unfolding o_def by (intro allI impI label(3)) (auto simp add: b'')
  15.361 +    using cube \<open>p > 0\<close> unfolding o_def by (intro allI impI label(3)) (auto simp: b'')
  15.362    obtain q where q:
  15.363        "\<forall>i<n. q i < p"
  15.364        "\<forall>i<n.
  15.365 @@ -1660,24 +1605,20 @@
  15.366      then have "z \<in> unit_cube"
  15.367        unfolding z_def mem_unit_cube
  15.368        using b'_Basis
  15.369 -      by (auto simp add: bij_betw_def zero_le_divide_iff divide_le_eq_1)
  15.370 +      by (auto simp: bij_betw_def zero_le_divide_iff divide_le_eq_1)
  15.371      then have d_fz_z: "d \<le> norm (f z - z)"
  15.372        by (rule d)
  15.373      assume "\<not> ?thesis"
  15.374      then have as: "\<forall>i\<in>Basis. \<bar>f z \<bullet> i - z \<bullet> i\<bar> < d / real n"
  15.375        using \<open>n > 0\<close>
  15.376 -      by (auto simp add: not_le inner_diff)
  15.377 +      by (auto simp: not_le inner_diff)
  15.378      have "norm (f z - z) \<le> (\<Sum>i\<in>Basis. \<bar>f z \<bullet> i - z \<bullet> i\<bar>)"
  15.379        unfolding inner_diff_left[symmetric]
  15.380        by (rule norm_le_l1)
  15.381      also have "\<dots> < (\<Sum>(i::'a) \<in> Basis. d / real n)"
  15.382 -      apply (rule sum_strict_mono)
  15.383 -      using as
  15.384 -      apply auto
  15.385 -      done
  15.386 +      by (meson as finite_Basis nonempty_Basis sum_strict_mono)
  15.387      also have "\<dots> = d"
  15.388 -      using DIM_positive[where 'a='a]
  15.389 -      by (auto simp: n_def)
  15.390 +      using DIM_positive[where 'a='a] by (auto simp: n_def)
  15.391      finally show False
  15.392        using d_fz_z by auto
  15.393    qed
  15.394 @@ -1698,50 +1639,37 @@
  15.395      apply (rule order_trans)
  15.396      apply (rule rs(1)[OF b'_im,THEN conjunct2])
  15.397      using q(1)[rule_format,OF b'_im]
  15.398 -    apply (auto simp add: Suc_le_eq)
  15.399 +    apply (auto simp: Suc_le_eq)
  15.400      done
  15.401    then have "r' \<in> unit_cube"
  15.402      unfolding r'_def mem_unit_cube
  15.403      using b'_Basis
  15.404 -    by (auto simp add: bij_betw_def zero_le_divide_iff divide_le_eq_1)
  15.405 +    by (auto simp: bij_betw_def zero_le_divide_iff divide_le_eq_1)
  15.406    define s' :: 'a where "s' = (\<Sum>i\<in>Basis. (real (s (b' i)) / real p) *\<^sub>R i)"
  15.407    have "\<And>i. i \<in> Basis \<Longrightarrow> s (b' i) \<le> p"
  15.408 -    apply (rule order_trans)
  15.409 -    apply (rule rs(2)[OF b'_im, THEN conjunct2])
  15.410 -    using q(1)[rule_format,OF b'_im]
  15.411 -    apply (auto simp add: Suc_le_eq)
  15.412 -    done
  15.413 +    using b'_im q(1) rs(2) by fastforce
  15.414    then have "s' \<in> unit_cube"
  15.415      unfolding s'_def mem_unit_cube
  15.416 -    using b'_Basis
  15.417 -    by (auto simp add: bij_betw_def zero_le_divide_iff divide_le_eq_1)
  15.418 +    using b'_Basis by (auto simp: bij_betw_def zero_le_divide_iff divide_le_eq_1)
  15.419    have "z \<in> unit_cube"
  15.420      unfolding z_def mem_unit_cube
  15.421      using b'_Basis q(1)[rule_format,OF b'_im] \<open>p > 0\<close>
  15.422 -    by (auto simp add: bij_betw_def zero_le_divide_iff divide_le_eq_1 less_imp_le)
  15.423 -  have *: "\<And>x. 1 + real x = real (Suc x)"
  15.424 -    by auto
  15.425 +    by (auto simp: bij_betw_def zero_le_divide_iff divide_le_eq_1 less_imp_le)
  15.426    {
  15.427      have "(\<Sum>i\<in>Basis. \<bar>real (r (b' i)) - real (q (b' i))\<bar>) \<le> (\<Sum>(i::'a)\<in>Basis. 1)"
  15.428 -      apply (rule sum_mono)
  15.429 -      using rs(1)[OF b'_im]
  15.430 -      apply (auto simp add:* field_simps simp del: of_nat_Suc)
  15.431 -      done
  15.432 +      by (rule sum_mono) (use rs(1)[OF b'_im] in force)
  15.433      also have "\<dots> < e * real p"
  15.434        using p \<open>e > 0\<close> \<open>p > 0\<close>
  15.435 -      by (auto simp add: field_simps n_def)
  15.436 +      by (auto simp: field_simps n_def)
  15.437      finally have "(\<Sum>i\<in>Basis. \<bar>real (r (b' i)) - real (q (b' i))\<bar>) < e * real p" .
  15.438    }
  15.439    moreover
  15.440    {
  15.441      have "(\<Sum>i\<in>Basis. \<bar>real (s (b' i)) - real (q (b' i))\<bar>) \<le> (\<Sum>(i::'a)\<in>Basis. 1)"
  15.442 -      apply (rule sum_mono)
  15.443 -      using rs(2)[OF b'_im]
  15.444 -      apply (auto simp add:* field_simps simp del: of_nat_Suc)
  15.445 -      done
  15.446 +      by (rule sum_mono) (use rs(2)[OF b'_im] in force)
  15.447      also have "\<dots> < e * real p"
  15.448        using p \<open>e > 0\<close> \<open>p > 0\<close>
  15.449 -      by (auto simp add: field_simps n_def)
  15.450 +      by (auto simp: field_simps n_def)
  15.451      finally have "(\<Sum>i\<in>Basis. \<bar>real (s (b' i)) - real (q (b' i))\<bar>) < e * real p" .
  15.452    }
  15.453    ultimately
  15.454 @@ -1749,7 +1677,7 @@
  15.455      unfolding r'_def s'_def z_def
  15.456      using \<open>p > 0\<close>
  15.457      apply (rule_tac[!] le_less_trans[OF norm_le_l1])
  15.458 -    apply (auto simp add: field_simps sum_divide_distrib[symmetric] inner_diff_left)
  15.459 +    apply (auto simp: field_simps sum_divide_distrib[symmetric] inner_diff_left)
  15.460      done
  15.461    then have "\<bar>(f z - z) \<bullet> i\<bar> < d / real n"
  15.462      using rs(3) i
  15.463 @@ -1762,121 +1690,100 @@
  15.464  
  15.465  subsection \<open>Retractions\<close>
  15.466  
  15.467 -definition "retraction s t r \<longleftrightarrow> t \<subseteq> s \<and> continuous_on s r \<and> r ` s \<subseteq> t \<and> (\<forall>x\<in>t. r x = x)"
  15.468 +definition "retraction S T r \<longleftrightarrow> T \<subseteq> S \<and> continuous_on S r \<and> r ` S \<subseteq> T \<and> (\<forall>x\<in>T. r x = x)"
  15.469  
  15.470  definition retract_of (infixl "retract'_of" 50)
  15.471 -  where "(t retract_of s) \<longleftrightarrow> (\<exists>r. retraction s t r)"
  15.472 -
  15.473 -lemma retraction_idempotent: "retraction s t r \<Longrightarrow> x \<in> s \<Longrightarrow>  r (r x) = r x"
  15.474 +  where "(T retract_of S) \<longleftrightarrow> (\<exists>r. retraction S T r)"
  15.475 +
  15.476 +lemma retraction_idempotent: "retraction S T r \<Longrightarrow> x \<in> S \<Longrightarrow>  r (r x) = r x"
  15.477    unfolding retraction_def by auto
  15.478  
  15.479  subsection \<open>Preservation of fixpoints under (more general notion of) retraction\<close>
  15.480  
  15.481  lemma invertible_fixpoint_property:
  15.482 -  fixes s :: "'a::euclidean_space set"
  15.483 -    and t :: "'b::euclidean_space set"
  15.484 -  assumes "continuous_on t i"
  15.485 -    and "i ` t \<subseteq> s"
  15.486 -    and "continuous_on s r"
  15.487 -    and "r ` s \<subseteq> t"
  15.488 -    and "\<forall>y\<in>t. r (i y) = y"
  15.489 -    and "\<forall>f. continuous_on s f \<and> f ` s \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. f x = x)"
  15.490 -    and "continuous_on t g"
  15.491 -    and "g ` t \<subseteq> t"
  15.492 -  obtains y where "y \<in> t" and "g y = y"
  15.493 +  fixes S :: "'a::euclidean_space set"
  15.494 +    and T :: "'b::euclidean_space set"
  15.495 +  assumes contt: "continuous_on T i"
  15.496 +    and "i ` T \<subseteq> S"
  15.497 +    and contr: "continuous_on S r"
  15.498 +    and "r ` S \<subseteq> T"
  15.499 +    and ri: "\<And>y. y \<in> T \<Longrightarrow> r (i y) = y"
  15.500 +    and FP: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>x\<in>S. f x = x"
  15.501 +    and contg: "continuous_on T g"
  15.502 +    and "g ` T \<subseteq> T"
  15.503 +  obtains y where "y \<in> T" and "g y = y"
  15.504  proof -
  15.505 -  have "\<exists>x\<in>s. (i \<circ> g \<circ> r) x = x"
  15.506 -    apply (rule assms(6)[rule_format])
  15.507 -    apply rule
  15.508 -    apply (rule continuous_on_compose assms)+
  15.509 -    apply ((rule continuous_on_subset)?, rule assms)+
  15.510 -    using assms(2,4,8)
  15.511 -    apply auto
  15.512 -    apply blast
  15.513 -    done
  15.514 -  then obtain x where x: "x \<in> s" "(i \<circ> g \<circ> r) x = x" ..
  15.515 -  then have *: "g (r x) \<in> t"
  15.516 +  have "\<exists>x\<in>S. (i \<circ> g \<circ> r) x = x"
  15.517 +  proof (rule FP)
  15.518 +    show "continuous_on S (i \<circ> g \<circ> r)"
  15.519 +      by (meson contt contr assms(4) contg assms(8) continuous_on_compose continuous_on_subset)
  15.520 +    show "(i \<circ> g \<circ> r) ` S \<subseteq> S"
  15.521 +      using assms(2,4,8) by force
  15.522 +  qed
  15.523 +  then obtain x where x: "x \<in> S" "(i \<circ> g \<circ> r) x = x" ..
  15.524 +  then have *: "g (r x) \<in> T"
  15.525      using assms(4,8) by auto
  15.526    have "r ((i \<circ> g \<circ> r) x) = r x"
  15.527      using x by auto
  15.528    then show ?thesis
  15.529 -    apply (rule_tac that[of "r x"])
  15.530 -    using x
  15.531 -    unfolding o_def
  15.532 -    unfolding assms(5)[rule_format,OF *]
  15.533 -    using assms(4)
  15.534 -    apply auto
  15.535 -    done
  15.536 +    using "*" ri that by auto
  15.537  qed
  15.538  
  15.539  lemma homeomorphic_fixpoint_property:
  15.540 -  fixes s :: "'a::euclidean_space set"
  15.541 -    and t :: "'b::euclidean_space set"
  15.542 -  assumes "s homeomorphic t"
  15.543 -  shows "(\<forall>f. continuous_on s f \<and> f ` s \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. f x = x)) \<longleftrightarrow>
  15.544 -    (\<forall>g. continuous_on t g \<and> g ` t \<subseteq> t \<longrightarrow> (\<exists>y\<in>t. g y = y))"
  15.545 +  fixes S :: "'a::euclidean_space set"
  15.546 +    and T :: "'b::euclidean_space set"
  15.547 +  assumes "S homeomorphic T"
  15.548 +  shows "(\<forall>f. continuous_on S f \<and> f ` S \<subseteq> S \<longrightarrow> (\<exists>x\<in>S. f x = x)) \<longleftrightarrow>
  15.549 +         (\<forall>g. continuous_on T g \<and> g ` T \<subseteq> T \<longrightarrow> (\<exists>y\<in>T. g y = y))"
  15.550 +         (is "?lhs = ?rhs")
  15.551  proof -
  15.552 -  obtain r i where
  15.553 -      "\<forall>x\<in>s. i (r x) = x"
  15.554 -      "r ` s = t"
  15.555 -      "continuous_on s r"
  15.556 -      "\<forall>y\<in>t. r (i y) = y"
  15.557 -      "i ` t = s"
  15.558 -      "continuous_on t i"
  15.559 -    using assms
  15.560 -    unfolding homeomorphic_def homeomorphism_def
  15.561 -    by blast
  15.562 -  then show ?thesis
  15.563 -    apply -
  15.564 -    apply rule
  15.565 -    apply (rule_tac[!] allI impI)+
  15.566 -    apply (rule_tac g=g in invertible_fixpoint_property[of t i s r])
  15.567 -    prefer 10
  15.568 -    apply (rule_tac g=f in invertible_fixpoint_property[of s r t i])
  15.569 -    apply auto
  15.570 -    done
  15.571 +  obtain r i where r:
  15.572 +      "\<forall>x\<in>S. i (r x) = x" "r ` S = T" "continuous_on S r"
  15.573 +      "\<forall>y\<in>T. r (i y) = y" "i ` T = S" "continuous_on T i"
  15.574 +    using assms unfolding homeomorphic_def homeomorphism_def  by blast
  15.575 +  show ?thesis
  15.576 +  proof
  15.577 +    assume ?lhs
  15.578 +    with r show ?rhs
  15.579 +      by (metis invertible_fixpoint_property[of T i S r] order_refl)
  15.580 +  next
  15.581 +    assume ?rhs
  15.582 +    with r show ?lhs
  15.583 +      by (metis invertible_fixpoint_property[of S r T i] order_refl)
  15.584 +  qed
  15.585  qed
  15.586  
  15.587  lemma retract_fixpoint_property:
  15.588    fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
  15.589 -    and s :: "'a set"
  15.590 -  assumes "t retract_of s"
  15.591 -    and "\<forall>f. continuous_on s f \<and> f ` s \<subseteq> s \<longrightarrow> (\<exists>x\<in>s. f x = x)"
  15.592 -    and "continuous_on t g"
  15.593 -    and "g ` t \<subseteq> t"
  15.594 -  obtains y where "y \<in> t" and "g y = y"
  15.595 +    and S :: "'a set"
  15.596 +  assumes "T retract_of S"
  15.597 +    and FP: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>x\<in>S. f x = x"
  15.598 +    and contg: "continuous_on T g"
  15.599 +    and "g ` T \<subseteq> T"
  15.600 +  obtains y where "y \<in> T" and "g y = y"
  15.601  proof -
  15.602 -  obtain h where "retraction s t h"
  15.603 +  obtain h where "retraction S T h"
  15.604      using assms(1) unfolding retract_of_def ..
  15.605    then show ?thesis
  15.606      unfolding retraction_def
  15.607 -    apply -
  15.608 -    apply (rule invertible_fixpoint_property[OF continuous_on_id _ _ _ _ assms(2), of t h g])
  15.609 -    prefer 7
  15.610 -    apply (rule_tac y = y in that)
  15.611 -    using assms
  15.612 -    apply auto
  15.613 -    done
  15.614 +    using invertible_fixpoint_property[OF continuous_on_id _ _ _ _ FP]
  15.615 +    by (metis assms(4) contg image_ident that)
  15.616  qed
  15.617  
  15.618  
  15.619  subsection \<open>The Brouwer theorem for any set with nonempty interior\<close>
  15.620  
  15.621  lemma convex_unit_cube: "convex unit_cube"
  15.622 -  apply (rule is_interval_convex)
  15.623 -  apply (clarsimp simp add: is_interval_def mem_unit_cube)
  15.624 -  apply (drule (1) bspec)+
  15.625 -  apply auto
  15.626 -  done
  15.627 +  by (rule is_interval_convex) (fastforce simp add: is_interval_def mem_unit_cube)
  15.628  
  15.629  lemma brouwer_weak:
  15.630    fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
  15.631 -  assumes "compact s"
  15.632 -    and "convex s"
  15.633 -    and "interior s \<noteq> {}"
  15.634 -    and "continuous_on s f"
  15.635 -    and "f ` s \<subseteq> s"
  15.636 -  obtains x where "x \<in> s" and "f x = x"
  15.637 +  assumes "compact S"
  15.638 +    and "convex S"
  15.639 +    and "interior S \<noteq> {}"
  15.640 +    and "continuous_on S f"
  15.641 +    and "f ` S \<subseteq> S"
  15.642 +  obtains x where "x \<in> S" and "f x = x"
  15.643  proof -
  15.644    let ?U = "unit_cube :: 'a set"
  15.645    have "\<Sum>Basis /\<^sub>R 2 \<in> interior ?U"
  15.646 @@ -1890,7 +1797,7 @@
  15.647        unfolding unit_cube_def by force
  15.648    qed
  15.649    then have *: "interior ?U \<noteq> {}" by fast
  15.650 -  have *: "?U homeomorphic s"
  15.651 +  have *: "?U homeomorphic S"
  15.652      using homeomorphic_convex_compact[OF convex_unit_cube compact_unit_cube * assms(2,1,3)] .
  15.653    have "\<forall>f. continuous_on ?U f \<and> f ` ?U \<subseteq> ?U \<longrightarrow>
  15.654      (\<exists>x\<in>?U. f x = x)"
  15.655 @@ -1898,7 +1805,7 @@
  15.656    then show ?thesis
  15.657      unfolding homeomorphic_fixpoint_property[OF *]
  15.658      using assms
  15.659 -    by (auto simp: intro: that)
  15.660 +    by (auto intro: that)
  15.661  qed
  15.662  
  15.663  
  15.664 @@ -1920,49 +1827,37 @@
  15.665  
  15.666  lemma brouwer:
  15.667    fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
  15.668 -  assumes "compact s"
  15.669 -    and "convex s"
  15.670 -    and "s \<noteq> {}"
  15.671 -    and "continuous_on s f"
  15.672 -    and "f ` s \<subseteq> s"
  15.673 -  obtains x where "x \<in> s" and "f x = x"
  15.674 +  assumes S: "compact S" "convex S" "S \<noteq> {}"
  15.675 +    and contf: "continuous_on S f"
  15.676 +    and fim: "f ` S \<subseteq> S"
  15.677 +  obtains x where "x \<in> S" and "f x = x"
  15.678  proof -
  15.679 -  have "\<exists>e>0. s \<subseteq> cball 0 e"
  15.680 -    using compact_imp_bounded[OF assms(1)]
  15.681 -    unfolding bounded_pos
  15.682 -    apply (erule_tac exE)
  15.683 -    apply (rule_tac x=b in exI)
  15.684 -    apply (auto simp add: dist_norm)
  15.685 -    done
  15.686 -  then obtain e where e: "e > 0" "s \<subseteq> cball 0 e"
  15.687 +  have "\<exists>e>0. S \<subseteq> cball 0 e"
  15.688 +    using compact_imp_bounded[OF \<open>compact S\<close>]  unfolding bounded_pos
  15.689 +    by auto
  15.690 +  then obtain e where e: "e > 0" "S \<subseteq> cball 0 e"
  15.691      by blast
  15.692 -  have "\<exists>x\<in> cball 0 e. (f \<circ> closest_point s) x = x"
  15.693 -    apply (rule_tac brouwer_ball[OF e(1), of 0 "f \<circ> closest_point s"])
  15.694 -    apply (rule continuous_on_compose )
  15.695 -    apply (rule continuous_on_closest_point[OF assms(2) compact_imp_closed[OF assms(1)] assms(3)])
  15.696 -    apply (rule continuous_on_subset[OF assms(4)])
  15.697 -    apply (insert closest_point_in_set[OF compact_imp_closed[OF assms(1)] assms(3)])
  15.698 -    using assms(5)[unfolded subset_eq]
  15.699 -    using e(2)[unfolded subset_eq mem_cball]
  15.700 -    apply (auto simp add: dist_norm)
  15.701 -    done
  15.702 -  then obtain x where x: "x \<in> cball 0 e" "(f \<circ> closest_point s) x = x" ..
  15.703 -  have *: "closest_point s x = x"
  15.704 -    apply (rule closest_point_self)
  15.705 -    apply (rule assms(5)[unfolded subset_eq,THEN bspec[where x="x"], unfolded image_iff])
  15.706 -    apply (rule_tac x="closest_point s x" in bexI)
  15.707 -    using x
  15.708 -    unfolding o_def
  15.709 -    using closest_point_in_set[OF compact_imp_closed[OF assms(1)] assms(3), of x]
  15.710 -    apply auto
  15.711 -    done
  15.712 +  have "\<exists>x\<in> cball 0 e. (f \<circ> closest_point S) x = x"
  15.713 +  proof (rule_tac brouwer_ball[OF e(1)])
  15.714 +    show "continuous_on (cball 0 e) (f \<circ> closest_point S)"
  15.715 +      apply (rule continuous_on_compose)
  15.716 +      using S compact_eq_bounded_closed continuous_on_closest_point apply blast
  15.717 +      by (meson S contf closest_point_in_set compact_imp_closed continuous_on_subset image_subsetI)
  15.718 +    show "(f \<circ> closest_point S) ` cball 0 e \<subseteq> cball 0 e"
  15.719 +      by clarsimp (metis S fim closest_point_exists(1) compact_eq_bounded_closed e(2) image_subset_iff mem_cball_0 subsetCE)
  15.720 +  qed (use assms in auto)
  15.721 +  then obtain x where x: "x \<in> cball 0 e" "(f \<circ> closest_point S) x = x" ..
  15.722 +  have "x \<in> S"
  15.723 +    by (metis closest_point_in_set comp_apply compact_imp_closed fim image_eqI S(1) S(3) subset_iff x(2))
  15.724 +  then have *: "closest_point S x = x"
  15.725 +    by (rule closest_point_self)
  15.726    show thesis
  15.727 -    apply (rule_tac x="closest_point s x" in that)
  15.728 -    unfolding x(2)[unfolded o_def]
  15.729 -    apply (rule closest_point_in_set[OF compact_imp_closed[OF assms(1)] assms(3)])
  15.730 -    using *
  15.731 -    apply auto
  15.732 -    done
  15.733 +  proof
  15.734 +    show "closest_point S x \<in> S"
  15.735 +      by (simp add: "*" \<open>x \<in> S\<close>)
  15.736 +    show "f (closest_point S x) = closest_point S x"
  15.737 +      using "*" x(2) by auto
  15.738 +  qed
  15.739  qed
  15.740  
  15.741  text \<open>So we get the no-retraction theorem.\<close>
  15.742 @@ -1975,17 +1870,15 @@
  15.743    assume *: "frontier (cball a e) retract_of (cball a e)"
  15.744    have **: "\<And>xa. a - (2 *\<^sub>R a - xa) = - (a - xa)"
  15.745      using scaleR_left_distrib[of 1 1 a] by auto
  15.746 -  obtain x where x:
  15.747 -      "x \<in> {x. norm (a - x) = e}"
  15.748 -      "2 *\<^sub>R a - x = x"
  15.749 -    apply (rule retract_fixpoint_property[OF *, of "\<lambda>x. scaleR 2 a - x"])
  15.750 -    apply (blast intro: brouwer_ball[OF assms])
  15.751 -    apply (intro continuous_intros)
  15.752 -    unfolding frontier_cball subset_eq Ball_def image_iff dist_norm sphere_def
  15.753 -    apply (auto simp add: ** norm_minus_commute)
  15.754 -    done
  15.755 +  obtain x where x: "x \<in> {x. norm (a - x) = e}" "2 *\<^sub>R a - x = x"
  15.756 +  proof (rule retract_fixpoint_property[OF *, of "\<lambda>x. scaleR 2 a - x"])
  15.757 +    show "continuous_on (frontier (cball a e)) ((-) (2 *\<^sub>R a))"
  15.758 +      by (intro continuous_intros)
  15.759 +    show "(-) (2 *\<^sub>R a) ` frontier (cball a e) \<subseteq> frontier (cball a e)"
  15.760 +      by clarsimp (metis "**" dist_norm norm_minus_cancel)
  15.761 +  qed (auto simp: dist_norm intro: brouwer_ball[OF assms])
  15.762    then have "scaleR 2 a = scaleR 1 x + scaleR 1 x"
  15.763 -    by (auto simp add: algebra_simps)
  15.764 +    by (auto simp: algebra_simps)
  15.765    then have "a = x"
  15.766      unfolding scaleR_left_distrib[symmetric]
  15.767      by auto
  15.768 @@ -2006,11 +1899,7 @@
  15.769    case False
  15.770    then show ?thesis
  15.771      unfolding contractible_def nullhomotopic_from_sphere_extension
  15.772 -    apply (simp add: not_less)
  15.773 -    apply (rule_tac x=id in exI)
  15.774 -    apply (auto simp: continuous_on_def)
  15.775 -    apply (meson dist_not_less_zero le_less less_le_trans)
  15.776 -    done
  15.777 +    using continuous_on_const less_eq_real_def by auto
  15.778  qed
  15.779  
  15.780  lemma connected_sphere_eq:
  15.781 @@ -2035,9 +1924,8 @@
  15.782          by (metis dist_self greater insertI1 less_add_same_cancel1 mem_sphere mult_2 not_le zero_le_dist)
  15.783        then have "finite (sphere a r)"
  15.784          by auto
  15.785 -      with L \<open>r > 0\<close> show "False"
  15.786 -        apply (auto simp: connected_finite_iff_sing)
  15.787 -        using xy by auto
  15.788 +      with L \<open>r > 0\<close> xy show "False"
  15.789 +        using connected_finite_iff_sing by auto
  15.790      qed
  15.791      with greater show ?rhs
  15.792        by (metis DIM_ge_Suc0 One_nat_def Suc_1 le_antisym not_less_eq_eq)
  15.793 @@ -2098,12 +1986,10 @@
  15.794      unfolding retraction_def
  15.795    proof (intro conjI ballI)
  15.796      show "frontier (cball a B) \<subseteq> cball a B"
  15.797 -      by (force simp:)
  15.798 +      by force
  15.799      show "continuous_on (cball a B) h"
  15.800        unfolding h_def
  15.801 -      apply (intro continuous_intros)
  15.802 -      using contg continuous_on_subset notga apply auto
  15.803 -      done
  15.804 +      by (intro continuous_intros) (use contg continuous_on_subset notga in auto)
  15.805      show "h ` cball a B \<subseteq> frontier (cball a B)"
  15.806        using \<open>0 < B\<close> by (auto simp: h_def notga dist_norm)
  15.807      show "\<And>x. x \<in> frontier (cball a B) \<Longrightarrow> h x = x"
  15.808 @@ -2117,76 +2003,76 @@
  15.809  subsection\<open>More Properties of Retractions\<close>
  15.810  
  15.811  lemma retraction:
  15.812 -   "retraction s t r \<longleftrightarrow>
  15.813 -    t \<subseteq> s \<and> continuous_on s r \<and> r ` s = t \<and> (\<forall>x \<in> t. r x = x)"
  15.814 +   "retraction S T r \<longleftrightarrow>
  15.815 +    T \<subseteq> S \<and> continuous_on S r \<and> r ` S = T \<and> (\<forall>x \<in> T. r x = x)"
  15.816  by (force simp: retraction_def)
  15.817  
  15.818  lemma retract_of_imp_extensible:
  15.819 -  assumes "s retract_of t" and "continuous_on s f" and "f ` s \<subseteq> u"
  15.820 -  obtains g where "continuous_on t g" "g ` t \<subseteq> u" "\<And>x. x \<in> s \<Longrightarrow> g x = f x"
  15.821 +  assumes "S retract_of T" and "continuous_on S f" and "f ` S \<subseteq> U"
  15.822 +  obtains g where "continuous_on T g" "g ` T \<subseteq> U" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
  15.823  using assms
  15.824  apply (clarsimp simp add: retract_of_def retraction)
  15.825 -apply (rule_tac g = "f o r" in that)
  15.826 +apply (rule_tac g = "f \<circ> r" in that)
  15.827  apply (auto simp: continuous_on_compose2)
  15.828  done
  15.829  
  15.830  lemma idempotent_imp_retraction:
  15.831 -  assumes "continuous_on s f" and "f ` s \<subseteq> s" and "\<And>x. x \<in> s \<Longrightarrow> f(f x) = f x"
  15.832 -    shows "retraction s (f ` s) f"
  15.833 +  assumes "continuous_on S f" and "f ` S \<subseteq> S" and "\<And>x. x \<in> S \<Longrightarrow> f(f x) = f x"
  15.834 +    shows "retraction S (f ` S) f"
  15.835  by (simp add: assms retraction)
  15.836  
  15.837  lemma retraction_subset:
  15.838 -  assumes "retraction s t r" and "t \<subseteq> s'" and "s' \<subseteq> s"
  15.839 -    shows "retraction s' t r"
  15.840 -apply (simp add: retraction_def)
  15.841 -by (metis assms continuous_on_subset image_mono retraction)
  15.842 +  assumes "retraction S T r" and "T \<subseteq> s'" and "s' \<subseteq> S"
  15.843 +  shows "retraction s' T r"
  15.844 +  unfolding retraction_def
  15.845 +  by (metis assms continuous_on_subset image_mono retraction)
  15.846  
  15.847  lemma retract_of_subset:
  15.848 -  assumes "t retract_of s" and "t \<subseteq> s'" and "s' \<subseteq> s"
  15.849 -    shows "t retract_of s'"
  15.850 +  assumes "T retract_of S" and "T \<subseteq> s'" and "s' \<subseteq> S"
  15.851 +    shows "T retract_of s'"
  15.852  by (meson assms retract_of_def retraction_subset)
  15.853  
  15.854 -lemma retraction_refl [simp]: "retraction s s (\<lambda>x. x)"
  15.855 +lemma retraction_refl [simp]: "retraction S S (\<lambda>x. x)"
  15.856  by (simp add: continuous_on_id retraction)
  15.857  
  15.858 -lemma retract_of_refl [iff]: "s retract_of s"
  15.859 +lemma retract_of_refl [iff]: "S retract_of S"
  15.860    using continuous_on_id retract_of_def retraction_def by fastforce
  15.861  
  15.862  lemma retract_of_imp_subset:
  15.863 -   "s retract_of t \<Longrightarrow> s \<subseteq> t"
  15.864 +   "S retract_of T \<Longrightarrow> S \<subseteq> T"
  15.865  by (simp add: retract_of_def retraction_def)
  15.866  
  15.867  lemma retract_of_empty [simp]:
  15.868 -     "({} retract_of s) \<longleftrightarrow> s = {}"  "(s retract_of {}) \<longleftrightarrow> s = {}"
  15.869 +     "({} retract_of S) \<longleftrightarrow> S = {}"  "(S retract_of {}) \<longleftrightarrow> S = {}"
  15.870  by (auto simp: retract_of_def retraction_def)
  15.871  
  15.872 -lemma retract_of_singleton [iff]: "({x} retract_of s) \<longleftrightarrow> x \<in> s"
  15.873 +lemma retract_of_singleton [iff]: "({x} retract_of S) \<longleftrightarrow> x \<in> S"
  15.874    using continuous_on_const
  15.875    by (auto simp: retract_of_def retraction_def)
  15.876  
  15.877  lemma retraction_comp:
  15.878 -   "\<lbrakk>retraction s t f; retraction t u g\<rbrakk>
  15.879 -        \<Longrightarrow> retraction s u (g o f)"
  15.880 +   "\<lbrakk>retraction S T f; retraction T U g\<rbrakk>
  15.881 +        \<Longrightarrow> retraction S U (g \<circ> f)"
  15.882  apply (auto simp: retraction_def intro: continuous_on_compose2)
  15.883  by blast
  15.884  
  15.885  lemma retract_of_trans [trans]:
  15.886 -  assumes "s retract_of t" and "t retract_of u"
  15.887 -    shows "s retract_of u"
  15.888 +  assumes "S retract_of T" and "T retract_of U"
  15.889 +    shows "S retract_of U"
  15.890  using assms by (auto simp: retract_of_def intro: retraction_comp)
  15.891  
  15.892  lemma closedin_retract:
  15.893 -  fixes s :: "'a :: real_normed_vector set"
  15.894 -  assumes "s retract_of t"
  15.895 -    shows "closedin (subtopology euclidean t) s"
  15.896 +  fixes S :: "'a :: real_normed_vector set"
  15.897 +  assumes "S retract_of T"
  15.898 +    shows "closedin (subtopology euclidean T) S"
  15.899  proof -
  15.900 -  obtain r where "s \<subseteq> t" "continuous_on t r" "r ` t \<subseteq> s" "\<And>x. x \<in> s \<Longrightarrow> r x = x"
  15.901 +  obtain r where "S \<subseteq> T" "continuous_on T r" "r ` T \<subseteq> S" "\<And>x. x \<in> S \<Longrightarrow> r x = x"
  15.902      using assms by (auto simp: retract_of_def retraction_def)
  15.903 -  then have s: "s = {x \<in> t. (norm(r x - x)) = 0}" by auto
  15.904 +  then have S: "S = {x \<in> T. (norm(r x - x)) = 0}" by auto
  15.905    show ?thesis
  15.906 -    apply (subst s)
  15.907 +    apply (subst S)
  15.908      apply (rule continuous_closedin_preimage_constant)
  15.909 -    by (simp add: \<open>continuous_on t r\<close> continuous_on_diff continuous_on_id continuous_on_norm)
  15.910 +    by (simp add: \<open>continuous_on T r\<close> continuous_on_diff continuous_on_id continuous_on_norm)
  15.911  qed
  15.912  
  15.913  lemma closedin_self [simp]:
  15.914 @@ -2195,52 +2081,52 @@
  15.915    by (simp add: closedin_retract)
  15.916  
  15.917  lemma retract_of_contractible:
  15.918 -  assumes "contractible t" "s retract_of t"
  15.919 -    shows "contractible s"
  15.920 +  assumes "contractible T" "S retract_of T"
  15.921 +    shows "contractible S"
  15.922  using assms
  15.923  apply (clarsimp simp add: retract_of_def contractible_def retraction_def homotopic_with)
  15.924  apply (rule_tac x="r a" in exI)
  15.925 -apply (rule_tac x="r o h" in exI)
  15.926 +apply (rule_tac x="r \<circ> h" in exI)
  15.927  apply (intro conjI continuous_intros continuous_on_compose)
  15.928  apply (erule continuous_on_subset | force)+
  15.929  done
  15.930  
  15.931  lemma retract_of_compact:
  15.932 -     "\<lbrakk>compact t; s retract_of t\<rbrakk> \<Longrightarrow> compact s"
  15.933 +     "\<lbrakk>compact T; S retract_of T\<rbrakk> \<Longrightarrow> compact S"
  15.934    by (metis compact_continuous_image retract_of_def retraction)
  15.935  
  15.936  lemma retract_of_closed:
  15.937 -    fixes s :: "'a :: real_normed_vector set"
  15.938 -    shows "\<lbrakk>closed t; s retract_of t\<rbrakk> \<Longrightarrow> closed s"
  15.939 +    fixes S :: "'a :: real_normed_vector set"
  15.940 +    shows "\<lbrakk>closed T; S retract_of T\<rbrakk> \<Longrightarrow> closed S"
  15.941    by (metis closedin_retract closedin_closed_eq)
  15.942  
  15.943  lemma retract_of_connected:
  15.944 -    "\<lbrakk>connected t; s retract_of t\<rbrakk> \<Longrightarrow> connected s"
  15.945 +    "\<lbrakk>connected T; S retract_of T\<rbrakk> \<Longrightarrow> connected S"
  15.946    by (metis Topological_Spaces.connected_continuous_image retract_of_def retraction)
  15.947  
  15.948  lemma retract_of_path_connected:
  15.949 -    "\<lbrakk>path_connected t; s retract_of t\<rbrakk> \<Longrightarrow> path_connected s"
  15.950 +    "\<lbrakk>path_connected T; S retract_of T\<rbrakk> \<Longrightarrow> path_connected S"
  15.951    by (metis path_connected_continuous_image retract_of_def retraction)
  15.952  
  15.953  lemma retract_of_simply_connected:
  15.954 -    "\<lbrakk>simply_connected t; s retract_of t\<rbrakk> \<Longrightarrow> simply_connected s"
  15.955 +    "\<lbrakk>simply_connected T; S retract_of T\<rbrakk> \<Longrightarrow> simply_connected S"
  15.956  apply (simp add: retract_of_def retraction_def, clarify)
  15.957  apply (rule simply_connected_retraction_gen)
  15.958  apply (force simp: continuous_on_id elim!: continuous_on_subset)+
  15.959  done
  15.960  
  15.961  lemma retract_of_homotopically_trivial:
  15.962 -  assumes ts: "t retract_of s"
  15.963 -      and hom: "\<And>f g. \<lbrakk>continuous_on u f; f ` u \<subseteq> s;
  15.964 -                       continuous_on u g; g ` u \<subseteq> s\<rbrakk>
  15.965 -                       \<Longrightarrow> homotopic_with (\<lambda>x. True) u s f g"
  15.966 -      and "continuous_on u f" "f ` u \<subseteq> t"
  15.967 -      and "continuous_on u g" "g ` u \<subseteq> t"
  15.968 -    shows "homotopic_with (\<lambda>x. True) u t f g"
  15.969 +  assumes ts: "T retract_of S"
  15.970 +      and hom: "\<And>f g. \<lbrakk>continuous_on U f; f ` U \<subseteq> S;
  15.971 +                       continuous_on U g; g ` U \<subseteq> S\<rbrakk>
  15.972 +                       \<Longrightarrow> homotopic_with (\<lambda>x. True) U S f g"
  15.973 +      and "continuous_on U f" "f ` U \<subseteq> T"
  15.974 +      and "continuous_on U g" "g ` U \<subseteq> T"
  15.975 +    shows "homotopic_with (\<lambda>x. True) U T f g"
  15.976  proof -
  15.977 -  obtain r where "r ` s \<subseteq> s" "continuous_on s r" "\<forall>x\<in>s. r (r x) = r x" "t = r ` s"
  15.978 +  obtain r where "r ` S \<subseteq> S" "continuous_on S r" "\<forall>x\<in>S. r (r x) = r x" "T = r ` S"
  15.979      using ts by (auto simp: retract_of_def retraction)
  15.980 -  then obtain k where "Retracts s r t k"
  15.981 +  then obtain k where "Retracts S r T k"
  15.982      unfolding Retracts_def
  15.983      by (metis continuous_on_subset dual_order.trans image_iff image_mono)
  15.984    then show ?thesis
  15.985 @@ -2251,15 +2137,15 @@
  15.986  qed
  15.987  
  15.988  lemma retract_of_homotopically_trivial_null:
  15.989 -  assumes ts: "t retract_of s"
  15.990 -      and hom: "\<And>f. \<lbrakk>continuous_on u f; f ` u \<subseteq> s\<rbrakk>
  15.991 -                     \<Longrightarrow> \<exists>c. homotopic_with (\<lambda>x. True) u s f (\<lambda>x. c)"
  15.992 -      and "continuous_on u f" "f ` u \<subseteq> t"
  15.993 -  obtains c where "homotopic_with (\<lambda>x. True) u t f (\<lambda>x. c)"
  15.994 +  assumes ts: "T retract_of S"
  15.995 +      and hom: "\<And>f. \<lbrakk>continuous_on U f; f ` U \<subseteq> S\<rbrakk>
  15.996 +                     \<Longrightarrow> \<exists>c. homotopic_with (\<lambda>x. True) U S f (\<lambda>x. c)"
  15.997 +      and "continuous_on U f" "f ` U \<subseteq> T"
  15.998 +  obtains c where "homotopic_with (\<lambda>x. True) U T f (\<lambda>x. c)"
  15.999  proof -
 15.1000 -  obtain r where "r ` s \<subseteq> s" "continuous_on s r" "\<forall>x\<in>s. r (r x) = r x" "t = r ` s"
 15.1001 +  obtain r where "r ` S \<subseteq> S" "continuous_on S r" "\<forall>x\<in>S. r (r x) = r x" "T = r ` S"
 15.1002      using ts by (auto simp: retract_of_def retraction)
 15.1003 -  then obtain k where "Retracts s r t k"
 15.1004 +  then obtain k where "Retracts S r T k"
 15.1005      unfolding Retracts_def
 15.1006      by (metis continuous_on_subset dual_order.trans image_iff image_mono)
 15.1007    then show ?thesis
 15.1008 @@ -2269,35 +2155,34 @@
 15.1009  qed
 15.1010  
 15.1011  lemma retraction_imp_quotient_map:
 15.1012 -   "retraction s t r
 15.1013 -    \<Longrightarrow> u \<subseteq> t
 15.1014 -            \<Longrightarrow> (openin (subtopology euclidean s) (s \<inter> r -` u) \<longleftrightarrow>
 15.1015 -                 openin (subtopology euclidean t) u)"
 15.1016 +   "retraction S T r
 15.1017 +    \<Longrightarrow> U \<subseteq> T
 15.1018 +            \<Longrightarrow> (openin (subtopology euclidean S) (S \<inter> r -` U) \<longleftrightarrow>
 15.1019 +                 openin (subtopology euclidean T) U)"
 15.1020  apply (clarsimp simp add: retraction)
 15.1021  apply (rule continuous_right_inverse_imp_quotient_map [where g=r])
 15.1022  apply (auto simp: elim: continuous_on_subset)
 15.1023  done
 15.1024  
 15.1025  lemma retract_of_locally_compact:
 15.1026 -    fixes s :: "'a :: {heine_borel,real_normed_vector} set"
 15.1027 -    shows  "\<lbrakk> locally compact s; t retract_of s\<rbrakk> \<Longrightarrow> locally compact t"
 15.1028 +    fixes S :: "'a :: {heine_borel,real_normed_vector} set"
 15.1029 +    shows  "\<lbrakk> locally compact S; T retract_of S\<rbrakk> \<Longrightarrow> locally compact T"
 15.1030    by (metis locally_compact_closedin closedin_retract)
 15.1031  
 15.1032  lemma retract_of_Times:
 15.1033 -   "\<lbrakk>s retract_of s'; t retract_of t'\<rbrakk> \<Longrightarrow> (s \<times> t) retract_of (s' \<times> t')"
 15.1034 +   "\<lbrakk>S retract_of s'; T retract_of t'\<rbrakk> \<Longrightarrow> (S \<times> T) retract_of (s' \<times> t')"
 15.1035  apply (simp add: retract_of_def retraction_def Sigma_mono, clarify)
 15.1036  apply (rename_tac f g)
 15.1037 -apply (rule_tac x="\<lambda>z. ((f o fst) z, (g o snd) z)" in exI)
 15.1038 +apply (rule_tac x="\<lambda>z. ((f \<circ> fst) z, (g \<circ> snd) z)" in exI)
 15.1039  apply (rule conjI continuous_intros | erule continuous_on_subset | force)+
 15.1040  done
 15.1041  
 15.1042  lemma homotopic_into_retract:
 15.1043 -   "\<lbrakk>f ` s \<subseteq> t; g ` s \<subseteq> t; t retract_of u;
 15.1044 -        homotopic_with (\<lambda>x. True) s u f g\<rbrakk>
 15.1045 -        \<Longrightarrow> homotopic_with (\<lambda>x. True) s t f g"
 15.1046 +   "\<lbrakk>f ` S \<subseteq> T; g ` S \<subseteq> T; T retract_of U; homotopic_with (\<lambda>x. True) S U f g\<rbrakk>
 15.1047 +        \<Longrightarrow> homotopic_with (\<lambda>x. True) S T f g"
 15.1048  apply (subst (asm) homotopic_with_def)
 15.1049  apply (simp add: homotopic_with retract_of_def retraction_def, clarify)
 15.1050 -apply (rule_tac x="r o h" in exI)
 15.1051 +apply (rule_tac x="r \<circ> h" in exI)
 15.1052  apply (rule conjI continuous_intros | erule continuous_on_subset | force simp: image_subset_iff)+
 15.1053  done
 15.1054  
 15.1055 @@ -2317,15 +2202,19 @@
 15.1056  
 15.1057  lemma deformation_retract_imp_homotopy_eqv:
 15.1058    fixes S :: "'a::euclidean_space set"
 15.1059 -  assumes "homotopic_with (\<lambda>x. True) S S id r" "retraction S T r"
 15.1060 -    shows "S homotopy_eqv T"
 15.1061 -  apply (simp add: homotopy_eqv_def)
 15.1062 -  apply (rule_tac x=r in exI)
 15.1063 -  using assms apply (simp add: retraction_def)
 15.1064 -  apply (rule_tac x=id in exI)
 15.1065 -  apply (auto simp: continuous_on_id)
 15.1066 -   apply (metis homotopic_with_symD)
 15.1067 -  by (metis continuous_on_id' homotopic_with_equal homotopic_with_symD id_apply image_id subset_refl)
 15.1068 +  assumes "homotopic_with (\<lambda>x. True) S S id r" and r: "retraction S T r"
 15.1069 +  shows "S homotopy_eqv T"
 15.1070 +proof -
 15.1071 +  have "homotopic_with (\<lambda>x. True) S S (id \<circ> r) id"
 15.1072 +    by (simp add: assms(1) homotopic_with_symD)
 15.1073 +  moreover have "homotopic_with (\<lambda>x. True) T T (r \<circ> id) id"
 15.1074 +    using r unfolding retraction_def
 15.1075 +    by (metis (no_types, lifting) comp_id continuous_on_id' homotopic_with_equal homotopic_with_symD id_def image_id order_refl)
 15.1076 +  ultimately
 15.1077 +  show ?thesis
 15.1078 +    unfolding homotopy_eqv_def
 15.1079 +    by (metis continuous_on_id' id_def image_id r retraction_def)
 15.1080 +qed
 15.1081  
 15.1082  lemma deformation_retract:
 15.1083    fixes S :: "'a::euclidean_space set"
 15.1084 @@ -2356,10 +2245,8 @@
 15.1085    have "{a} retract_of S"
 15.1086      by (simp add: \<open>a \<in> S\<close>)
 15.1087    moreover have "homotopic_with (\<lambda>x. True) S S id (\<lambda>x. a)"
 15.1088 -    using assms
 15.1089 -    apply (clarsimp simp add: contractible_def)
 15.1090 -    apply (rule homotopic_with_trans, assumption)
 15.1091 -    by (metis assms(1) contractible_imp_path_connected homotopic_constant_maps homotopic_with_sym homotopic_with_trans insert_absorb insert_not_empty path_component_mem(1) path_connected_component)
 15.1092 +      using assms
 15.1093 +      by (auto simp: contractible_def continuous_on_const continuous_on_id homotopic_into_contractible image_subset_iff)
 15.1094    moreover have "(\<lambda>x. a) ` S \<subseteq> {a}"
 15.1095      by (simp add: image_subsetI)
 15.1096    ultimately show ?thesis
 15.1097 @@ -2382,15 +2269,12 @@
 15.1098      using assms by auto (metis imageI subset_iff)
 15.1099    have contp': "continuous_on S p"
 15.1100      by (rule continuous_on_subset [OF contp \<open>S \<subseteq> T\<close>])
 15.1101 -  have "continuous_on T (q \<circ> p)"
 15.1102 -    apply (rule continuous_on_compose [OF contp])
 15.1103 -    apply (simp add: *)
 15.1104 -    apply (rule continuous_on_inv [OF contp' \<open>compact S\<close>])
 15.1105 -    using assms by auto
 15.1106 +  have "continuous_on (p ` T) q"
 15.1107 +    by (simp add: "*" assms(1) assms(2) assms(5) continuous_on_inv contp' rev_subsetD)
 15.1108 +  then have "continuous_on T (q \<circ> p)"
 15.1109 +    by (rule continuous_on_compose [OF contp])
 15.1110    then show ?thesis
 15.1111 -    apply (rule continuous_on_eq [of _ "q o p"])
 15.1112 -    apply (simp add: o_def)
 15.1113 -    done
 15.1114 +    by (rule continuous_on_eq [of _ "q \<circ> p"]) (simp add: o_def)
 15.1115  qed
 15.1116  
 15.1117  lemma continuous_on_compact_surface_projection:
 15.1118 @@ -2441,21 +2325,19 @@
 15.1119    have aaffS: "a \<in> affine hull S"
 15.1120      by (meson arelS subsetD hull_inc rel_interior_subset)
 15.1121    have "((\<lambda>z. z - a) ` (affine hull S - {a})) = ((\<lambda>z. z - a) ` (affine hull S)) - {0}"
 15.1122 -    by (auto simp: )
 15.1123 +    by auto
 15.1124    moreover have "continuous_on (((\<lambda>z. z - a) ` (affine hull S)) - {0}) (\<lambda>x. dd x *\<^sub>R x)"
 15.1125    proof (rule continuous_on_compact_surface_projection)
 15.1126      show "compact (rel_frontier ((\<lambda>z. z - a) ` S))"
 15.1127        by (simp add: \<open>bounded S\<close> bounded_translation_minus compact_rel_frontier_bounded)
 15.1128      have releq: "rel_frontier ((\<lambda>z. z - a) ` S) = (\<lambda>z. z - a) ` rel_frontier S"
 15.1129        using rel_frontier_translation [of "-a"] add.commute by simp
 15.1130 -    also have "... \<subseteq> (\<lambda>z. z - a) ` (affine hull S) - {0}"
 15.1131 +    also have "\<dots> \<subseteq> (\<lambda>z. z - a) ` (affine hull S) - {0}"
 15.1132        using rel_frontier_affine_hull arelS rel_frontier_def by fastforce
 15.1133      finally show "rel_frontier ((\<lambda>z. z - a) ` S) \<subseteq> (\<lambda>z. z - a) ` (affine hull S) - {0}" .
 15.1134      show "cone ((\<lambda>z. z - a) ` (affine hull S))"
 15.1135 -      apply (rule subspace_imp_cone)
 15.1136 -      using aaffS
 15.1137 -      apply (simp add: subspace_affine image_comp o_def affine_translation_aux [of a])
 15.1138 -      done
 15.1139 +      by (rule subspace_imp_cone)
 15.1140 +         (use aaffS in \<open>simp add: subspace_affine image_comp o_def affine_translation_aux [of a]\<close>)
 15.1141      show "(0 < k \<and> k *\<^sub>R x \<in> rel_frontier ((\<lambda>z. z - a) ` S)) \<longleftrightarrow> (dd x = k)"
 15.1142           if x: "x \<in> (\<lambda>z. z - a) ` (affine hull S) - {0}" for k x
 15.1143      proof
 15.1144 @@ -2471,7 +2353,7 @@
 15.1145          then have segsub: "open_segment a (a + k *\<^sub>R x) \<subseteq> rel_interior S"
 15.1146            by (metis rel_interior_closure_convex_segment [OF \<open>convex S\<close> arelS])
 15.1147          have "x \<noteq> 0" and xaffS: "a + x \<in> affine hull S"
 15.1148 -          using x by (auto simp: )
 15.1149 +          using x by auto
 15.1150          then have "0 < dd x" and inS: "a + dd x *\<^sub>R x \<in> rel_frontier S"
 15.1151            using dd1 by auto
 15.1152          moreover have "a + dd x *\<^sub>R x \<in> open_segment a (a + k *\<^sub>R x)"
 15.1153 @@ -2483,7 +2365,7 @@
 15.1154            apply (metis (no_types) \<open>k \<noteq> 0\<close> divide_inverse_commute inverse_eq_divide mult.left_commute right_inverse)
 15.1155            done
 15.1156          ultimately show ?thesis
 15.1157 -          using segsub by (auto simp add: rel_frontier_def)
 15.1158 +          using segsub by (auto simp: rel_frontier_def)
 15.1159        qed
 15.1160        moreover have False if "k < dd x"
 15.1161          using x k that rel_frontier_def
 15.1162 @@ -2497,7 +2379,7 @@
 15.1163    have "continuous_on (affine hull S - {a}) ((\<lambda>x. a + dd x *\<^sub>R x) \<circ> (\<lambda>z. z - a))"
 15.1164      by (intro * continuous_intros continuous_on_compose)
 15.1165    with affS have contdd: "continuous_on (T - {a}) ((\<lambda>x. a + dd x *\<^sub>R x) \<circ> (\<lambda>z. z - a))"
 15.1166 -    by (blast intro: continuous_on_subset elim: )
 15.1167 +    by (blast intro: continuous_on_subset)
 15.1168    show ?thesis
 15.1169    proof
 15.1170      show "homotopic_with (\<lambda>x. True) (T - {a}) (T - {a}) id (\<lambda>x. a + dd (x - a) *\<^sub>R (x - a))"
 15.1171 @@ -2510,11 +2392,10 @@
 15.1172             if "x \<in> T - {a}" for x
 15.1173        proof (clarsimp simp: in_segment, intro conjI)
 15.1174          fix u::real assume u: "0 \<le> u" "u \<le> 1"
 15.1175 -        show "(1 - u) *\<^sub>R x + u *\<^sub>R (a + dd (x - a) *\<^sub>R (x - a)) \<in> T"
 15.1176 -          apply (rule convexD [OF \<open>convex T\<close>])
 15.1177 -          using that u apply (auto simp add: )
 15.1178 -          apply (metis add.commute affS dd1 diff_add_cancel eq_iff_diff_eq_0 relS subsetD)
 15.1179 -          done
 15.1180 +        have "a + dd (x - a) *\<^sub>R (x - a) \<in> T"
 15.1181 +          by (metis DiffD1 DiffD2 add.commute add.right_neutral affS dd1 diff_add_cancel relS singletonI subsetCE that)
 15.1182 +        then show "(1 - u) *\<^sub>R x + u *\<^sub>R (a + dd (x - a) *\<^sub>R (x - a)) \<in> T"
 15.1183 +          using convexD [OF \<open>convex T\<close>] that u by simp
 15.1184          have iff: "(1 - u) *\<^sub>R x + u *\<^sub>R (a + d *\<^sub>R (x - a)) = a \<longleftrightarrow>
 15.1185                    (1 - u + u * d) *\<^sub>R (x - a) = 0" for d
 15.1186            by (auto simp: algebra_simps)
 15.1187 @@ -2541,7 +2422,7 @@
 15.1188        show "a + dd (x - a) *\<^sub>R (x - a) = x" if x: "x \<in> rel_frontier S" for x
 15.1189        proof -
 15.1190          have "x \<noteq> a"
 15.1191 -          using that arelS by (auto simp add: rel_frontier_def)
 15.1192 +          using that arelS by (auto simp: rel_frontier_def)
 15.1193          have False if "dd (x - a) < 1"
 15.1194          proof -
 15.1195            have "x \<in> closure S"
 15.1196 @@ -2551,7 +2432,7 @@
 15.1197            have  xaffS: "x \<in> affine hull S"
 15.1198              using affS relS x by auto
 15.1199            then have "0 < dd (x - a)" and inS: "a + dd (x - a) *\<^sub>R (x - a) \<in> rel_frontier S"
 15.1200 -            using dd1 by (auto simp add: \<open>x \<noteq> a\<close>)
 15.1201 +            using dd1 by (auto simp: \<open>x \<noteq> a\<close>)
 15.1202            moreover have "a + dd (x - a) *\<^sub>R (x - a) \<in> open_segment a x"
 15.1203              using  \<open>x \<noteq> a\<close> \<open>0 < dd (x - a)\<close>
 15.1204              apply (simp add: in_segment)
 15.1205 @@ -2559,7 +2440,7 @@
 15.1206              apply (simp add: algebra_simps that)
 15.1207              done
 15.1208            ultimately show ?thesis
 15.1209 -            using segsub by (auto simp add: rel_frontier_def)
 15.1210 +            using segsub by (auto simp: rel_frontier_def)
 15.1211          qed
 15.1212          moreover have False if "1 < dd (x - a)"
 15.1213            using x that dd2 [of "x - a" 1] \<open>x \<noteq> a\<close> closure_affine_hull
 15.1214 @@ -2578,7 +2459,7 @@
 15.1215    assumes "bounded S" "convex S" "a \<in> rel_interior S"
 15.1216      shows "rel_frontier S retract_of (affine hull S - {a})"
 15.1217  apply (rule rel_frontier_deformation_retract_of_punctured_convex [of S "affine hull S" a])
 15.1218 -apply (auto simp add: affine_imp_convex rel_frontier_affine_hull retract_of_def assms)
 15.1219 +apply (auto simp: affine_imp_convex rel_frontier_affine_hull retract_of_def assms)
 15.1220  done
 15.1221  
 15.1222  corollary rel_boundary_retract_of_punctured_affine_hull:
 15.1223 @@ -2643,7 +2524,7 @@
 15.1224      using assms by (auto simp: path_component_def)
 15.1225    then show ?thesis
 15.1226      apply (simp add: path_def path_image_def pathstart_def pathfinish_def homotopic_with_def)
 15.1227 -    apply (rule_tac x = "\<lambda>z. inverse(norm(snd z - (g o fst)z)) *\<^sub>R (snd z - (g o fst)z)" in exI)
 15.1228 +    apply (rule_tac x = "\<lambda>z. inverse(norm(snd z - (g \<circ> fst)z)) *\<^sub>R (snd z - (g \<circ> fst)z)" in exI)
 15.1229      apply (intro conjI continuous_intros)
 15.1230      apply (rule continuous_intros | erule continuous_on_subset | fastforce simp: divide_simps sphere_def)+
 15.1231      done
 15.1232 @@ -2767,7 +2648,7 @@
 15.1233      using hom by (force simp: homeomorphic_def)
 15.1234    then have "continuous_on (f ` T) g"
 15.1235      by (meson \<open>f ` T \<subseteq> S\<close> continuous_on_subset homeomorphism_def)
 15.1236 -  then have contgf: "continuous_on T (g o f)"
 15.1237 +  then have contgf: "continuous_on T (g \<circ> f)"
 15.1238      by (metis continuous_on_compose contf)
 15.1239    have gfTC: "(g \<circ> f) ` T \<subseteq> C"
 15.1240    proof -
 15.1241 @@ -2779,7 +2660,7 @@
 15.1242                        "\<And>x. x \<in> T \<Longrightarrow> f' x = (g \<circ> f) x"
 15.1243      by (metis Dugundji [OF C cloUT contgf gfTC])
 15.1244    show ?thesis
 15.1245 -  proof (rule_tac g = "h o r o f'" in that)
 15.1246 +  proof (rule_tac g = "h \<circ> r \<circ> f'" in that)
 15.1247      show "continuous_on U (h \<circ> r \<circ> f')"
 15.1248        apply (intro continuous_on_compose f')
 15.1249         using continuous_on_subset contr f' apply blast
 15.1250 @@ -2811,7 +2692,7 @@
 15.1251    have [simp]: "S' \<subseteq> U" using clo closedin_limpt by blast
 15.1252    show ?thesis
 15.1253    proof (simp add: retraction_def retract_of_def, intro exI conjI)
 15.1254 -    show "continuous_on U (g o h')"
 15.1255 +    show "continuous_on U (g \<circ> h')"
 15.1256        apply (intro continuous_on_compose h')
 15.1257        apply (meson hom continuous_on_subset h' homeomorphism_cont1)
 15.1258        done
 15.1259 @@ -2853,7 +2734,7 @@
 15.1260      using clo closedin_imp_subset by auto
 15.1261    show "T retract_of U"
 15.1262    proof (simp add: retraction_def retract_of_def, intro exI conjI)
 15.1263 -    show "continuous_on U (g o h')"
 15.1264 +    show "continuous_on U (g \<circ> h')"
 15.1265        apply (intro continuous_on_compose h')
 15.1266        apply (meson hom continuous_on_subset h' homeomorphism_cont1)
 15.1267        done
 15.1268 @@ -2919,7 +2800,7 @@
 15.1269      using hom by (force simp: homeomorphic_def)
 15.1270    have "continuous_on (f ` T) g"
 15.1271      by (meson \<open>f ` T \<subseteq> S\<close> continuous_on_subset homeomorphism_def homgh)
 15.1272 -  then have contgf: "continuous_on T (g o f)"
 15.1273 +  then have contgf: "continuous_on T (g \<circ> f)"
 15.1274      by (intro continuous_on_compose contf)
 15.1275    have gfTC: "(g \<circ> f) ` T \<subseteq> C"
 15.1276    proof -
 15.1277 @@ -2933,7 +2814,7 @@
 15.1278                and eq: "\<And>x. x \<in> T \<Longrightarrow> f' x = (g \<circ> f) x"
 15.1279      by (metis Dugundji [OF C cloUT contgf gfTC])
 15.1280    show ?thesis
 15.1281 -  proof (rule_tac V = "U \<inter> f' -` D" and g = "h o r o f'" in that)
 15.1282 +  proof (rule_tac V = "U \<inter> f' -` D" and g = "h \<circ> r \<circ> f'" in that)
 15.1283      show "T \<subseteq> U \<inter> f' -` D"
 15.1284        using cloUT closedin_imp_subset \<open>S' \<subseteq> D\<close> \<open>f ` T \<subseteq> S\<close> eq homeomorphism_image1 homgh
 15.1285        by fastforce
 15.1286 @@ -2976,7 +2857,7 @@
 15.1287      by (blast intro: ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> h clo])
 15.1288    have "S' retract_of V"
 15.1289    proof (simp add: retraction_def retract_of_def, intro exI conjI \<open>S' \<subseteq> V\<close>)
 15.1290 -    show "continuous_on V (g o h')"
 15.1291 +    show "continuous_on V (g \<circ> h')"
 15.1292        apply (intro continuous_on_compose h')
 15.1293        apply (meson hom continuous_on_subset h' homeomorphism_cont1)
 15.1294        done
 15.1295 @@ -3029,7 +2910,7 @@
 15.1296      using clo closedin_imp_subset by auto
 15.1297    have "T retract_of V"
 15.1298    proof (simp add: retraction_def retract_of_def, intro exI conjI \<open>T \<subseteq> V\<close>)
 15.1299 -    show "continuous_on V (g o h')"
 15.1300 +    show "continuous_on V (g \<circ> h')"
 15.1301        apply (intro continuous_on_compose h')
 15.1302        apply (meson hom continuous_on_subset h' homeomorphism_cont1)
 15.1303        done
 15.1304 @@ -3086,7 +2967,7 @@
 15.1305      using Diff_subset_conv \<open>U - Z \<subseteq> W\<close> by blast
 15.1306    ultimately show ?thesis
 15.1307      apply (rule_tac V=V and W = "U-W" in that)
 15.1308 -    using openin_imp_subset apply (force simp:)+
 15.1309 +    using openin_imp_subset apply force+
 15.1310      done
 15.1311  qed
 15.1312  
 15.1313 @@ -3146,7 +3027,7 @@
 15.1314    proof (simp add: retraction_def retract_of_def, intro exI conjI)
 15.1315      show "S' \<subseteq> W" "S' \<subseteq> h -` X"
 15.1316        using him WS' closedin_imp_subset by blast+
 15.1317 -    show "continuous_on (W \<inter> h -` X) (f o r o h)"
 15.1318 +    show "continuous_on (W \<inter> h -` X) (f \<circ> r \<circ> h)"
 15.1319      proof (intro continuous_on_compose)
 15.1320        show "continuous_on (W \<inter> h -` X) h"
 15.1321          by (meson conth continuous_on_subset inf_le1)
 15.1322 @@ -3356,7 +3237,7 @@
 15.1323  apply (clarsimp elim!: all_forward)
 15.1324  apply (erule impCE, metis subset_trans)
 15.1325  apply (clarsimp elim!: ex_forward)
 15.1326 -apply (rule_tac x="r o g" in exI)
 15.1327 +apply (rule_tac x="r \<circ> g" in exI)
 15.1328  by (metis comp_apply continuous_on_compose continuous_on_subset subsetD imageI image_comp image_mono subset_trans)
 15.1329  
 15.1330  lemma AR_retract_of_AR:
 15.1331 @@ -3642,7 +3523,7 @@
 15.1332    obtain r0
 15.1333      where "S \<inter> T \<subseteq> W0" and contr0: "continuous_on W0 r0" and "r0 ` W0 \<subseteq> S \<inter> T"
 15.1334        and r0 [simp]: "\<And>x. x \<in> S \<inter> T \<Longrightarrow> r0 x = x"
 15.1335 -    using ret  by (force simp add: retract_of_def retraction_def)
 15.1336 +    using ret  by (force simp: retract_of_def retraction_def)
 15.1337    have ST: "x \<in> W \<Longrightarrow> x \<in> S \<longleftrightarrow> x \<in> T" for x
 15.1338      using assms by (auto simp: W_def setdist_sing_in_set dest!: setdist_eq_0_closedin)
 15.1339    define r where "r \<equiv> \<lambda>x. if x \<in> W0 then r0 x else x"
 15.1340 @@ -3667,8 +3548,7 @@
 15.1341                  and opeSW1: "openin (subtopology euclidean S') W1"
 15.1342                  and "g ` W1 \<subseteq> S" and geqr: "\<And>x. x \<in> W0 \<union> S \<Longrightarrow> g x = r x"
 15.1343      apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR S\<close> _ \<open>r ` (W0 \<union> S) \<subseteq> S\<close> cloS'WS])
 15.1344 -     apply (rule continuous_on_subset [OF contr])
 15.1345 -    apply (blast intro:  elim: )+
 15.1346 +     apply (rule continuous_on_subset [OF contr], blast+)
 15.1347      done
 15.1348    have cloT'WT: "closedin (subtopology euclidean T') (W0 \<union> T)"
 15.1349      by (meson closedin_subset_trans UT cloUT' \<open>T \<subseteq> T'\<close> \<open>W \<subseteq> T'\<close> cloUW cloWW0 
 15.1350 @@ -3677,13 +3557,12 @@
 15.1351                  and opeSW2: "openin (subtopology euclidean T') W2"
 15.1352                  and "h ` W2 \<subseteq> T" and heqr: "\<And>x. x \<in> W0 \<union> T \<Longrightarrow> h x = r x"
 15.1353      apply (rule ANR_imp_absolute_neighbourhood_extensor [OF \<open>ANR T\<close> _ \<open>r ` (W0 \<union> T) \<subseteq> T\<close> cloT'WT])
 15.1354 -     apply (rule continuous_on_subset [OF contr])
 15.1355 -    apply (blast intro:  elim: )+
 15.1356 +     apply (rule continuous_on_subset [OF contr], blast+)
 15.1357      done
 15.1358    have "S' \<inter> T' = W"
 15.1359      by (force simp: S'_def T'_def W_def)
 15.1360    obtain O1 O2 where "open O1" "W1 = S' \<inter> O1" "open O2" "W2 = T' \<inter> O2"
 15.1361 -    using opeSW1 opeSW2 by (force simp add: openin_open)
 15.1362 +    using opeSW1 opeSW2 by (force simp: openin_open)
 15.1363    show ?thesis
 15.1364    proof
 15.1365      have eq: "W1 - (W - U0) \<union> (W2 - (W - U0)) =
 15.1366 @@ -3692,25 +3571,23 @@
 15.1367        by (auto simp: \<open>S' \<union> T' = U\<close> [symmetric] \<open>S' \<inter> T' = W\<close> [symmetric] \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close>)
 15.1368      show "openin (subtopology euclidean U) (W1 - (W - U0) \<union> (W2 - (W - U0)))"
 15.1369        apply (subst eq)
 15.1370 -      apply (intro openin_Un openin_Int_open openin_diff closedin_diff cloUW opeUU0 cloUS' cloUT' \<open>open O1\<close> \<open>open O2\<close>)
 15.1371 -      apply simp_all
 15.1372 +      apply (intro openin_Un openin_Int_open openin_diff closedin_diff cloUW opeUU0 cloUS' cloUT' \<open>open O1\<close> \<open>open O2\<close>, simp_all)
 15.1373        done
 15.1374      have cloW1: "closedin (subtopology euclidean (W1 - (W - U0) \<union> (W2 - (W - U0)))) (W1 - (W - U0))"
 15.1375        using cloUS' apply (simp add: closedin_closed)
 15.1376        apply (erule ex_forward)
 15.1377        using U0 \<open>W0 \<union> S \<subseteq> W1\<close>
 15.1378 -      apply (auto simp add: \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<union> T' = U\<close> [symmetric]\<open>S' \<inter> T' = W\<close> [symmetric])
 15.1379 +      apply (auto simp: \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<union> T' = U\<close> [symmetric]\<open>S' \<inter> T' = W\<close> [symmetric])
 15.1380        done
 15.1381      have cloW2: "closedin (subtopology euclidean (W1 - (W - U0) \<union> (W2 - (W - U0)))) (W2 - (W - U0))"
 15.1382        using cloUT' apply (simp add: closedin_closed)
 15.1383        apply (erule ex_forward)
 15.1384        using U0 \<open>W0 \<union> T \<subseteq> W2\<close>
 15.1385 -      apply (auto simp add: \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<union> T' = U\<close> [symmetric]\<open>S' \<inter> T' = W\<close> [symmetric])
 15.1386 +      apply (auto simp: \<open>W1 = S' \<inter> O1\<close> \<open>W2 = T' \<inter> O2\<close> \<open>S' \<union> T' = U\<close> [symmetric]\<open>S' \<inter> T' = W\<close> [symmetric])
 15.1387        done
 15.1388      have *: "\<forall>x\<in>S \<union> T. (if x \<in> S' then g x else h x) = x"
 15.1389        using ST \<open>S' \<inter> T' = W\<close> cloT'WT closedin_subset geqr heqr 
 15.1390 -      apply (auto simp: r_def)
 15.1391 -       apply fastforce
 15.1392 +      apply (auto simp: r_def, fastforce)
 15.1393        using \<open>S \<subseteq> S'\<close> \<open>T \<subseteq> T'\<close> \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W1 = S' \<inter> O1\<close>  by auto
 15.1394      have "\<exists>r. continuous_on (W1 - (W - U0) \<union> (W2 - (W - U0))) r \<and>
 15.1395                r ` (W1 - (W - U0) \<union> (W2 - (W - U0))) \<subseteq> S \<union> T \<and> 
 15.1396 @@ -3725,7 +3602,7 @@
 15.1397        done
 15.1398      then show "S \<union> T retract_of W1 - (W - U0) \<union> (W2 - (W - U0))"
 15.1399        using  \<open>W0 \<union> S \<subseteq> W1\<close> \<open>W0 \<union> T \<subseteq> W2\<close> ST opeUU0 U0
 15.1400 -      by (auto simp add: retract_of_def retraction_def)
 15.1401 +      by (auto simp: retract_of_def retraction_def)
 15.1402    qed
 15.1403  qed
 15.1404  
 15.1405 @@ -4059,15 +3936,15 @@
 15.1406      by (auto simp: closest_point_self)
 15.1407    have "rel_frontier S retract_of affine hull S - {a}"
 15.1408      by (simp add: assms a rel_frontier_retract_of_punctured_affine_hull)
 15.1409 -  also have "... retract_of {x. closest_point (affine hull S) x \<noteq> a}"
 15.1410 +  also have "\<dots> retract_of {x. closest_point (affine hull S) x \<noteq> a}"
 15.1411      apply (simp add: retract_of_def retraction_def ahS)
 15.1412      apply (rule_tac x="closest_point (affine hull S)" in exI)
 15.1413 -    apply (auto simp add: False closest_point_self affine_imp_convex closest_point_in_set continuous_on_closest_point)
 15.1414 +    apply (auto simp: False closest_point_self affine_imp_convex closest_point_in_set continuous_on_closest_point)
 15.1415      done
 15.1416    finally have "rel_frontier S retract_of {x. closest_point (affine hull S) x \<noteq> a}" .
 15.1417    moreover have "openin (subtopology euclidean UNIV) (UNIV \<inter> closest_point (affine hull S) -` (- {a}))"
 15.1418      apply (rule continuous_openin_preimage_gen)
 15.1419 -    apply (auto simp add: False affine_imp_convex continuous_on_closest_point)
 15.1420 +    apply (auto simp: False affine_imp_convex continuous_on_closest_point)
 15.1421      done
 15.1422    ultimately show ?thesis
 15.1423      unfolding ENR_def
 15.1424 @@ -4116,7 +3993,7 @@
 15.1425        apply (rule continuous_on_cases_local [OF clS clT])
 15.1426        using r by (auto simp: continuous_on_id)
 15.1427    qed (use r in auto)
 15.1428 -  also have "... retract_of U"
 15.1429 +  also have "\<dots> retract_of U"
 15.1430      by (rule Un)
 15.1431    finally show ?thesis .
 15.1432  qed
 15.1433 @@ -4499,7 +4376,7 @@
 15.1434               and him: "h ` ({0..1} \<times> S) \<subseteq> U"
 15.1435               and [simp]: "\<And>x. h(0, x) = f x" "\<And>x. h(1::real, x) = g x"
 15.1436         using assms by (auto simp: homotopic_with_def)
 15.1437 -  define h' where "h' \<equiv>  \<lambda>z. if snd z \<in> S then h z else (f o snd) z"
 15.1438 +  define h' where "h' \<equiv>  \<lambda>z. if snd z \<in> S then h z else (f \<circ> snd) z"
 15.1439    define B where "B \<equiv> {0::real} \<times> T \<union> {0..1} \<times> S"
 15.1440    have clo0T: "closedin (subtopology euclidean ({0..1} \<times> T)) ({0::real} \<times> T)"
 15.1441      by (simp add: closedin_subtopology_refl closedin_Times)
 15.1442 @@ -4542,7 +4419,7 @@
 15.1443                        "retraction V B r" for V r
 15.1444        using that
 15.1445        apply (clarsimp simp add: retraction_def)
 15.1446 -      apply (rule Vk [of V "h' o r"], assumption+)
 15.1447 +      apply (rule Vk [of V "h' \<circ> r"], assumption+)
 15.1448          apply (metis continuous_on_compose conth' continuous_on_subset) 
 15.1449        using \<open>h' ` B \<subseteq> U\<close> apply force+
 15.1450        done
 15.1451 @@ -4629,7 +4506,7 @@
 15.1452  proof
 15.1453    assume ?lhs
 15.1454    then obtain c where c: "homotopic_with (\<lambda>x. True) S T (\<lambda>x. c) f"
 15.1455 -    by (blast intro: homotopic_with_symD elim: )
 15.1456 +    by (blast intro: homotopic_with_symD)
 15.1457    have "closedin (subtopology euclidean UNIV) S"
 15.1458      using \<open>closed S\<close> closed_closedin by fastforce
 15.1459    then obtain g where "continuous_on UNIV g" "range g \<subseteq> T"
 15.1460 @@ -4645,10 +4522,10 @@
 15.1461    then obtain c where "homotopic_with (\<lambda>h. True) UNIV T g (\<lambda>x. c)"
 15.1462      using nullhomotopic_from_contractible [of UNIV g T] contractible_UNIV by blast
 15.1463    then show ?lhs
 15.1464 -    apply (rule_tac x="c" in exI)
 15.1465 +    apply (rule_tac x=c in exI)
 15.1466      apply (rule homotopic_with_eq [of _ _ _ g "\<lambda>x. c"])
 15.1467      apply (rule homotopic_with_subset_left)
 15.1468 -    apply (auto simp add: \<open>\<And>x. x \<in> S \<Longrightarrow> g x = f x\<close>)
 15.1469 +    apply (auto simp: \<open>\<And>x. x \<in> S \<Longrightarrow> g x = f x\<close>)
 15.1470      done
 15.1471  qed
 15.1472  
 15.1473 @@ -4672,7 +4549,7 @@
 15.1474             (is "?lhs = ?rhs")
 15.1475  proof (cases "r = 0")
 15.1476    case True with fim show ?thesis
 15.1477 -    apply (auto simp: )
 15.1478 +    apply auto
 15.1479      using fim continuous_on_const apply fastforce
 15.1480      by (metis contf contractible_sing nullhomotopic_into_contractible)
 15.1481  next
 15.1482 @@ -4717,11 +4594,11 @@
 15.1483      obtain g where "range g \<subseteq> sphere 0 1" "continuous_on UNIV g"
 15.1484                          "\<And>x. x \<in> S \<Longrightarrow> g x = (x - a) /\<^sub>R norm (x - a)"
 15.1485        using notr
 15.1486 -      by (auto simp add: nullhomotopic_into_sphere_extension
 15.1487 +      by (auto simp: nullhomotopic_into_sphere_extension
 15.1488                   [OF \<open>closed S\<close> continuous_on_Borsuk_map [OF \<open>a \<notin> S\<close>] False s01])
 15.1489      with \<open>a \<notin> S\<close> show  "~ ?lhs"
 15.1490        apply (clarsimp simp: Borsuk_map_into_sphere [of a S, symmetric] dest!: nog)
 15.1491 -      apply (drule_tac x="g" in spec)
 15.1492 +      apply (drule_tac x=g in spec)
 15.1493        using continuous_on_subset by fastforce 
 15.1494    next
 15.1495      assume "~ ?lhs"
 15.1496 @@ -5070,7 +4947,7 @@
 15.1497          then obtain k where "y \<in> V k" and j: "\<forall>j<k. y \<notin> V j"
 15.1498            by (metis image_iff V wop)
 15.1499          with him t show "\<zeta>(t, y) \<in> T"
 15.1500 -          by (subst eq) (force simp:)+
 15.1501 +          by (subst eq) force+
 15.1502        qed
 15.1503        fix X y
 15.1504        assume "X \<in> \<V>" "y \<in> X"
 15.1505 @@ -5291,4 +5168,16 @@
 15.1506    using connected_complement_homeomorphic_convex_compact [OF assms]
 15.1507    using \<open>compact T\<close> compact_eq_bounded_closed connected_open_path_connected hom homeomorphic_compactness by blast
 15.1508  
 15.1509 +lemma path_connected_complement_homeomorphic_interval:
 15.1510 +  fixes S :: "'a::euclidean_space set"
 15.1511 +  assumes "S homeomorphic cbox a b" "2 \<le> DIM('a)"
 15.1512 +  shows "path_connected(-S)"
 15.1513 +  using assms compact_cbox convex_box(1) path_connected_complement_homeomorphic_convex_compact by blast
 15.1514 +
 15.1515 +lemma connected_complement_homeomorphic_interval:
 15.1516 +  fixes S :: "'a::euclidean_space set"
 15.1517 +  assumes "S homeomorphic cbox a b" "2 \<le> DIM('a)"
 15.1518 +  shows "connected(-S)"
 15.1519 +  using assms path_connected_complement_homeomorphic_interval path_connected_imp_connected by blast
 15.1520 +
 15.1521  end
    16.1 --- a/src/HOL/Analysis/Cartesian_Euclidean_Space.thy	Wed May 02 13:49:38 2018 +0200
    16.2 +++ b/src/HOL/Analysis/Cartesian_Euclidean_Space.thy	Thu May 03 15:07:14 2018 +0200
    16.3 @@ -1,3 +1,7 @@
    16.4 +(* Title:      HOL/Analysis/Cartesian_Euclidean_Space.thy
    16.5 +   Some material by Jose Divasón, Tim Makarios and L C Paulson
    16.6 +*)
    16.7 +
    16.8  section \<open>Instantiates the finite Cartesian product of Euclidean spaces as a Euclidean space\<close>
    16.9  
   16.10  theory Cartesian_Euclidean_Space
   16.11 @@ -176,12 +180,10 @@
   16.12  qed
   16.13  
   16.14  lemma matrix_mult_transpose_dot_column:
   16.15 -  fixes A :: "real^'n^'n"
   16.16    shows "transpose A ** A = (\<chi> i j. inner (column i A) (column j A))"
   16.17    by (simp add: matrix_matrix_mult_def vec_eq_iff transpose_def column_def inner_vec_def)
   16.18  
   16.19  lemma matrix_mult_transpose_dot_row:
   16.20 -  fixes A :: "real^'n^'n"
   16.21    shows "A ** transpose A = (\<chi> i j. inner (row i A) (row j A))"
   16.22    by (simp add: matrix_matrix_mult_def vec_eq_iff transpose_def row_def inner_vec_def)
   16.23  
   16.24 @@ -215,11 +217,77 @@
   16.25    by (simp add: linear_conv_bounded_linear linear_matrix_vector_mul_eq)
   16.26  
   16.27  lemma
   16.28 -  fixes A :: "real^'n^'m"
   16.29 +  fixes A :: "'a::{euclidean_space,real_algebra_1}^'n^'m"
   16.30    shows matrix_vector_mult_linear_continuous_at [continuous_intros]: "isCont (( *v) A) z"
   16.31      and matrix_vector_mult_linear_continuous_on [continuous_intros]: "continuous_on S (( *v) A)"
   16.32    by (simp_all add: linear_continuous_at linear_continuous_on)
   16.33  
   16.34 +lemma scalar_invertible:
   16.35 +  fixes A :: "('a::real_algebra_1)^'m^'n"
   16.36 +  assumes "k \<noteq> 0" and "invertible A"
   16.37 +  shows "invertible (k *\<^sub>R A)"
   16.38 +proof -
   16.39 +  obtain A' where "A ** A' = mat 1" and "A' ** A = mat 1"
   16.40 +    using assms unfolding invertible_def by auto
   16.41 +  with `k \<noteq> 0`
   16.42 +  have "(k *\<^sub>R A) ** ((1/k) *\<^sub>R A') = mat 1" "((1/k) *\<^sub>R A') ** (k *\<^sub>R A) = mat 1"
   16.43 +    by (simp_all add: assms matrix_scalar_ac)
   16.44 +  thus "invertible (k *\<^sub>R A)"
   16.45 +    unfolding invertible_def by auto
   16.46 +qed
   16.47 +
   16.48 +lemma scalar_invertible_iff:
   16.49 +  fixes A :: "('a::real_algebra_1)^'m^'n"
   16.50 +  assumes "k \<noteq> 0" and "invertible A"
   16.51 +  shows "invertible (k *\<^sub>R A) \<longleftrightarrow> k \<noteq> 0 \<and> invertible A"
   16.52 +  by (simp add: assms scalar_invertible)
   16.53 +
   16.54 +lemma vector_transpose_matrix [simp]: "x v* transpose A = A *v x"
   16.55 +  unfolding transpose_def vector_matrix_mult_def matrix_vector_mult_def
   16.56 +  by simp
   16.57 +
   16.58 +lemma transpose_matrix_vector [simp]: "transpose A *v x = x v* A"
   16.59 +  unfolding transpose_def vector_matrix_mult_def matrix_vector_mult_def
   16.60 +  by simp
   16.61 +
   16.62 +lemma vector_scalar_commute:
   16.63 +  fixes A :: "'a::{field}^'m^'n"
   16.64 +  shows "A *v (c *s x) = c *s (A *v x)"
   16.65 +  by (simp add: vector_scalar_mult_def matrix_vector_mult_def mult_ac sum_distrib_left)
   16.66 +
   16.67 +lemma scalar_vector_matrix_assoc:
   16.68 +  fixes k :: "'a::{field}" and x :: "'a::{field}^'n" and A :: "'a^'m^'n"
   16.69 +  shows "(k *s x) v* A = k *s (x v* A)"
   16.70 +  by (metis transpose_matrix_vector vector_scalar_commute)
   16.71 + 
   16.72 +lemma vector_matrix_mult_0 [simp]: "0 v* A = 0"
   16.73 +  unfolding vector_matrix_mult_def by (simp add: zero_vec_def)
   16.74 +
   16.75 +lemma vector_matrix_mult_0_right [simp]: "x v* 0 = 0"
   16.76 +  unfolding vector_matrix_mult_def by (simp add: zero_vec_def)
   16.77 +
   16.78 +lemma vector_matrix_mul_rid [simp]:
   16.79 +  fixes v :: "('a::semiring_1)^'n"
   16.80 +  shows "v v* mat 1 = v"
   16.81 +  by (metis matrix_vector_mul_lid transpose_mat vector_transpose_matrix)
   16.82 +
   16.83 +lemma scaleR_vector_matrix_assoc:
   16.84 +  fixes k :: real and x :: "real^'n" and A :: "real^'m^'n"
   16.85 +  shows "(k *\<^sub>R x) v* A = k *\<^sub>R (x v* A)"
   16.86 +  by (metis matrix_vector_mult_scaleR transpose_matrix_vector)
   16.87 +
   16.88 +lemma vector_scaleR_matrix_ac:
   16.89 +  fixes k :: real and x :: "real^'n" and A :: "real^'m^'n"
   16.90 +  shows "x v* (k *\<^sub>R A) = k *\<^sub>R (x v* A)"
   16.91 +proof -
   16.92 +  have "x v* (k *\<^sub>R A) = (k *\<^sub>R x) v* A"
   16.93 +    unfolding vector_matrix_mult_def
   16.94 +    by (simp add: algebra_simps)
   16.95 +  with scaleR_vector_matrix_assoc
   16.96 +  show "x v* (k *\<^sub>R A) = k *\<^sub>R (x v* A)"
   16.97 +    by auto
   16.98 +qed
   16.99 +
  16.100  
  16.101  subsection\<open>Some bounds on components etc. relative to operator norm\<close>
  16.102  
  16.103 @@ -402,22 +470,18 @@
  16.104    have fU: "finite ?U" by simp
  16.105    have lhseq: "?lhs \<longleftrightarrow> (\<forall>y. \<exists>(x::'a^'m). sum (\<lambda>i. (x$i) *s column i A) ?U = y)"
  16.106      unfolding matrix_right_invertible_surjective matrix_mult_sum surj_def
  16.107 -    apply (subst eq_commute)
  16.108 -    apply rule
  16.109 -    done
  16.110 +    by (simp add: eq_commute)
  16.111    have rhseq: "?rhs \<longleftrightarrow> (\<forall>x. x \<in> vec.span (columns A))" by blast
  16.112    { assume h: ?lhs
  16.113      { fix x:: "'a ^'n"
  16.114        from h[unfolded lhseq, rule_format, of x] obtain y :: "'a ^'m"
  16.115          where y: "sum (\<lambda>i. (y$i) *s column i A) ?U = x" by blast
  16.116        have "x \<in> vec.span (columns A)"
  16.117 -        unfolding y[symmetric]
  16.118 -        apply (rule vec.span_sum)
  16.119 -        apply (rule vec.span_scale)
  16.120 -        apply (rule vec.span_base)
  16.121 -        unfolding columns_def
  16.122 -        apply blast
  16.123 -        done
  16.124 +        unfolding y[symmetric] scalar_mult_eq_scaleR
  16.125 +      proof (rule span_sum [OF span_mul])
  16.126 +        show "column i A \<in> span (columns A)" for i
  16.127 +          using columns_def span_inc by auto
  16.128 +      qed
  16.129      }
  16.130      then have ?rhs unfolding rhseq by blast }
  16.131    moreover
  16.132 @@ -428,17 +492,18 @@
  16.133          unfolding h by blast
  16.134        then have "?P y"
  16.135        proof (induction rule: vec.span_induct_alt)
  16.136 -        show "\<exists>x::'a ^ 'm. sum (\<lambda>i. (x$i) *s column i A) ?U = 0"
  16.137 -          by (rule exI[where x=0], simp)
  16.138 +        case base
  16.139 +        then show ?case
  16.140 +          by (metis (full_types) matrix_mult_sum matrix_vector_mult_0_right)
  16.141        next
  16.142 -        fix c y1 y2
  16.143 -        assume y1: "y1 \<in> columns A" and y2: "?P y2"
  16.144 +        case (step c y1 y2)
  16.145 +        then obtain i where i: "i \<in> ?U" "y1 = column i A"
  16.146          from y1 obtain i where i: "i \<in> ?U" "y1 = column i A"
  16.147            unfolding columns_def by blast
  16.148 -        from y2 obtain x:: "'a ^'m" where
  16.149 -          x: "sum (\<lambda>i. (x$i) *s column i A) ?U = y2" by blast
  16.150 +        obtain x:: "real ^'m" where x: "sum (\<lambda>i. (x$i) *s column i A) ?U = y2"
  16.151 +          using step by blast
  16.152          let ?x = "(\<chi> j. if j = i then c + (x$i) else (x$j))::'a^'m"
  16.153 -        show "?P (c*s y1 + y2)"
  16.154 +        show ?case
  16.155          proof (rule exI[where x= "?x"], vector, auto simp add: i x[symmetric] if_distrib distrib_left if_distribR cong del: if_weak_cong)
  16.156            fix j
  16.157            have th: "\<forall>xa \<in> ?U. (if xa = i then (c + (x$i)) * ((column xa A)$j)
  16.158 @@ -446,9 +511,7 @@
  16.159              using i(1) by (simp add: field_simps)
  16.160            have "sum (\<lambda>xa. if xa = i then (c + (x$i)) * ((column xa A)$j)
  16.161                else (x$xa) * ((column xa A$j))) ?U = sum (\<lambda>xa. (if xa = i then c * ((column i A)$j) else 0) + ((x$xa) * ((column xa A)$j))) ?U"
  16.162 -            apply (rule sum.cong[OF refl])
  16.163 -            using th apply blast
  16.164 -            done
  16.165 +            by (rule sum.cong[OF refl]) (use th in blast)
  16.166            also have "\<dots> = sum (\<lambda>xa. if xa = i then c * ((column i A)$j) else 0) ?U + sum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U"
  16.167              by (simp add: sum.distrib)
  16.168            also have "\<dots> = c * ((column i A)$j) + sum (\<lambda>xa. ((x$xa) * ((column xa A)$j))) ?U"
  16.169 @@ -1038,8 +1101,8 @@
  16.170      obtain B where "independent B" "span(rows A) \<subseteq> span B"
  16.171                and B: "B \<subseteq> span(rows A)""card B = dim (span(rows A))"
  16.172        using basis_exists [of "span(rows A)"] by blast
  16.173 -    then have eq: "span B = span(rows A)"
  16.174 -      using span_subspace subspace_span by blast
  16.175 +    with span_subspace have eq: "span B = span(rows A)"
  16.176 +      by auto
  16.177      then have inj: "inj_on (( *v) A) (span B)"
  16.178        by (simp add: inj_on_def matrix_vector_mul_injective_on_rowspace)
  16.179      then have ind: "independent (( *v) A ` B)"
  16.180 @@ -1208,15 +1271,13 @@
  16.181  
  16.182  definition "vector l = (\<chi> i. foldr (\<lambda>x f n. fun_upd (f (n+1)) n x) l (\<lambda>n x. 0) 1 i)"
  16.183  
  16.184 -lemma vector_1: "(vector[x]) $1 = x"
  16.185 +lemma vector_1 [simp]: "(vector[x]) $1 = x"
  16.186    unfolding vector_def by simp
  16.187  
  16.188 -lemma vector_2:
  16.189 - "(vector[x,y]) $1 = x"
  16.190 - "(vector[x,y] :: 'a^2)$2 = (y::'a::zero)"
  16.191 +lemma vector_2 [simp]: "(vector[x,y]) $1 = x" "(vector[x,y] :: 'a^2)$2 = (y::'a::zero)"
  16.192    unfolding vector_def by simp_all
  16.193  
  16.194 -lemma vector_3:
  16.195 +lemma vector_3 [simp]:
  16.196   "(vector [x,y,z] ::('a::zero)^3)$1 = x"
  16.197   "(vector [x,y,z] ::('a::zero)^3)$2 = y"
  16.198   "(vector [x,y,z] ::('a::zero)^3)$3 = z"
  16.199 @@ -1247,7 +1308,7 @@
  16.200    done
  16.201  
  16.202  lemma bounded_linear_component_cart[intro]: "bounded_linear (\<lambda>x::real^'n. x $ k)"
  16.203 -  apply (rule bounded_linearI[where K=1])
  16.204 +  apply (rule bounded_linear_intro[where K=1])
  16.205    using component_le_norm_cart[of _ k] unfolding real_norm_def by auto
  16.206  
  16.207  lemma interval_split_cart:
  16.208 @@ -1263,4 +1324,4 @@
  16.209    bounded_linear.uniform_limit[OF bounded_linear_vec_nth]
  16.210    bounded_linear.uniform_limit[OF bounded_linear_component_cart]
  16.211  
  16.212 -end
  16.213 \ No newline at end of file
  16.214 +end
    17.1 --- a/src/HOL/Analysis/Cartesian_Space.thy	Wed May 02 13:49:38 2018 +0200
    17.2 +++ b/src/HOL/Analysis/Cartesian_Space.thy	Thu May 03 15:07:14 2018 +0200
    17.3 @@ -219,11 +219,7 @@
    17.4    { fix A A' :: "'a ^'n^'n"
    17.5      assume AA': "A ** A' = mat 1"
    17.6      have sA: "surj (( *v) A)"
    17.7 -      unfolding surj_def
    17.8 -      apply clarify
    17.9 -      apply (rule_tac x="(A' *v y)" in exI)
   17.10 -      apply (simp add: matrix_vector_mul_assoc AA')
   17.11 -      done
   17.12 +      using AA' matrix_right_invertible_surjective by auto
   17.13      from vec.linear_surjective_isomorphism[OF matrix_vector_mul_linear_gen sA]
   17.14      obtain f' :: "'a ^'n \<Rightarrow> 'a ^'n"
   17.15        where f': "Vector_Spaces.linear ( *s) ( *s) f'" "\<forall>x. f' (A *v x) = x" "\<forall>x. A *v f' x = x" by blast
   17.16 @@ -244,11 +240,64 @@
   17.17    shows "invertible A \<longleftrightarrow> (\<exists>(B::'a^'n^'n). B ** A = mat 1)"
   17.18    by (metis invertible_def matrix_left_right_inverse)
   17.19  
   17.20 -  lemma invertible_right_inverse:
   17.21 +lemma invertible_right_inverse:
   17.22    fixes A :: "'a::{field}^'n^'n"
   17.23    shows "invertible A \<longleftrightarrow> (\<exists>(B::'a^'n^'n). A** B = mat 1)"
   17.24    by (metis invertible_def matrix_left_right_inverse)
   17.25  
   17.26 +lemma invertible_mult:
   17.27 +  assumes inv_A: "invertible A"
   17.28 +  and inv_B: "invertible B"
   17.29 +  shows "invertible (A**B)"
   17.30 +proof -
   17.31 +  obtain A' where AA': "A ** A' = mat 1" and A'A: "A' ** A = mat 1" 
   17.32 +    using inv_A unfolding invertible_def by blast
   17.33 +  obtain B' where BB': "B ** B' = mat 1" and B'B: "B' ** B = mat 1" 
   17.34 +    using inv_B unfolding invertible_def by blast
   17.35 +  show ?thesis
   17.36 +  proof (unfold invertible_def, rule exI[of _ "B'**A'"], rule conjI)
   17.37 +    have "A ** B ** (B' ** A') = A ** (B ** (B' ** A'))" 
   17.38 +      using matrix_mul_assoc[of A B "(B' ** A')", symmetric] .
   17.39 +    also have "... = A ** (B ** B' ** A')" unfolding matrix_mul_assoc[of B "B'" "A'"] ..
   17.40 +    also have "... = A ** (mat 1 ** A')" unfolding BB' ..
   17.41 +    also have "... = A ** A'" unfolding matrix_mul_lid ..
   17.42 +    also have "... = mat 1" unfolding AA' ..
   17.43 +    finally show "A ** B ** (B' ** A') = mat (1::'a)" .    
   17.44 +    have "B' ** A' ** (A ** B) = B' ** (A' ** (A ** B))" using matrix_mul_assoc[of B' A' "(A ** B)", symmetric] .
   17.45 +    also have "... =  B' ** (A' ** A ** B)" unfolding matrix_mul_assoc[of A' A B] ..
   17.46 +    also have "... =  B' ** (mat 1 ** B)" unfolding A'A ..
   17.47 +    also have "... = B' ** B"  unfolding matrix_mul_lid ..
   17.48 +    also have "... = mat 1" unfolding B'B ..
   17.49 +    finally show "B' ** A' ** (A ** B) = mat 1" .
   17.50 +  qed
   17.51 +qed
   17.52 +
   17.53 +lemma transpose_invertible:
   17.54 +  fixes A :: "real^'n^'n"
   17.55 +  assumes "invertible A"
   17.56 +  shows "invertible (transpose A)"
   17.57 +  by (meson assms invertible_def matrix_left_right_inverse right_invertible_transpose)
   17.58 +
   17.59 +lemma vector_matrix_mul_assoc:
   17.60 +  fixes v :: "('a::comm_semiring_1)^'n"
   17.61 +  shows "(v v* M) v* N = v v* (M ** N)"
   17.62 +proof -
   17.63 +  from matrix_vector_mul_assoc
   17.64 +  have "transpose N *v (transpose M *v v) = (transpose N ** transpose M) *v v" by fast
   17.65 +  thus "(v v* M) v* N = v v* (M ** N)"
   17.66 +    by (simp add: matrix_transpose_mul [symmetric])
   17.67 +qed
   17.68 +
   17.69 +lemma matrix_scaleR_vector_ac:
   17.70 +  fixes A :: "real^('m::finite)^'n"
   17.71 +  shows "A *v (k *\<^sub>R v) = k *\<^sub>R A *v v"
   17.72 +  by (metis matrix_vector_mult_scaleR transpose_scalar vector_scaleR_matrix_ac vector_transpose_matrix)
   17.73 +
   17.74 +lemma scaleR_matrix_vector_assoc:
   17.75 +  fixes A :: "real^('m::finite)^'n"
   17.76 +  shows "k *\<^sub>R (A *v v) = k *\<^sub>R A *v v"
   17.77 +  by (metis matrix_scaleR_vector_ac matrix_vector_mult_scaleR)
   17.78 +
   17.79  (*Finally, some interesting theorems and interpretations that don't appear in any file of the
   17.80    library.*)
   17.81  
    18.1 --- a/src/HOL/Analysis/Cauchy_Integral_Theorem.thy	Wed May 02 13:49:38 2018 +0200
    18.2 +++ b/src/HOL/Analysis/Cauchy_Integral_Theorem.thy	Thu May 03 15:07:14 2018 +0200
    18.3 @@ -4130,7 +4130,7 @@
    18.4      have "winding_number \<gamma> y \<in> \<int>"  "winding_number \<gamma> z \<in>  \<int>"
    18.5        using that integer_winding_number [OF \<gamma> loop] sg \<open>y \<in> S\<close> by auto
    18.6      with ne show ?thesis
    18.7 -      by (auto simp: Ints_def of_int_diff [symmetric] simp del: of_int_diff)
    18.8 +      by (auto simp: Ints_def reorient: of_int_diff)
    18.9    qed
   18.10    have cont: "continuous_on S (\<lambda>w. winding_number \<gamma> w)"
   18.11      using continuous_on_winding_number [OF \<gamma>] sg
   18.12 @@ -6663,7 +6663,7 @@
   18.13        by (rule derivative_eq_intros | simp)+
   18.14      have y_le: "\<lbrakk>cmod (z - y) * 2 < r - cmod z\<rbrakk> \<Longrightarrow> cmod y \<le> cmod (of_real r + of_real (cmod z)) / 2" for z y
   18.15        using \<open>r > 0\<close>
   18.16 -      apply (auto simp: algebra_simps norm_mult norm_divide norm_power of_real_add [symmetric] simp del: of_real_add)
   18.17 +      apply (auto simp: algebra_simps norm_mult norm_divide norm_power reorient: of_real_add)
   18.18        using norm_triangle_ineq2 [of y z]
   18.19        apply (simp only: diff_le_eq norm_minus_commute mult_2)
   18.20        done
   18.21 @@ -6671,7 +6671,7 @@
   18.22        using assms \<open>r > 0\<close> by simp
   18.23      moreover have "\<And>z. cmod z < r \<Longrightarrow> cmod ((of_real r + of_real (cmod z)) / 2) < cmod (of_real r)"
   18.24        using \<open>r > 0\<close>
   18.25 -      by (simp add: of_real_add [symmetric] del: of_real_add)
   18.26 +      by (simp reorient: of_real_add)
   18.27      ultimately have sum: "\<And>z. cmod z < r \<Longrightarrow> summable (\<lambda>n. of_real (cmod (a n)) * ((of_real r + complex_of_real (cmod z)) / 2) ^ n)"
   18.28        by (rule power_series_conv_imp_absconv_weak)
   18.29      have "\<exists>g g'. \<forall>z \<in> ball 0 r. (\<lambda>n.  (a n) * z ^ n) sums g z \<and>
   18.30 @@ -6719,7 +6719,7 @@
   18.31        then have "0 \<le> r"
   18.32          by (meson less_eq_real_def norm_ge_zero order_trans)
   18.33        show ?thesis
   18.34 -        using w by (simp add: dist_norm \<open>0\<le>r\<close> of_real_add [symmetric] del: of_real_add)
   18.35 +        using w by (simp add: dist_norm \<open>0\<le>r\<close> reorient: of_real_add)
   18.36      qed
   18.37      have sum: "summable (\<lambda>n. a n * of_real (((cmod (z - w) + r) / 2) ^ n))"
   18.38        using assms [OF inb] by (force simp add: summable_def dist_norm)
    19.1 --- a/src/HOL/Analysis/Change_Of_Vars.thy	Wed May 02 13:49:38 2018 +0200
    19.2 +++ b/src/HOL/Analysis/Change_Of_Vars.thy	Thu May 03 15:07:14 2018 +0200
    19.3 @@ -1,3 +1,9 @@
    19.4 +(*  Title:      HOL/Analysis/Change_Of_Vars.thy
    19.5 +    Authors:    LC Paulson, based on material from HOL Light
    19.6 +*)
    19.7 +
    19.8 +section\<open>Change of Variables Theorems\<close>
    19.9 +
   19.10  theory Change_Of_Vars
   19.11    imports Vitali_Covering_Theorem Determinants
   19.12  
   19.13 @@ -1274,8 +1280,7 @@
   19.14        proof (rule add_mono)
   19.15          have "(\<Sum>k\<le>n. real k * e * ?\<mu> (T k)) = (\<Sum>k\<le>n. integral (T k) (\<lambda>x. k * e))"
   19.16            by (simp add: lmeasure_integral [OF meas_t]
   19.17 -                        integral_mult_right [symmetric] integral_mult_left [symmetric]
   19.18 -                   del: integral_mult_right integral_mult_left)
   19.19 +                   reorient: integral_mult_right integral_mult_left)
   19.20          also have "\<dots> \<le> (\<Sum>k\<le>n. integral (T k) (\<lambda>x.  (abs (det (matrix (f' x))))))"
   19.21          proof (rule sum_mono)
   19.22            fix k
   19.23 @@ -1624,7 +1629,7 @@
   19.24    proof -
   19.25      obtain d where "d \<noteq> 0" and d: "\<And>y. f y = 0 \<Longrightarrow> d \<bullet> y = 0"
   19.26        using orthogonal_to_subspace_exists [OF less] orthogonal_def
   19.27 -      by (metis (mono_tags, lifting) mem_Collect_eq span_clauses(1))
   19.28 +      by (metis (mono_tags, lifting) mem_Collect_eq span_superset)
   19.29      then obtain k where "k > 0"
   19.30        and k: "\<And>e. e > 0 \<Longrightarrow> \<exists>y. y \<in> S - {0} \<and> norm y < e \<and> k * norm y \<le> \<bar>d \<bullet> y\<bar>"
   19.31        using lb by blast
    20.1 --- a/src/HOL/Analysis/Complex_Analysis_Basics.thy	Wed May 02 13:49:38 2018 +0200
    20.2 +++ b/src/HOL/Analysis/Complex_Analysis_Basics.thy	Thu May 03 15:07:14 2018 +0200
    20.3 @@ -837,15 +837,13 @@
    20.4      qed
    20.5    } note ** = this
    20.6    show ?thesis
    20.7 -  unfolding has_field_derivative_def
    20.8 +    unfolding has_field_derivative_def
    20.9    proof (rule has_derivative_sequence [OF cvs _ _ x])
   20.10 -    show "\<forall>n. \<forall>x\<in>s. (f n has_derivative (( * ) (f' n x))) (at x within s)"
   20.11 -      by (metis has_field_derivative_def df)
   20.12 -  next show "(\<lambda>n. f n x) \<longlonglongrightarrow> l"
   20.13 +  show "(\<lambda>n. f n x) \<longlonglongrightarrow> l"
   20.14      by (rule tf)
   20.15 -  next show "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. \<forall>x\<in>s. \<forall>h. cmod (f' n x * h - g' x * h) \<le> e * cmod h"
   20.16 +  next show "\<And>e. e > 0 \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. \<forall>x\<in>s. \<forall>h. cmod (f' n x * h - g' x * h) \<le> e * cmod h"
   20.17      by (blast intro: **)
   20.18 -  qed
   20.19 +  qed (metis has_field_derivative_def df)
   20.20  qed
   20.21  
   20.22  lemma has_complex_derivative_series:
   20.23 @@ -884,7 +882,7 @@
   20.24        by (metis df has_field_derivative_def mult_commute_abs)
   20.25    next show " ((\<lambda>n. f n x) sums l)"
   20.26      by (rule sf)
   20.27 -  next show "\<forall>e>0. \<exists>N. \<forall>n\<ge>N. \<forall>x\<in>s. \<forall>h. cmod ((\<Sum>i<n. h * f' i x) - g' x * h) \<le> e * cmod h"
   20.28 +  next show "\<And>e. e>0 \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. \<forall>x\<in>s. \<forall>h. cmod ((\<Sum>i<n. h * f' i x) - g' x * h) \<le> e * cmod h"
   20.29      by (blast intro: **)
   20.30    qed
   20.31  qed
   20.32 @@ -896,7 +894,7 @@
   20.33    assumes "\<And>n x. x \<in> s \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
   20.34    assumes "uniformly_convergent_on s (\<lambda>n x. \<Sum>i<n. f' i x)"
   20.35    assumes "x0 \<in> s" "summable (\<lambda>n. f n x0)" and x: "x \<in> s"
   20.36 -  shows   "summable (\<lambda>n. f n x)" and "(\<lambda>x. \<Sum>n. f n x) field_differentiable (at x)"
   20.37 +  shows  "(\<lambda>x. \<Sum>n. f n x) field_differentiable (at x)"
   20.38  proof -
   20.39    from assms(4) obtain g' where A: "uniform_limit s (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
   20.40      unfolding uniformly_convergent_on_def by blast
   20.41 @@ -905,7 +903,6 @@
   20.42      by (intro has_field_derivative_series[of s f f' g' x0] assms A has_field_derivative_at_within)
   20.43    then obtain g where g: "\<And>x. x \<in> s \<Longrightarrow> (\<lambda>n. f n x) sums g x"
   20.44      "\<And>x. x \<in> s \<Longrightarrow> (g has_field_derivative g' x) (at x within s)" by blast
   20.45 -  from g[OF x] show "summable (\<lambda>n. f n x)" by (auto simp: summable_def)
   20.46    from g(2)[OF x] have g': "(g has_derivative ( * ) (g' x)) (at x)"
   20.47      by (simp add: has_field_derivative_def s)
   20.48    have "((\<lambda>x. \<Sum>n. f n x) has_derivative ( * ) (g' x)) (at x)"
   20.49 @@ -915,15 +912,6 @@
   20.50      by (auto simp: summable_def field_differentiable_def has_field_derivative_def)
   20.51  qed
   20.52  
   20.53 -lemma field_differentiable_series':
   20.54 -  fixes f :: "nat \<Rightarrow> 'a::{real_normed_field,banach} \<Rightarrow> 'a"
   20.55 -  assumes "convex s" "open s"
   20.56 -  assumes "\<And>n x. x \<in> s \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
   20.57 -  assumes "uniformly_convergent_on s (\<lambda>n x. \<Sum>i<n. f' i x)"
   20.58 -  assumes "x0 \<in> s" "summable (\<lambda>n. f n x0)"
   20.59 -  shows   "(\<lambda>x. \<Sum>n. f n x) field_differentiable (at x0)"
   20.60 -  using field_differentiable_series[OF assms, of x0] \<open>x0 \<in> s\<close> by blast+
   20.61 -
   20.62  subsection\<open>Bound theorem\<close>
   20.63  
   20.64  lemma field_differentiable_bound:
    21.1 --- a/src/HOL/Analysis/Convex_Euclidean_Space.thy	Wed May 02 13:49:38 2018 +0200
    21.2 +++ b/src/HOL/Analysis/Convex_Euclidean_Space.thy	Thu May 03 15:07:14 2018 +0200
    21.3 @@ -68,8 +68,7 @@
    21.4    then have "span (cball 0 e) = (UNIV :: 'n::euclidean_space set)"
    21.5      by auto
    21.6    then show ?thesis
    21.7 -    using dim_span[of "cball (0 :: 'n::euclidean_space) e"]
    21.8 -    by auto
    21.9 +    using dim_span[of "cball (0 :: 'n::euclidean_space) e"] by (auto simp: dim_UNIV)
   21.10  qed
   21.11  
   21.12  lemma sum_not_0: "sum f A \<noteq> 0 \<Longrightarrow> \<exists>a \<in> A. f a \<noteq> 0"
   21.13 @@ -119,8 +118,7 @@
   21.14      then have "x-a \<in> S" using assms by auto
   21.15      then have "x \<in> {a + v |v. v \<in> S}"
   21.16        apply auto
   21.17 -      apply (rule exI[of _ "x-a"])
   21.18 -      apply simp
   21.19 +      apply (rule exI[of _ "x-a"], simp)
   21.20        done
   21.21      then have "x \<in> ((\<lambda>x. a+x) ` S)" by auto
   21.22    }
   21.23 @@ -1301,7 +1299,7 @@
   21.24  proof -
   21.25    have *: "x - y + (y - z) = x - z" by auto
   21.26    show ?thesis unfolding dist_norm norm_triangle_eq[of "x - y" "y - z", unfolded *]
   21.27 -    by (auto simp add:norm_minus_commute)
   21.28 +    by (auto simp:norm_minus_commute)
   21.29  qed
   21.30  
   21.31  
   21.32 @@ -1317,7 +1315,7 @@
   21.33    unfolding affine_def by auto
   21.34  
   21.35  lemma affine_sing [iff]: "affine {x}"
   21.36 -  unfolding affine_alt by (auto simp add: scaleR_left_distrib [symmetric])
   21.37 +  unfolding affine_alt by (auto simp: scaleR_left_distrib [symmetric])
   21.38  
   21.39  lemma affine_UNIV [iff]: "affine UNIV"
   21.40    unfolding affine_def by auto
   21.41 @@ -1350,293 +1348,200 @@
   21.42  lemma affine:
   21.43    fixes V::"'a::real_vector set"
   21.44    shows "affine V \<longleftrightarrow>
   21.45 -    (\<forall>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> V \<and> sum u s = 1 \<longrightarrow> (sum (\<lambda>x. (u x) *\<^sub>R x)) s \<in> V)"
   21.46 -  unfolding affine_def
   21.47 -  apply rule
   21.48 -  apply(rule, rule, rule)
   21.49 -  apply(erule conjE)+
   21.50 -  defer
   21.51 -  apply (rule, rule, rule, rule, rule)
   21.52 +         (\<forall>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> V \<and> sum u S = 1 \<longrightarrow> (\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V)"
   21.53  proof -
   21.54 -  fix x y u v
   21.55 -  assume as: "x \<in> V" "y \<in> V" "u + v = (1::real)"
   21.56 -    "\<forall>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> V \<and> sum u s = 1 \<longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V"
   21.57 -  then show "u *\<^sub>R x + v *\<^sub>R y \<in> V"
   21.58 -    apply (cases "x = y")
   21.59 -    using as(4)[THEN spec[where x="{x,y}"], THEN spec[where x="\<lambda>w. if w = x then u else v"]]
   21.60 -      and as(1-3)
   21.61 -    apply (auto simp add: scaleR_left_distrib[symmetric])
   21.62 -    done
   21.63 -next
   21.64 -  fix s u
   21.65 -  assume as: "\<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
   21.66 -    "finite s" "s \<noteq> {}" "s \<subseteq> V" "sum u s = (1::real)"
   21.67 -  define n where "n = card s"
   21.68 -  have "card s = 0 \<or> card s = 1 \<or> card s = 2 \<or> card s > 2" by auto
   21.69 -  then show "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V"
   21.70 -  proof (auto simp only: disjE)
   21.71 -    assume "card s = 2"
   21.72 -    then have "card s = Suc (Suc 0)"
   21.73 -      by auto
   21.74 -    then obtain a b where "s = {a, b}"
   21.75 -      unfolding card_Suc_eq by auto
   21.76 +  have "u *\<^sub>R x + v *\<^sub>R y \<in> V" if "x \<in> V" "y \<in> V" "u + v = (1::real)"
   21.77 +    and *: "\<And>S u. \<lbrakk>finite S; S \<noteq> {}; S \<subseteq> V; sum u S = 1\<rbrakk> \<Longrightarrow> (\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V" for x y u v
   21.78 +  proof (cases "x = y")
   21.79 +    case True
   21.80 +    then show ?thesis
   21.81 +      using that by (metis scaleR_add_left scaleR_one)
   21.82 +  next
   21.83 +    case False
   21.84      then show ?thesis
   21.85 -      using as(1)[THEN bspec[where x=a], THEN bspec[where x=b]] using as(4,5)
   21.86 -      by (auto simp add: sum_clauses(2))
   21.87 -  next
   21.88 -    assume "card s > 2"
   21.89 -    then show ?thesis using as and n_def
   21.90 -    proof (induct n arbitrary: u s)
   21.91 -      case 0
   21.92 -      then show ?case by auto
   21.93 +      using that *[of "{x,y}" "\<lambda>w. if w = x then u else v"] by auto
   21.94 +  qed
   21.95 +  moreover have "(\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V"
   21.96 +                if *: "\<And>x y u v. \<lbrakk>x\<in>V; y\<in>V; u + v = 1\<rbrakk> \<Longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
   21.97 +                  and "finite S" "S \<noteq> {}" "S \<subseteq> V" "sum u S = 1" for S u
   21.98 +  proof -
   21.99 +    define n where "n = card S"
  21.100 +    consider "card S = 0" | "card S = 1" | "card S = 2" | "card S > 2" by linarith
  21.101 +    then show "(\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V"
  21.102 +    proof cases
  21.103 +      assume "card S = 1"
  21.104 +      then obtain a where "S={a}"
  21.105 +        by (auto simp: card_Suc_eq)
  21.106 +      then show ?thesis
  21.107 +        using that by simp
  21.108 +    next
  21.109 +      assume "card S = 2"
  21.110 +      then obtain a b where "S = {a, b}"
  21.111 +        by (metis Suc_1 card_1_singletonE card_Suc_eq)
  21.112 +      then show ?thesis
  21.113 +        using *[of a b] that
  21.114 +        by (auto simp: sum_clauses(2))
  21.115      next
  21.116 -      case (Suc n)
  21.117 -      fix s :: "'a set" and u :: "'a \<Rightarrow> real"
  21.118 -      assume IA:
  21.119 -        "\<And>u s.  \<lbrakk>2 < card s; \<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V; finite s;
  21.120 -          s \<noteq> {}; s \<subseteq> V; sum u s = 1; n = card s \<rbrakk> \<Longrightarrow> (\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V"
  21.121 -        and as:
  21.122 -          "Suc n = card s" "2 < card s" "\<forall>x\<in>V. \<forall>y\<in>V. \<forall>u v. u + v = 1 \<longrightarrow> u *\<^sub>R x + v *\<^sub>R y \<in> V"
  21.123 -           "finite s" "s \<noteq> {}" "s \<subseteq> V" "sum u s = 1"
  21.124 -      have "\<exists>x\<in>s. u x \<noteq> 1"
  21.125 -      proof (rule ccontr)
  21.126 -        assume "\<not> ?thesis"
  21.127 -        then have "sum u s = real_of_nat (card s)"
  21.128 -          unfolding card_eq_sum by auto
  21.129 -        then show False
  21.130 -          using as(7) and \<open>card s > 2\<close>
  21.131 -          by (metis One_nat_def less_Suc0 Zero_not_Suc of_nat_1 of_nat_eq_iff numeral_2_eq_2)
  21.132 +      assume "card S > 2"
  21.133 +      then show ?thesis using that n_def
  21.134 +      proof (induct n arbitrary: u S)
  21.135 +        case 0
  21.136 +        then show ?case by auto
  21.137 +      next
  21.138 +        case (Suc n u S)
  21.139 +        have "sum u S = card S" if "\<not> (\<exists>x\<in>S. u x \<noteq> 1)"
  21.140 +          using that unfolding card_eq_sum by auto
  21.141 +        with Suc.prems obtain x where "x \<in> S" and x: "u x \<noteq> 1" by force
  21.142 +        have c: "card (S - {x}) = card S - 1"
  21.143 +          by (simp add: Suc.prems(3) \<open>x \<in> S\<close>)
  21.144 +        have "sum u (S - {x}) = 1 - u x"
  21.145 +          by (simp add: Suc.prems sum_diff1_ring \<open>x \<in> S\<close>)
  21.146 +        with x have eq1: "inverse (1 - u x) * sum u (S - {x}) = 1"
  21.147 +          by auto
  21.148 +        have inV: "(\<Sum>y\<in>S - {x}. (inverse (1 - u x) * u y) *\<^sub>R y) \<in> V"
  21.149 +        proof (cases "card (S - {x}) > 2")
  21.150 +          case True
  21.151 +          then have S: "S - {x} \<noteq> {}" "card (S - {x}) = n"
  21.152 +            using Suc.prems c by force+
  21.153 +          show ?thesis
  21.154 +          proof (rule Suc.hyps)
  21.155 +            show "(\<Sum>a\<in>S - {x}. inverse (1 - u x) * u a) = 1"
  21.156 +              by (auto simp: eq1 sum_distrib_left[symmetric])
  21.157 +          qed (use S Suc.prems True in auto)
  21.158 +        next
  21.159 +          case False
  21.160 +          then have "card (S - {x}) = Suc (Suc 0)"
  21.161 +            using Suc.prems c by auto
  21.162 +          then obtain a b where ab: "(S - {x}) = {a, b}" "a\<noteq>b"
  21.163 +            unfolding card_Suc_eq by auto
  21.164 +          then show ?thesis
  21.165 +            using eq1 \<open>S \<subseteq> V\<close>
  21.166 +            by (auto simp: sum_distrib_left distrib_left intro!: Suc.prems(2)[of a b])
  21.167 +        qed
  21.168 +        have "u x + (1 - u x) = 1 \<Longrightarrow>
  21.169 +          u x *\<^sub>R x + (1 - u x) *\<^sub>R ((\<Sum>y\<in>S - {x}. u y *\<^sub>R y) /\<^sub>R (1 - u x)) \<in> V"
  21.170 +          by (rule Suc.prems) (use \<open>x \<in> S\<close> Suc.prems inV in \<open>auto simp: scaleR_right.sum\<close>)
  21.171 +        moreover have "(\<Sum>a\<in>S. u a *\<^sub>R a) = u x *\<^sub>R x + (\<Sum>a\<in>S - {x}. u a *\<^sub>R a)"
  21.172 +          by (meson Suc.prems(3) sum.remove \<open>x \<in> S\<close>)
  21.173 +        ultimately show "(\<Sum>x\<in>S. u x *\<^sub>R x) \<in> V"
  21.174 +          by (simp add: x)
  21.175        qed
  21.176 -      then obtain x where x:"x \<in> s" "u x \<noteq> 1" by auto
  21.177 -
  21.178 -      have c: "card (s - {x}) = card s - 1"
  21.179 -        apply (rule card_Diff_singleton)
  21.180 -        using \<open>x\<in>s\<close> as(4)
  21.181 -        apply auto
  21.182 -        done
  21.183 -      have *: "s = insert x (s - {x})" "finite (s - {x})"
  21.184 -        using \<open>x\<in>s\<close> and as(4) by auto
  21.185 -      have **: "sum u (s - {x}) = 1 - u x"
  21.186 -        using sum_clauses(2)[OF *(2), of u x, unfolded *(1)[symmetric] as(7)] by auto
  21.187 -      have ***: "inverse (1 - u x) * sum u (s - {x}) = 1"
  21.188 -        unfolding ** using \<open>u x \<noteq> 1\<close> by auto
  21.189 -      have "(\<Sum>xa\<in>s - {x}. (inverse (1 - u x) * u xa) *\<^sub>R xa) \<in> V"
  21.190 -      proof (cases "card (s - {x}) > 2")
  21.191 -        case True
  21.192 -        then have "s - {x} \<noteq> {}" "card (s - {x}) = n"
  21.193 -          unfolding c and as(1)[symmetric]
  21.194 -        proof (rule_tac ccontr)
  21.195 -          assume "\<not> s - {x} \<noteq> {}"
  21.196 -          then have "card (s - {x}) = 0" unfolding card_0_eq[OF *(2)] by simp
  21.197 -          then show False using True by auto
  21.198 -        qed auto
  21.199 -        then show ?thesis
  21.200 -          apply (rule_tac IA[of "s - {x}" "\<lambda>y. (inverse (1 - u x) * u y)"])
  21.201 -          unfolding sum_distrib_left[symmetric]
  21.202 -          using as and *** and True
  21.203 -          apply auto
  21.204 -          done
  21.205 -      next
  21.206 -        case False
  21.207 -        then have "card (s - {x}) = Suc (Suc 0)"
  21.208 -          using as(2) and c by auto
  21.209 -        then obtain a b where "(s - {x}) = {a, b}" "a\<noteq>b"
  21.210 -          unfolding card_Suc_eq by auto
  21.211 -        then show ?thesis
  21.212 -          using as(3)[THEN bspec[where x=a], THEN bspec[where x=b]]
  21.213 -          using *** *(2) and \<open>s \<subseteq> V\<close>
  21.214 -          unfolding sum_distrib_left
  21.215 -          by (auto simp add: sum_clauses(2))
  21.216 -      qed
  21.217 -      then have "u x + (1 - u x) = 1 \<Longrightarrow>
  21.218 -          u x *\<^sub>R x + (1 - u x) *\<^sub>R ((\<Sum>xa\<in>s - {x}. u xa *\<^sub>R xa) /\<^sub>R (1 - u x)) \<in> V"
  21.219 -        apply -
  21.220 -        apply (rule as(3)[rule_format])
  21.221 -        unfolding  Real_Vector_Spaces.scaleR_right.sum
  21.222 -        using x(1) as(6)
  21.223 -        apply auto
  21.224 -        done
  21.225 -      then show "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> V"
  21.226 -        unfolding scaleR_scaleR[symmetric] and scaleR_right.sum [symmetric]
  21.227 -        apply (subst *)
  21.228 -        unfolding sum_clauses(2)[OF *(2)]
  21.229 -        using \<open>u x \<noteq> 1\<close>
  21.230 -        apply auto
  21.231 -        done
  21.232 -    qed
  21.233 -  next
  21.234 -    assume "card s = 1"
  21.235 -    then obtain a where "s={a}"
  21.236 -      by (auto simp add: card_Suc_eq)
  21.237 -    then show ?thesis
  21.238 -      using as(4,5) by simp
  21.239 -  qed (insert \<open>s\<noteq>{}\<close> \<open>finite s\<close>, auto)
  21.240 -qed
  21.241 +    qed (use \<open>S\<noteq>{}\<close> \<open>finite S\<close> in auto)
  21.242 +  qed
  21.243 +  ultimately show ?thesis
  21.244 +    unfolding affine_def by meson
  21.245 +qed
  21.246 +
  21.247  
  21.248  lemma affine_hull_explicit:
  21.249 -  "affine hull p =
  21.250 -    {y. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> sum u s = 1 \<and> sum (\<lambda>v. (u v) *\<^sub>R v) s = y}"
  21.251 -  apply (rule hull_unique)
  21.252 -  apply (subst subset_eq)
  21.253 -  prefer 3
  21.254 -  apply rule
  21.255 -  unfolding mem_Collect_eq
  21.256 -  apply (erule exE)+
  21.257 -  apply (erule conjE)+
  21.258 -  prefer 2
  21.259 -  apply rule
  21.260 -proof -
  21.261 -  fix x
  21.262 -  assume "x\<in>p"
  21.263 -  then show "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
  21.264 -    apply (rule_tac x="{x}" in exI)
  21.265 -    apply (rule_tac x="\<lambda>x. 1" in exI)
  21.266 -    apply auto
  21.267 -    done
  21.268 -next
  21.269 -  fix t x s u
  21.270 -  assume as: "p \<subseteq> t" "affine t" "finite s" "s \<noteq> {}"
  21.271 -    "s \<subseteq> p" "sum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
  21.272 -  then show "x \<in> t"
  21.273 -    using as(2)[unfolded affine, THEN spec[where x=s], THEN spec[where x=u]]
  21.274 -    by auto
  21.275 -next
  21.276 -  show "affine {y. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y}"
  21.277 +  "affine hull p = {y. \<exists>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p \<and> sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
  21.278 +  (is "_ = ?rhs")
  21.279 +proof (rule hull_unique)
  21.280 +  show "p \<subseteq> ?rhs"
  21.281 +  proof (intro subsetI CollectI exI conjI)
  21.282 +    show "\<And>x. sum (\<lambda>z. 1) {x} = 1"
  21.283 +      by auto
  21.284 +  qed auto
  21.285 +  show "?rhs \<subseteq> T" if "p \<subseteq> T" "affine T" for T
  21.286 +    using that unfolding affine by blast
  21.287 +  show "affine ?rhs"
  21.288      unfolding affine_def
  21.289 -    apply (rule, rule, rule, rule, rule)
  21.290 -    unfolding mem_Collect_eq
  21.291 -  proof -
  21.292 -    fix u v :: real
  21.293 +  proof clarify
  21.294 +    fix u v :: real and sx ux sy uy
  21.295      assume uv: "u + v = 1"
  21.296 -    fix x
  21.297 -    assume "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
  21.298 -    then obtain sx ux where
  21.299 -      x: "finite sx" "sx \<noteq> {}" "sx \<subseteq> p" "sum ux sx = 1" "(\<Sum>v\<in>sx. ux v *\<^sub>R v) = x"
  21.300 -      by auto
  21.301 -    fix y
  21.302 -    assume "\<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
  21.303 -    then obtain sy uy where
  21.304 -      y: "finite sy" "sy \<noteq> {}" "sy \<subseteq> p" "sum uy sy = 1" "(\<Sum>v\<in>sy. uy v *\<^sub>R v) = y" by auto
  21.305 -    have xy: "finite (sx \<union> sy)"
  21.306 -      using x(1) y(1) by auto
  21.307 +      and x: "finite sx" "sx \<noteq> {}" "sx \<subseteq> p" "sum ux sx = (1::real)"
  21.308 +      and y: "finite sy" "sy \<noteq> {}" "sy \<subseteq> p" "sum uy sy = (1::real)" 
  21.309      have **: "(sx \<union> sy) \<inter> sx = sx" "(sx \<union> sy) \<inter> sy = sy"
  21.310        by auto
  21.311 -    show "\<exists>s ua. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p \<and>
  21.312 -        sum ua s = 1 \<and> (\<Sum>v\<in>s. ua v *\<^sub>R v) = u *\<^sub>R x + v *\<^sub>R y"
  21.313 -      apply (rule_tac x="sx \<union> sy" in exI)
  21.314 -      apply (rule_tac x="\<lambda>a. (if a\<in>sx then u * ux a else 0) + (if a\<in>sy then v * uy a else 0)" in exI)
  21.315 -      unfolding scaleR_left_distrib sum.distrib if_smult scaleR_zero_left
  21.316 -        ** sum.inter_restrict[OF xy, symmetric]
  21.317 -      unfolding scaleR_scaleR[symmetric] Real_Vector_Spaces.scaleR_right.sum [symmetric]
  21.318 -        and sum_distrib_left[symmetric]
  21.319 -      unfolding x y
  21.320 -      using x(1-3) y(1-3) uv
  21.321 -      apply simp
  21.322 -      done
  21.323 +    show "\<exists>S w. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p \<and>
  21.324 +        sum w S = 1 \<and> (\<Sum>v\<in>S. w v *\<^sub>R v) = u *\<^sub>R (\<Sum>v\<in>sx. ux v *\<^sub>R v) + v *\<^sub>R (\<Sum>v\<in>sy. uy v *\<^sub>R v)"
  21.325 +    proof (intro exI conjI)
  21.326 +      show "finite (sx \<union> sy)"
  21.327 +        using x y by auto
  21.328 +      show "sum (\<lambda>i. (if i\<in>sx then u * ux i else 0) + (if i\<in>sy then v * uy i else 0)) (sx \<union> sy) = 1"
  21.329 +        using x y uv
  21.330 +        by (simp add: sum_Un sum.distrib sum.inter_restrict[symmetric] sum_distrib_left [symmetric] **)
  21.331 +      have "(\<Sum>i\<in>sx \<union> sy. ((if i \<in> sx then u * ux i else 0) + (if i \<in> sy then v * uy i else 0)) *\<^sub>R i)
  21.332 +          = (\<Sum>i\<in>sx. (u * ux i) *\<^sub>R i) + (\<Sum>i\<in>sy. (v * uy i) *\<^sub>R i)"
  21.333 +        using x y
  21.334 +        unfolding scaleR_left_distrib scaleR_zero_left if_smult
  21.335 +        by (simp add: sum_Un sum.distrib sum.inter_restrict[symmetric]  **)
  21.336 +      also have "\<dots> = u *\<^sub>R (\<Sum>v\<in>sx. ux v *\<^sub>R v) + v *\<^sub>R (\<Sum>v\<in>sy. uy v *\<^sub>R v)"
  21.337 +        unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] by blast
  21.338 +      finally show "(\<Sum>i\<in>sx \<union> sy. ((if i \<in> sx then u * ux i else 0) + (if i \<in> sy then v * uy i else 0)) *\<^sub>R i) 
  21.339 +                  = u *\<^sub>R (\<Sum>v\<in>sx. ux v *\<^sub>R v) + v *\<^sub>R (\<Sum>v\<in>sy. uy v *\<^sub>R v)" .
  21.340 +    qed (use x y in auto)
  21.341    qed
  21.342  qed
  21.343  
  21.344  lemma affine_hull_finite:
  21.345 -  assumes "finite s"
  21.346 -  shows "affine hull s = {y. \<exists>u. sum u s = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) s = y}"
  21.347 -  unfolding affine_hull_explicit and set_eq_iff and mem_Collect_eq
  21.348 -  apply (rule, rule)
  21.349 -  apply (erule exE)+
  21.350 -  apply (erule conjE)+
  21.351 -  defer
  21.352 -  apply (erule exE)
  21.353 -  apply (erule conjE)
  21.354 +  assumes "finite S"
  21.355 +  shows "affine hull S = {y. \<exists>u. sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
  21.356  proof -
  21.357 -  fix x u
  21.358 -  assume "sum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
  21.359 -  then show "\<exists>sa u. finite sa \<and>
  21.360 -      \<not> (\<forall>x. (x \<in> sa) = (x \<in> {})) \<and> sa \<subseteq> s \<and> sum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = x"
  21.361 -    apply (rule_tac x=s in exI, rule_tac x=u in exI)
  21.362 -    using assms
  21.363 -    apply auto
  21.364 -    done
  21.365 -next
  21.366 -  fix x t u
  21.367 -  assume "t \<subseteq> s"
  21.368 -  then have *: "s \<inter> t = t"
  21.369 -    by auto
  21.370 -  assume "finite t" "\<not> (\<forall>x. (x \<in> t) = (x \<in> {}))" "sum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = x"
  21.371 -  then show "\<exists>u. sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
  21.372 -    apply (rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
  21.373 -    unfolding if_smult scaleR_zero_left and sum.inter_restrict[OF assms, symmetric] and *
  21.374 -    apply auto
  21.375 -    done
  21.376 +  have *: "\<exists>h. sum h S = 1 \<and> (\<Sum>v\<in>S. h v *\<^sub>R v) = x" 
  21.377 +    if "F \<subseteq> S" "finite F" "F \<noteq> {}" and sum: "sum u F = 1" and x: "(\<Sum>v\<in>F. u v *\<^sub>R v) = x" for x F u
  21.378 +  proof -
  21.379 +    have "S \<inter> F = F"
  21.380 +      using that by auto
  21.381 +    show ?thesis
  21.382 +    proof (intro exI conjI)
  21.383 +      show "(\<Sum>x\<in>S. if x \<in> F then u x else 0) = 1"
  21.384 +        by (metis (mono_tags, lifting) \<open>S \<inter> F = F\<close> assms sum.inter_restrict sum)
  21.385 +      show "(\<Sum>v\<in>S. (if v \<in> F then u v else 0) *\<^sub>R v) = x"
  21.386 +        by (simp add: if_smult cong: if_cong) (metis (no_types) \<open>S \<inter> F = F\<close> assms sum.inter_restrict x)
  21.387 +    qed
  21.388 +  qed
  21.389 +  show ?thesis
  21.390 +    unfolding affine_hull_explicit using assms
  21.391 +    by (fastforce dest: *)
  21.392  qed
  21.393  
  21.394  
  21.395  subsubsection%unimportant \<open>Stepping theorems and hence small special cases\<close>
  21.396  
  21.397  lemma affine_hull_empty[simp]: "affine hull {} = {}"
  21.398 -  by (rule hull_unique) auto
  21.399 -
  21.400 -(*could delete: it simply rewrites sum expressions, but it's used twice*)
  21.401 +  by simp
  21.402 +
  21.403  lemma affine_hull_finite_step:
  21.404    fixes y :: "'a::real_vector"
  21.405 -  shows
  21.406 -    "(\<exists>u. sum u {} = w \<and> sum (\<lambda>x. u x *\<^sub>R x) {} = y) \<longleftrightarrow> w = 0 \<and> y = 0" (is ?th1)
  21.407 -    and
  21.408 -    "finite s \<Longrightarrow>
  21.409 -      (\<exists>u. sum u (insert a s) = w \<and> sum (\<lambda>x. u x *\<^sub>R x) (insert a s) = y) \<longleftrightarrow>
  21.410 -      (\<exists>v u. sum u s = w - v \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y - v *\<^sub>R a)" (is "_ \<Longrightarrow> ?lhs = ?rhs")
  21.411 +  shows "finite S \<Longrightarrow>
  21.412 +      (\<exists>u. sum u (insert a S) = w \<and> sum (\<lambda>x. u x *\<^sub>R x) (insert a S) = y) \<longleftrightarrow>
  21.413 +      (\<exists>v u. sum u S = w - v \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y - v *\<^sub>R a)" (is "_ \<Longrightarrow> ?lhs = ?rhs")
  21.414  proof -
  21.415 -  show ?th1 by simp
  21.416 -  assume fin: "finite s"
  21.417 +  assume fin: "finite S"
  21.418    show "?lhs = ?rhs"
  21.419    proof
  21.420      assume ?lhs
  21.421 -    then obtain u where u: "sum u (insert a s) = w \<and> (\<Sum>x\<in>insert a s. u x *\<^sub>R x) = y"
  21.422 +    then obtain u where u: "sum u (insert a S) = w \<and> (\<Sum>x\<in>insert a S. u x *\<^sub>R x) = y"
  21.423        by auto
  21.424      show ?rhs
  21.425 -    proof (cases "a \<in> s")
  21.426 +    proof (cases "a \<in> S")
  21.427        case True
  21.428 -      then have *: "insert a s = s" by auto
  21.429 -      show ?thesis
  21.430 -        using u[unfolded *]
  21.431 -        apply(rule_tac x=0 in exI)
  21.432 -        apply auto
  21.433 -        done
  21.434 +      then show ?thesis
  21.435 +        using u by (simp add: insert_absorb) (metis diff_zero real_vector.scale_zero_left)
  21.436      next
  21.437        case False
  21.438 -      then show ?thesis
  21.439 -        apply (rule_tac x="u a" in exI)
  21.440 -        using u and fin
  21.441 -        apply auto
  21.442 -        done
  21.443 +      show ?thesis
  21.444 +        by (rule exI [where x="u a"]) (use u fin False in auto)
  21.445      qed
  21.446    next
  21.447      assume ?rhs
  21.448 -    then obtain v u where vu: "sum u s = w - v"  "(\<Sum>x\<in>s. u x *\<^sub>R x) = y - v *\<^sub>R a"
  21.449 +    then obtain v u where vu: "sum u S = w - v"  "(\<Sum>x\<in>S. u x *\<^sub>R x) = y - v *\<^sub>R a"
  21.450        by auto
  21.451      have *: "\<And>x M. (if x = a then v else M) *\<^sub>R x = (if x = a then v *\<^sub>R x else M *\<^sub>R x)"
  21.452        by auto
  21.453      show ?lhs
  21.454 -    proof (cases "a \<in> s")
  21.455 +    proof (cases "a \<in> S")
  21.456        case True
  21.457 -      then show ?thesis
  21.458 -        apply (rule_tac x="\<lambda>x. (if x=a then v else 0) + u x" in exI)
  21.459 -        unfolding sum_clauses(2)[OF fin]
  21.460 -        apply simp
  21.461 -        unfolding scaleR_left_distrib and sum.distrib
  21.462 -        unfolding vu and * and scaleR_zero_left
  21.463 -        apply (auto simp add: sum.delta[OF fin])
  21.464 -        done
  21.465 +      show ?thesis
  21.466 +        by (rule exI [where x="\<lambda>x. (if x=a then v else 0) + u x"])
  21.467 +           (simp add: True scaleR_left_distrib sum.distrib sum_clauses fin vu * cong: if_cong)
  21.468      next
  21.469        case False
  21.470 -      then have **:
  21.471 -        "\<And>x. x \<in> s \<Longrightarrow> u x = (if x = a then v else u x)"
  21.472 -        "\<And>x. x \<in> s \<Longrightarrow> u x *\<^sub>R x = (if x = a then v *\<^sub>R x else u x *\<^sub>R x)" by auto
  21.473 -      from False show ?thesis
  21.474 -        apply (rule_tac x="\<lambda>x. if x=a then v else u x" in exI)
  21.475 -        unfolding sum_clauses(2)[OF fin] and * using vu
  21.476 -        using sum.cong [of s _ "\<lambda>x. u x *\<^sub>R x" "\<lambda>x. if x = a then v *\<^sub>R x else u x *\<^sub>R x", OF _ **(2)]
  21.477 -        using sum.cong [of s _ u "\<lambda>x. if x = a then v else u x", OF _ **(1)]
  21.478 -        apply auto
  21.479 -        done
  21.480 +      then show ?thesis
  21.481 +        apply (rule_tac x="\<lambda>x. if x=a then v else u x" in exI) 
  21.482 +        apply (simp add: vu sum_clauses(2)[OF fin] *)
  21.483 +        by (simp add: sum_delta_notmem(3) vu)
  21.484      qed
  21.485    qed
  21.486  qed
  21.487 @@ -1652,7 +1557,7 @@
  21.488    have "?lhs = {y. \<exists>u. sum u {a, b} = 1 \<and> (\<Sum>v\<in>{a, b}. u v *\<^sub>R v) = y}"
  21.489      using affine_hull_finite[of "{a,b}"] by auto
  21.490    also have "\<dots> = {y. \<exists>v u. u b = 1 - v \<and> u b *\<^sub>R b = y - v *\<^sub>R a}"
  21.491 -    by (simp add: affine_hull_finite_step(2)[of "{b}" a])
  21.492 +    by (simp add: affine_hull_finite_step[of "{b}" a])
  21.493    also have "\<dots> = ?rhs" unfolding * by auto
  21.494    finally show ?thesis by auto
  21.495  qed
  21.496 @@ -1667,12 +1572,9 @@
  21.497    show ?thesis
  21.498      apply (simp add: affine_hull_finite affine_hull_finite_step)
  21.499      unfolding *
  21.500 -    apply auto
  21.501 -    apply (rule_tac x=v in exI)
  21.502 -    apply (rule_tac x=va in exI)
  21.503 -    apply auto
  21.504 -    apply (rule_tac x=u in exI)
  21.505 -    apply force
  21.506 +    apply safe
  21.507 +     apply (metis add.assoc)
  21.508 +    apply (rule_tac x=u in exI, force)
  21.509      done
  21.510  qed
  21.511  
  21.512 @@ -1710,56 +1612,57 @@
  21.513  subsubsection%unimportant \<open>Some relations between affine hull and subspaces\<close>
  21.514  
  21.515  lemma affine_hull_insert_subset_span:
  21.516 -  "affine hull (insert a s) \<subseteq> {a + v| v . v \<in> span {x - a | x . x \<in> s}}"
  21.517 -  unfolding subset_eq Ball_def
  21.518 -  unfolding affine_hull_explicit span_explicit mem_Collect_eq
  21.519 -  apply (rule, rule)
  21.520 -  apply (erule exE)+
  21.521 -  apply (erule conjE)+
  21.522 +  "affine hull (insert a S) \<subseteq> {a + v| v . v \<in> span {x - a | x . x \<in> S}}"
  21.523  proof -
  21.524 -  fix x t u
  21.525 -  assume as: "finite t" "t \<noteq> {}" "t \<subseteq> insert a s" "sum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = x"
  21.526 -  have "(\<lambda>x. x - a) ` (t - {a}) \<subseteq> {x - a |x. x \<in> s}"
  21.527 -    using as(3) by auto
  21.528 -  then show "\<exists>v. x = a + v \<and> (\<exists>S u. v = (\<Sum>v\<in>S. u v *\<^sub>R v) \<and> finite S \<and> S \<subseteq> {x - a |x. x \<in> s} )"
  21.529 -    apply (rule_tac x="x - a" in exI)
  21.530 -    apply (rule conjI, simp)
  21.531 -    apply (rule_tac x="(\<lambda>x. x - a) ` (t - {a})" in exI)
  21.532 -    apply (rule_tac x="\<lambda>x. u (x + a)" in exI)
  21.533 -    by (simp_all add: as sum.reindex[unfolded inj_on_def] scaleR_right_diff_distrib
  21.534 -        sum_subtractf scaleR_left.sum[symmetric] sum_diff1 scaleR_left_diff_distrib)
  21.535 +  have "\<exists>v T u. x = a + v \<and> (finite T \<and> T \<subseteq> {x - a |x. x \<in> S} \<and> (\<Sum>v\<in>T. u v *\<^sub>R v) = v)"
  21.536 +    if "finite F" "F \<noteq> {}" "F \<subseteq> insert a S" "sum u F = 1" "(\<Sum>v\<in>F. u v *\<^sub>R v) = x"
  21.537 +    for x F u
  21.538 +  proof -
  21.539 +    have *: "(\<lambda>x. x - a) ` (F - {a}) \<subseteq> {x - a |x. x \<in> S}"
  21.540 +      using that by auto
  21.541 +    show ?thesis
  21.542 +    proof (intro exI conjI)
  21.543 +      show "finite ((\<lambda>x. x - a) ` (F - {a}))"
  21.544 +        by (simp add: that(1))
  21.545 +      show "(\<Sum>v\<in>(\<lambda>x. x - a) ` (F - {a}). u(v+a) *\<^sub>R v) = x-a"
  21.546 +        by (simp add: sum.reindex[unfolded inj_on_def] algebra_simps
  21.547 +            sum_subtractf scaleR_left.sum[symmetric] sum_diff1 that)
  21.548 +    qed (use \<open>F \<subseteq> insert a S\<close> in auto)
  21.549 +  qed
  21.550 +  then show ?thesis
  21.551 +    unfolding affine_hull_explicit span_explicit by auto
  21.552  qed
  21.553  
  21.554  lemma affine_hull_insert_span:
  21.555 -  assumes "a \<notin> s"
  21.556 -  shows "affine hull (insert a s) = {a + v | v . v \<in> span {x - a | x.  x \<in> s}}"
  21.557 -  apply (rule, rule affine_hull_insert_subset_span)
  21.558 -  unfolding subset_eq Ball_def
  21.559 -  unfolding affine_hull_explicit and mem_Collect_eq
  21.560 -proof (rule, rule, erule exE, erule conjE)
  21.561 -  fix y v
  21.562 -  assume "y = a + v" "v \<in> span {x - a |x. x \<in> s}"
  21.563 -  then obtain t u where obt: "finite t" "t \<subseteq> {x - a |x. x \<in> s}" "a + (\<Sum>v\<in>t. u v *\<^sub>R v) = y"
  21.564 -    unfolding span_explicit by auto
  21.565 -  define f where "f = (\<lambda>x. x + a) ` t"
  21.566 -  have f: "finite f" "f \<subseteq> s" "(\<Sum>v\<in>f. u (v - a) *\<^sub>R (v - a)) = y - a"
  21.567 -    unfolding f_def using obt by (auto simp add: sum.reindex[unfolded inj_on_def])
  21.568 -  have *: "f \<inter> {a} = {}" "f \<inter> - {a} = f"
  21.569 -    using f(2) assms by auto
  21.570 -  show "\<exists>sa u. finite sa \<and> sa \<noteq> {} \<and> sa \<subseteq> insert a s \<and> sum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = y"
  21.571 -    apply (rule_tac x = "insert a f" in exI)
  21.572 -    apply (rule_tac x = "\<lambda>x. if x=a then 1 - sum (\<lambda>x. u (x - a)) f else u (x - a)" in exI)
  21.573 -    using assms and f
  21.574 -    unfolding sum_clauses(2)[OF f(1)] and if_smult
  21.575 -    unfolding sum.If_cases[OF f(1), of "\<lambda>x. x = a"]
  21.576 -    apply (auto simp add: sum_subtractf scaleR_left.sum algebra_simps *)
  21.577 -    done
  21.578 +  assumes "a \<notin> S"
  21.579 +  shows "affine hull (insert a S) = {a + v | v . v \<in> span {x - a | x.  x \<in> S}}"
  21.580 +proof -
  21.581 +  have *: "\<exists>G u. finite G \<and> G \<noteq> {} \<and> G \<subseteq> insert a S \<and> sum u G = 1 \<and> (\<Sum>v\<in>G. u v *\<^sub>R v) = y"
  21.582 +    if "v \<in> span {x - a |x. x \<in> S}" "y = a + v" for y v
  21.583 +  proof -
  21.584 +    from that
  21.585 +    obtain T u where u: "finite T" "T \<subseteq> {x - a |x. x \<in> S}" "a + (\<Sum>v\<in>T. u v *\<^sub>R v) = y"
  21.586 +      unfolding span_explicit by auto
  21.587 +    define F where "F = (\<lambda>x. x + a) ` T"
  21.588 +    have F: "finite F" "F \<subseteq> S" "(\<Sum>v\<in>F. u (v - a) *\<^sub>R (v - a)) = y - a"
  21.589 +      unfolding F_def using u by (auto simp: sum.reindex[unfolded inj_on_def])
  21.590 +    have *: "F \<inter> {a} = {}" "F \<inter> - {a} = F"
  21.591 +      using F assms by auto
  21.592 +    show "\<exists>G u. finite G \<and> G \<noteq> {} \<and> G \<subseteq> insert a S \<and> sum u G = 1 \<and> (\<Sum>v\<in>G. u v *\<^sub>R v) = y"
  21.593 +      apply (rule_tac x = "insert a F" in exI)
  21.594 +      apply (rule_tac x = "\<lambda>x. if x=a then 1 - sum (\<lambda>x. u (x - a)) F else u (x - a)" in exI)
  21.595 +      using assms F
  21.596 +      apply (auto simp:  sum_clauses sum.If_cases if_smult sum_subtractf scaleR_left.sum algebra_simps *)
  21.597 +      done
  21.598 +  qed
  21.599 +  show ?thesis
  21.600 +    by (intro subset_antisym affine_hull_insert_subset_span) (auto simp: affine_hull_explicit dest!: *)
  21.601  qed
  21.602  
  21.603  lemma affine_hull_span:
  21.604 -  assumes "a \<in> s"
  21.605 -  shows "affine hull s = {a + v | v. v \<in> span {x - a | x. x \<in> s - {a}}}"
  21.606 -  using affine_hull_insert_span[of a "s - {a}", unfolded insert_Diff[OF assms]] by auto
  21.607 +  assumes "a \<in> S"
  21.608 +  shows "affine hull S = {a + v | v. v \<in> span {x - a | x. x \<in> S - {a}}}"
  21.609 +  using affine_hull_insert_span[of a "S - {a}", unfolded insert_Diff[OF assms]] by auto
  21.610  
  21.611  
  21.612  subsubsection%unimportant \<open>Parallel affine sets\<close>
  21.613 @@ -1769,17 +1672,12 @@
  21.614  
  21.615  lemma affine_parallel_expl_aux:
  21.616    fixes S T :: "'a::real_vector set"
  21.617 -  assumes "\<forall>x. x \<in> S \<longleftrightarrow> a + x \<in> T"
  21.618 +  assumes "\<And>x. x \<in> S \<longleftrightarrow> a + x \<in> T"
  21.619    shows "T = (\<lambda>x. a + x) ` S"
  21.620  proof -
  21.621 -  {
  21.622 -    fix x
  21.623 -    assume "x \<in> T"
  21.624 -    then have "( - a) + x \<in> S"
  21.625 -      using assms by auto
  21.626 -    then have "x \<in> ((\<lambda>x. a + x) ` S)"
  21.627 -      using imageI[of "-a+x" S "(\<lambda>x. a+x)"] by auto
  21.628 -  }
  21.629 +  have "x \<in> ((\<lambda>x. a + x) ` S)" if "x \<in> T" for x
  21.630 +    using that
  21.631 +    by (simp add: image_iff) (metis add.commute diff_add_cancel assms)
  21.632    moreover have "T \<ge> (\<lambda>x. a + x) ` S"
  21.633      using assms by auto
  21.634    ultimately show ?thesis by auto
  21.635 @@ -1791,9 +1689,7 @@
  21.636  
  21.637  lemma affine_parallel_reflex: "affine_parallel S S"
  21.638    unfolding affine_parallel_def
  21.639 -  apply (rule exI[of _ "0"])
  21.640 -  apply auto
  21.641 -  done
  21.642 +  using image_add_0 by blast
  21.643  
  21.644  lemma affine_parallel_commut:
  21.645    assumes "affine_parallel A B"
  21.646 @@ -2109,7 +2005,7 @@
  21.647    shows "c *\<^sub>R x \<in> cone hull S"
  21.648    by (metis assms cone_cone_hull hull_inc mem_cone)
  21.649  
  21.650 -lemma%important cone_hull_expl: "cone hull S = {c *\<^sub>R x | c x. c \<ge> 0 \<and> x \<in> S}"
  21.651 +proposition%important cone_hull_expl: "cone hull S = {c *\<^sub>R x | c x. c \<ge> 0 \<and> x \<in> S}"
  21.652    (is "?lhs = ?rhs")
  21.653  proof%unimportant -
  21.654    {
  21.655 @@ -2135,8 +2031,7 @@
  21.656      assume "x \<in> S"
  21.657      then have "1 *\<^sub>R x \<in> ?rhs"
  21.658        apply auto
  21.659 -      apply (rule_tac x = 1 in exI)
  21.660 -      apply auto
  21.661 +      apply (rule_tac x = 1 in exI, auto)
  21.662        done
  21.663      then have "x \<in> ?rhs" by auto
  21.664    }
  21.665 @@ -2169,7 +2064,7 @@
  21.666    then have "0 \<in> S \<and> (\<forall>c. c > 0 \<longrightarrow> ( *\<^sub>R) c ` S = S)"
  21.667      using cone_iff[of S] assms by auto
  21.668    then have "0 \<in> closure S \<and> (\<forall>c. c > 0 \<longrightarrow> ( *\<^sub>R) c ` closure S = closure S)"
  21.669 -    using closure_subset by (auto simp add: closure_scaleR)
  21.670 +    using closure_subset by (auto simp: closure_scaleR)
  21.671    then show ?thesis
  21.672      using False cone_iff[of "closure S"] by auto
  21.673  qed
  21.674 @@ -2194,66 +2089,60 @@
  21.675     "~ affine_dependent s \<Longrightarrow> ~ affine_dependent(s - t)"
  21.676  by (meson Diff_subset affine_dependent_subset)
  21.677  
  21.678 -lemma%important affine_dependent_explicit:
  21.679 +proposition%important affine_dependent_explicit:
  21.680    "affine_dependent p \<longleftrightarrow>
  21.681 -    (\<exists>s u. finite s \<and> s \<subseteq> p \<and> sum u s = 0 \<and>
  21.682 -      (\<exists>v\<in>s. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) s = 0)"
  21.683 -  unfolding%unimportant affine_dependent_def affine_hull_explicit mem_Collect_eq
  21.684 -  apply rule
  21.685 -  apply (erule bexE, erule exE, erule exE)
  21.686 -  apply (erule conjE)+
  21.687 -  defer
  21.688 -  apply (erule exE, erule exE)
  21.689 -  apply (erule conjE)+
  21.690 -  apply (erule bexE)
  21.691 +    (\<exists>S u. finite S \<and> S \<subseteq> p \<and> sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) S = 0)"
  21.692  proof -
  21.693 -  fix x s u
  21.694 -  assume as: "x \<in> p" "finite s" "s \<noteq> {}" "s \<subseteq> p - {x}" "sum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = x"
  21.695 -  have "x \<notin> s" using as(1,4) by auto
  21.696 -  show "\<exists>s u. finite s \<and> s \<subseteq> p \<and> sum u s = 0 \<and> (\<exists>v\<in>s. u v \<noteq> 0) \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
  21.697 -    apply (rule_tac x="insert x s" in exI, rule_tac x="\<lambda>v. if v = x then - 1 else u v" in exI)
  21.698 -    unfolding if_smult and sum_clauses(2)[OF as(2)] and sum_delta_notmem[OF \<open>x\<notin>s\<close>] and as
  21.699 -    using as
  21.700 -    apply auto
  21.701 -    done
  21.702 -next
  21.703 -  fix s u v
  21.704 -  assume as: "finite s" "s \<subseteq> p" "sum u s = 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0" "v \<in> s" "u v \<noteq> 0"
  21.705 -  have "s \<noteq> {v}"
  21.706 -    using as(3,6) by auto
  21.707 -  then show "\<exists>x\<in>p. \<exists>s u. finite s \<and> s \<noteq> {} \<and> s \<subseteq> p - {x} \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
  21.708 -    apply (rule_tac x=v in bexI)
  21.709 -    apply (rule_tac x="s - {v}" in exI)
  21.710 -    apply (rule_tac x="\<lambda>x. - (1 / u v) * u x" in exI)
  21.711 -    unfolding scaleR_scaleR[symmetric] and scaleR_right.sum [symmetric]
  21.712 -    unfolding sum_distrib_left[symmetric] and sum_diff1[OF as(1)]
  21.713 -    using as
  21.714 -    apply auto
  21.715 -    done
  21.716 +  have "\<exists>S u. finite S \<and> S \<subseteq> p \<and> sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> (\<Sum>w\<in>S. u w *\<^sub>R w) = 0"
  21.717 +    if "(\<Sum>w\<in>S. u w *\<^sub>R w) = x" "x \<in> p" "finite S" "S \<noteq> {}" "S \<subseteq> p - {x}" "sum u S = 1" for x S u
  21.718 +  proof (intro exI conjI)
  21.719 +    have "x \<notin> S" 
  21.720 +      using that by auto
  21.721 +    then show "(\<Sum>v \<in> insert x S. if v = x then - 1 else u v) = 0"
  21.722 +      using that by (simp add: sum_delta_notmem)
  21.723 +    show "(\<Sum>w \<in> insert x S. (if w = x then - 1 else u w) *\<^sub>R w) = 0"
  21.724 +      using that \<open>x \<notin> S\<close> by (simp add: if_smult sum_delta_notmem cong: if_cong)
  21.725 +  qed (use that in auto)
  21.726 +  moreover have "\<exists>x\<in>p. \<exists>S u. finite S \<and> S \<noteq> {} \<and> S \<subseteq> p - {x} \<and> sum u S = 1 \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = x"
  21.727 +    if "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0" "finite S" "S \<subseteq> p" "sum u S = 0" "v \<in> S" "u v \<noteq> 0" for S u v
  21.728 +  proof (intro bexI exI conjI)
  21.729 +    have "S \<noteq> {v}"
  21.730 +      using that by auto
  21.731 +    then show "S - {v} \<noteq> {}"
  21.732 +      using that by auto
  21.733 +    show "(\<Sum>x \<in> S - {v}. - (1 / u v) * u x) = 1"
  21.734 +      unfolding sum_distrib_left[symmetric] sum_diff1[OF \<open>finite S\<close>] by (simp add: that)
  21.735 +    show "(\<Sum>x\<in>S - {v}. (- (1 / u v) * u x) *\<^sub>R x) = v"
  21.736 +      unfolding sum_distrib_left [symmetric] scaleR_scaleR[symmetric]
  21.737 +                scaleR_right.sum [symmetric] sum_diff1[OF \<open>finite S\<close>] 
  21.738 +      using that by auto
  21.739 +    show "S - {v} \<subseteq> p - {v}"
  21.740 +      using that by auto
  21.741 +  qed (use that in auto)
  21.742 +  ultimately show ?thesis
  21.743 +    unfolding affine_dependent_def affine_hull_explicit by auto
  21.744  qed
  21.745  
  21.746  lemma affine_dependent_explicit_finite:
  21.747 -  fixes s :: "'a::real_vector set"
  21.748 -  assumes "finite s"
  21.749 -  shows "affine_dependent s \<longleftrightarrow>
  21.750 -    (\<exists>u. sum u s = 0 \<and> (\<exists>v\<in>s. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) s = 0)"
  21.751 +  fixes S :: "'a::real_vector set"
  21.752 +  assumes "finite S"
  21.753 +  shows "affine_dependent S \<longleftrightarrow>
  21.754 +    (\<exists>u. sum u S = 0 \<and> (\<exists>v\<in>S. u v \<noteq> 0) \<and> sum (\<lambda>v. u v *\<^sub>R v) S = 0)"
  21.755    (is "?lhs = ?rhs")
  21.756  proof
  21.757    have *: "\<And>vt u v. (if vt then u v else 0) *\<^sub>R v = (if vt then (u v) *\<^sub>R v else 0::'a)"
  21.758      by auto
  21.759    assume ?lhs
  21.760    then obtain t u v where
  21.761 -    "finite t" "t \<subseteq> s" "sum u t = 0" "v\<in>t" "u v \<noteq> 0"  "(\<Sum>v\<in>t. u v *\<^sub>R v) = 0"
  21.762 +    "finite t" "t \<subseteq> S" "sum u t = 0" "v\<in>t" "u v \<noteq> 0"  "(\<Sum>v\<in>t. u v *\<^sub>R v) = 0"
  21.763      unfolding affine_dependent_explicit by auto
  21.764    then show ?rhs
  21.765      apply (rule_tac x="\<lambda>x. if x\<in>t then u x else 0" in exI)
  21.766 -    apply auto unfolding * and sum.inter_restrict[OF assms, symmetric]
  21.767 -    unfolding Int_absorb1[OF \<open>t\<subseteq>s\<close>]
  21.768 -    apply auto
  21.769 +    apply (auto simp: * sum.inter_restrict[OF assms, symmetric] Int_absorb1[OF \<open>t\<subseteq>S\<close>])
  21.770      done
  21.771  next
  21.772    assume ?rhs
  21.773 -  then obtain u v where "sum u s = 0"  "v\<in>s" "u v \<noteq> 0" "(\<Sum>v\<in>s. u v *\<^sub>R v) = 0"
  21.774 +  then obtain u v where "sum u S = 0"  "v\<in>S" "u v \<noteq> 0" "(\<Sum>v\<in>S. u v *\<^sub>R v) = 0"
  21.775      by auto
  21.776    then show ?lhs unfolding affine_dependent_explicit
  21.777      using assms by auto
  21.778 @@ -2267,15 +2156,15 @@
  21.779    by (rule Topological_Spaces.topological_space_class.connectedD)
  21.780  
  21.781  lemma convex_connected:
  21.782 -  fixes s :: "'a::real_normed_vector set"
  21.783 -  assumes "convex s"
  21.784 -  shows "connected s"
  21.785 +  fixes S :: "'a::real_normed_vector set"
  21.786 +  assumes "convex S"
  21.787 +  shows "connected S"
  21.788  proof (rule connectedI)
  21.789    fix A B
  21.790 -  assume "open A" "open B" "A \<inter> B \<inter> s = {}" "s \<subseteq> A \<union> B"
  21.791 +  assume "open A" "open B" "A \<inter> B \<inter> S = {}" "S \<subseteq> A \<union> B"
  21.792    moreover
  21.793 -  assume "A \<inter> s \<noteq> {}" "B \<inter> s \<noteq> {}"
  21.794 -  then obtain a b where a: "a \<in> A" "a \<in> s" and b: "b \<in> B" "b \<in> s" by auto
  21.795 +  assume "A \<inter> S \<noteq> {}" "B \<inter> S \<noteq> {}"
  21.796 +  then obtain a b where a: "a \<in> A" "a \<in> S" and b: "b \<in> B" "b \<in> S" by auto
  21.797    define f where [abs_def]: "f u = u *\<^sub>R a + (1 - u) *\<^sub>R b" for u
  21.798    then have "continuous_on {0 .. 1} f"
  21.799      by (auto intro!: continuous_intros)
  21.800 @@ -2286,8 +2175,8 @@
  21.801      using a by (auto intro!: image_eqI[of _ _ 1] simp: f_def)
  21.802    moreover have "b \<in> B \<inter> f ` {0 .. 1}"
  21.803      using b by (auto intro!: image_eqI[of _ _ 0] simp: f_def)
  21.804 -  moreover have "f ` {0 .. 1} \<subseteq> s"
  21.805 -    using \<open>convex s\<close> a b unfolding convex_def f_def by auto
  21.806 +  moreover have "f ` {0 .. 1} \<subseteq> S"
  21.807 +    using \<open>convex S\<close> a b unfolding convex_def f_def by auto
  21.808    ultimately show False by auto
  21.809  qed
  21.810  
  21.811 @@ -2372,7 +2261,7 @@
  21.812  lemma convex_ball [iff]:
  21.813    fixes x :: "'a::real_normed_vector"
  21.814    shows "convex (ball x e)"
  21.815 -proof (auto simp add: convex_def)
  21.816 +proof (auto simp: convex_def)
  21.817    fix y z
  21.818    assume yz: "dist x y < e" "dist x z < e"
  21.819    fix u v :: real
  21.820 @@ -2403,7 +2292,7 @@
  21.821      then have "dist x (u *\<^sub>R y + v *\<^sub>R z) \<le> e"
  21.822        using convex_bound_le[OF yz uv] by auto
  21.823    }
  21.824 -  then show ?thesis by (auto simp add: convex_def Ball_def)
  21.825 +  then show ?thesis by (auto simp: convex_def Ball_def)
  21.826  qed
  21.827  
  21.828  lemma connected_ball [iff]:
  21.829 @@ -2481,8 +2370,8 @@
  21.830  proof
  21.831    show "convex hull (s \<times> t) \<subseteq> (convex hull s) \<times> (convex hull t)"
  21.832      by (intro hull_minimal Sigma_mono hull_subset convex_Times convex_convex_hull)
  21.833 -  have "\<forall>x\<in>convex hull s. \<forall>y\<in>convex hull t. (x, y) \<in> convex hull (s \<times> t)"
  21.834 -  proof (intro hull_induct)
  21.835 +  have "(x, y) \<in> convex hull (s \<times> t)" if x: "x \<in> convex hull s" and y: "y \<in> convex hull t" for x y
  21.836 +  proof (rule hull_induct [OF x], rule hull_induct [OF y])
  21.837      fix x y assume "x \<in> s" and "y \<in> t"
  21.838      then show "(x, y) \<in> convex hull (s \<times> t)"
  21.839        by (simp add: hull_inc)
  21.840 @@ -2492,22 +2381,22 @@
  21.841        by (intro convex_linear_vimage convex_translation convex_convex_hull,
  21.842          simp add: linear_iff)
  21.843      also have "?S = {y. (x, y) \<in> convex hull (s \<times> t)}"
  21.844 -      by (auto simp add: image_def Bex_def)
  21.845 +      by (auto simp: image_def Bex_def)
  21.846      finally show "convex {y. (x, y) \<in> convex hull (s \<times> t)}" .
  21.847    next
  21.848 -    show "convex {x. \<forall>y\<in>convex hull t. (x, y) \<in> convex hull (s \<times> t)}"
  21.849 -    proof (unfold Collect_ball_eq, rule convex_INT [rule_format])
  21.850 +    show "convex {x. (x, y) \<in> convex hull s \<times> t}"
  21.851 +    proof -
  21.852        fix y let ?S = "((\<lambda>x. (x, 0)) -` (\<lambda>p. (0, - y) + p) ` (convex hull s \<times> t))"
  21.853        have "convex ?S"
  21.854        by (intro convex_linear_vimage convex_translation convex_convex_hull,
  21.855          simp add: linear_iff)
  21.856        also have "?S = {x. (x, y) \<in> convex hull (s \<times> t)}"
  21.857 -        by (auto simp add: image_def Bex_def)
  21.858 +        by (auto simp: image_def Bex_def)
  21.859        finally show "convex {x. (x, y) \<in> convex hull (s \<times> t)}" .
  21.860      qed
  21.861    qed
  21.862    then show "(convex hull s) \<times> (convex hull t) \<subseteq> convex hull (s \<times> t)"
  21.863 -    unfolding subset_eq split_paired_Ball_Sigma .
  21.864 +    unfolding subset_eq split_paired_Ball_Sigma by blast
  21.865  qed
  21.866  
  21.867  
  21.868 @@ -2520,118 +2409,114 @@
  21.869    by (rule hull_unique) auto
  21.870  
  21.871  lemma convex_hull_insert:
  21.872 -  fixes s :: "'a::real_vector set"
  21.873 -  assumes "s \<noteq> {}"
  21.874 -  shows "convex hull (insert a s) =
  21.875 -    {x. \<exists>u\<ge>0. \<exists>v\<ge>0. \<exists>b. (u + v = 1) \<and> b \<in> (convex hull s) \<and> (x = u *\<^sub>R a + v *\<^sub>R b)}"
  21.876 +  fixes S :: "'a::real_vector set"
  21.877 +  assumes "S \<noteq> {}"
  21.878 +  shows "convex hull (insert a S) =
  21.879 +         {x. \<exists>u\<ge>0. \<exists>v\<ge>0. \<exists>b. (u + v = 1) \<and> b \<in> (convex hull S) \<and> (x = u *\<^sub>R a + v *\<^sub>R b)}"
  21.880    (is "_ = ?hull")
  21.881 -  apply (rule, rule hull_minimal, rule)
  21.882 -  unfolding insert_iff
  21.883 -  prefer 3
  21.884 -  apply rule
  21.885 -proof -
  21.886 +proof (intro equalityI hull_minimal subsetI)
  21.887    fix x
  21.888 -  assume x: "x = a \<or> x \<in> s"
  21.889 +  assume "x \<in> insert a S"
  21.890 +  then have "\<exists>u\<ge>0. \<exists>v\<ge>0. u + v = 1 \<and> (\<exists>b. b \<in> convex hull S \<and> x = u *\<^sub>R a + v *\<^sub>R b)"
  21.891 +  unfolding insert_iff
  21.892 +  proof
  21.893 +    assume "x = a"
  21.894 +    then show ?thesis
  21.895 +      by (rule_tac x=1 in exI) (use assms hull_subset in fastforce)
  21.896 +  next
  21.897 +    assume "x \<in> S"
  21.898 +    with hull_subset[of S convex] show ?thesis
  21.899 +      by force
  21.900 +  qed
  21.901    then show "x \<in> ?hull"
  21.902 -    apply rule
  21.903 -    unfolding mem_Collect_eq
  21.904 -    apply (rule_tac x=1 in exI)
  21.905 -    defer
  21.906 -    apply (rule_tac x=0 in exI)
  21.907 -    using assms hull_subset[of s convex]
  21.908 -    apply auto
  21.909 -    done
  21.910 +    by simp
  21.911  next
  21.912    fix x
  21.913    assume "x \<in> ?hull"
  21.914 -  then obtain u v b where obt: "u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull s" "x = u *\<^sub>R a + v *\<^sub>R b"
  21.915 +  then obtain u v b where obt: "u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull S" "x = u *\<^sub>R a + v *\<^sub>R b"
  21.916      by auto
  21.917 -  have "a \<in> convex hull insert a s" "b \<in> convex hull insert a s"
  21.918 -    using hull_mono[of s "insert a s" convex] hull_mono[of "{a}" "insert a s" convex] and obt(4)
  21.919 +  have "a \<in> convex hull insert a S" "b \<in> convex hull insert a S"
  21.920 +    using hull_mono[of S "insert a S" convex] hull_mono[of "{a}" "insert a S" convex] and obt(4)
  21.921      by auto
  21.922 -  then show "x \<in> convex hull insert a s"
  21.923 +  then show "x \<in> convex hull insert a S"
  21.924      unfolding obt(5) using obt(1-3)
  21.925      by (rule convexD [OF convex_convex_hull])
  21.926  next
  21.927    show "convex ?hull"
  21.928    proof (rule convexI)
  21.929      fix x y u v
  21.930 -    assume as: "(0::real) \<le> u" "0 \<le> v" "u + v = 1" "x\<in>?hull" "y\<in>?hull"
  21.931 -    from as(4) obtain u1 v1 b1 where
  21.932 -      obt1: "u1\<ge>0" "v1\<ge>0" "u1 + v1 = 1" "b1 \<in> convex hull s" "x = u1 *\<^sub>R a + v1 *\<^sub>R b1"
  21.933 +    assume as: "(0::real) \<le> u" "0 \<le> v" "u + v = 1" and x: "x \<in> ?hull" and y: "y \<in> ?hull"
  21.934 +    from x obtain u1 v1 b1 where
  21.935 +      obt1: "u1\<ge>0" "v1\<ge>0" "u1 + v1 = 1" "b1 \<in> convex hull S" and xeq: "x = u1 *\<^sub>R a + v1 *\<^sub>R b1"
  21.936        by auto
  21.937 -    from as(5) obtain u2 v2 b2 where
  21.938 -      obt2: "u2\<ge>0" "v2\<ge>0" "u2 + v2 = 1" "b2 \<in> convex hull s" "y = u2 *\<^sub>R a + v2 *\<^sub>R b2"
  21.939 +    from y obtain u2 v2 b2 where
  21.940 +      obt2: "u2\<ge>0" "v2\<ge>0" "u2 + v2 = 1" "b2 \<in> convex hull S" and yeq: "y = u2 *\<^sub>R a + v2 *\<^sub>R b2"
  21.941        by auto
  21.942      have *: "\<And>(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x"
  21.943 -      by (auto simp add: algebra_simps)
  21.944 -    have **: "\<exists>b \<in> convex hull s. u *\<^sub>R x + v *\<^sub>R y =
  21.945 +      by (auto simp: algebra_simps)
  21.946 +    have "\<exists>b \<in> convex hull S. u *\<^sub>R x + v *\<^sub>R y =
  21.947        (u * u1) *\<^sub>R a + (v * u2) *\<^sub>R a + (b - (u * u1) *\<^sub>R b - (v * u2) *\<^sub>R b)"
  21.948      proof (cases "u * v1 + v * v2 = 0")
  21.949        case True
  21.950        have *: "\<And>(x::'a) s1 s2. x - s1 *\<^sub>R x - s2 *\<^sub>R x = ((1::real) - (s1 + s2)) *\<^sub>R x"
  21.951 -        by (auto simp add: algebra_simps)
  21.952 -      from True have ***: "u * v1 = 0" "v * v2 = 0"
  21.953 -        using mult_nonneg_nonneg[OF \<open>u\<ge>0\<close> \<open>v1\<ge>0\<close>] mult_nonneg_nonneg[OF \<open>v\<ge>0\<close> \<open>v2\<ge>0\<close>]
  21.954 +        by (auto simp: algebra_simps)
  21.955 +      have eq0: "u * v1 = 0" "v * v2 = 0"
  21.956 +        using True mult_nonneg_nonneg[OF \<open>u\<ge>0\<close> \<open>v1\<ge>0\<close>] mult_nonneg_nonneg[OF \<open>v\<ge>0\<close> \<open>v2\<ge>0\<close>]
  21.957          by arith+
  21.958        then have "u * u1 + v * u2 = 1"
  21.959          using as(3) obt1(3) obt2(3) by auto
  21.960        then show ?thesis
  21.961 -        unfolding obt1(5) obt2(5) *
  21.962 -        using assms hull_subset[of s convex]
  21.963 -        by (auto simp add: *** scaleR_right_distrib)
  21.964 +        using "*" eq0 as obt1(4) xeq yeq by auto
  21.965      next
  21.966        case False
  21.967        have "1 - (u * u1 + v * u2) = (u + v) - (u * u1 + v * u2)"
  21.968 -        using as(3) obt1(3) obt2(3) by (auto simp add: field_simps)
  21.969 +        using as(3) obt1(3) obt2(3) by (auto simp: field_simps)
  21.970        also have "\<dots> = u * (v1 + u1 - u1) + v * (v2 + u2 - u2)"
  21.971 -        using as(3) obt1(3) obt2(3) by (auto simp add: field_simps)
  21.972 +        using as(3) obt1(3) obt2(3) by (auto simp: field_simps)
  21.973        also have "\<dots> = u * v1 + v * v2"
  21.974          by simp
  21.975        finally have **:"1 - (u * u1 + v * u2) = u * v1 + v * v2" by auto
  21.976 -      have "0 \<le> u * v1 + v * v2" "0 \<le> u * v1" "0 \<le> u * v1 + v * v2" "0 \<le> v * v2"
  21.977 +      let ?b = "((u * v1) / (u * v1 + v * v2)) *\<^sub>R b1 + ((v * v2) / (u * v1 + v * v2)) *\<^sub>R b2"
  21.978 +      have zeroes: "0 \<le> u * v1 + v * v2" "0 \<le> u * v1" "0 \<le> u * v1 + v * v2" "0 \<le> v * v2"
  21.979          using as(1,2) obt1(1,2) obt2(1,2) by auto
  21.980 -      then show ?thesis
  21.981 -        unfolding obt1(5) obt2(5)
  21.982 -        unfolding * and **
  21.983 -        using False
  21.984 -        apply (rule_tac
  21.985 -          x = "((u * v1) / (u * v1 + v * v2)) *\<^sub>R b1 + ((v * v2) / (u * v1 + v * v2)) *\<^sub>R b2" in bexI)
  21.986 -        defer
  21.987 -        apply (rule convexD [OF convex_convex_hull])
  21.988 -        using obt1(4) obt2(4)
  21.989 -        unfolding add_divide_distrib[symmetric] and zero_le_divide_iff
  21.990 -        apply (auto simp add: scaleR_left_distrib scaleR_right_distrib)
  21.991 -        done
  21.992 +      show ?thesis
  21.993 +      proof
  21.994 +        show "u *\<^sub>R x + v *\<^sub>R y = (u * u1) *\<^sub>R a + (v * u2) *\<^sub>R a + (?b - (u * u1) *\<^sub>R ?b - (v * u2) *\<^sub>R ?b)"
  21.995 +          unfolding xeq yeq * **
  21.996 +          using False by (auto simp: scaleR_left_distrib scaleR_right_distrib)
  21.997 +        show "?b \<in> convex hull S"
  21.998 +          using False zeroes obt1(4) obt2(4)
  21.999 +          by (auto simp: convexD [OF convex_convex_hull] scaleR_left_distrib scaleR_right_distrib  add_divide_distrib[symmetric]  zero_le_divide_iff)
 21.1000 +      qed
 21.1001      qed
 21.1002 +    then obtain b where b: "b \<in> convex hull S" 
 21.1003 +       "u *\<^sub>R x + v *\<^sub>R y = (u * u1) *\<^sub>R a + (v * u2) *\<^sub>R a + (b - (u * u1) *\<^sub>R b - (v * u2) *\<^sub>R b)" ..
 21.1004 +
 21.1005      have u1: "u1 \<le> 1"
 21.1006        unfolding obt1(3)[symmetric] and not_le using obt1(2) by auto
 21.1007      have u2: "u2 \<le> 1"
 21.1008        unfolding obt2(3)[symmetric] and not_le using obt2(2) by auto
 21.1009      have "u1 * u + u2 * v \<le> max u1 u2 * u + max u1 u2 * v"
 21.1010 -      apply (rule add_mono)
 21.1011 -      apply (rule_tac [!] mult_right_mono)
 21.1012 -      using as(1,2) obt1(1,2) obt2(1,2)
 21.1013 -      apply auto
 21.1014 -      done
 21.1015 +    proof (rule add_mono)
 21.1016 +      show "u1 * u \<le> max u1 u2 * u" "u2 * v \<le> max u1 u2 * v"
 21.1017 +        by (simp_all add: as mult_right_mono)
 21.1018 +    qed
 21.1019      also have "\<dots> \<le> 1"
 21.1020        unfolding distrib_left[symmetric] and as(3) using u1 u2 by auto
 21.1021 -    finally show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull"
 21.1022 -      unfolding mem_Collect_eq
 21.1023 -      apply (rule_tac x="u * u1 + v * u2" in exI)
 21.1024 -      apply (rule conjI)
 21.1025 -      defer
 21.1026 -      apply (rule_tac x="1 - u * u1 - v * u2" in exI)
 21.1027 -      unfolding Bex_def
 21.1028 -      using as(1,2) obt1(1,2) obt2(1,2) **
 21.1029 -      apply (auto simp add: algebra_simps)
 21.1030 -      done
 21.1031 +    finally have le1: "u1 * u + u2 * v \<le> 1" .    
 21.1032 +    show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull"
 21.1033 +    proof (intro CollectI exI conjI)
 21.1034 +      show "0 \<le> u * u1 + v * u2"
 21.1035 +        by (simp add: as(1) as(2) obt1(1) obt2(1))
 21.1036 +      show "0 \<le> 1 - u * u1 - v * u2"
 21.1037 +        by (simp add: le1 diff_diff_add mult.commute)
 21.1038 +    qed (use b in \<open>auto simp: algebra_simps\<close>)
 21.1039    qed
 21.1040  qed
 21.1041  
 21.1042  lemma convex_hull_insert_alt:
 21.1043     "convex hull (insert a S) =
 21.1044 -      (if S = {} then {a}
 21.1045 +     (if S = {} then {a}
 21.1046        else {(1 - u) *\<^sub>R a + u *\<^sub>R x |x u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> convex hull S})"
 21.1047    apply (auto simp: convex_hull_insert)
 21.1048    using diff_eq_eq apply fastforce
 21.1049 @@ -2639,147 +2524,81 @@
 21.1050  
 21.1051  subsubsection%unimportant \<open>Explicit expression for convex hull\<close>
 21.1052  
 21.1053 -lemma%important convex_hull_indexed:
 21.1054 -  fixes s :: "'a::real_vector set"
 21.1055 -  shows "convex hull s =
 21.1056 -    {y. \<exists>k u x.
 21.1057 -      (\<forall>i\<in>{1::nat .. k}. 0 \<le> u i \<and> x i \<in> s) \<and>
 21.1058 -      (sum u {1..k} = 1) \<and> (sum (\<lambda>i. u i *\<^sub>R x i) {1..k} = y)}"
 21.1059 -  (is "?xyz = ?hull")
 21.1060 -  apply%unimportant (rule hull_unique)
 21.1061 -  apply rule
 21.1062 -  defer
 21.1063 -  apply (rule convexI)
 21.1064 -proof -
 21.1065 -  fix x
 21.1066 -  assume "x\<in>s"
 21.1067 -  then show "x \<in> ?hull"
 21.1068 -    unfolding mem_Collect_eq
 21.1069 -    apply (rule_tac x=1 in exI, rule_tac x="\<lambda>x. 1" in exI)
 21.1070 -    apply auto
 21.1071 -    done
 21.1072 +proposition%important convex_hull_indexed:
 21.1073 +  fixes S :: "'a::real_vector set"
 21.1074 +  shows "convex hull S =
 21.1075 +    {y. \<exists>k u x. (\<forall>i\<in>{1::nat .. k}. 0 \<le> u i \<and> x i \<in> S) \<and>
 21.1076 +                (sum u {1..k} = 1) \<and> (\<Sum>i = 1..k. u i *\<^sub>R x i) = y}"
 21.1077 +    (is "?xyz = ?hull")
 21.1078 +proof (rule hull_unique [OF _ convexI])
 21.1079 +  show "S \<subseteq> ?hull" 
 21.1080 +    by (clarsimp, rule_tac x=1 in exI, rule_tac x="\<lambda>x. 1" in exI, auto)
 21.1081  next
 21.1082 -  fix t
 21.1083 -  assume as: "s \<subseteq> t" "convex t"
 21.1084 -  show "?hull \<subseteq> t"
 21.1085 -    apply rule
 21.1086 -    unfolding mem_Collect_eq
 21.1087 -    apply (elim exE conjE)
 21.1088 -  proof -
 21.1089 -    fix x k u y
 21.1090 -    assume assm:
 21.1091 -      "\<forall>i\<in>{1::nat..k}. 0 \<le> u i \<and> y i \<in> s"
 21.1092 -      "sum u {1..k} = 1" "(\<Sum>i = 1..k. u i *\<^sub>R y i) = x"
 21.1093 -    show "x\<in>t"
 21.1094 -      unfolding assm(3) [symmetric]
 21.1095 -      apply (rule as(2)[unfolded convex, rule_format])
 21.1096 -      using assm(1,2) as(1) apply auto
 21.1097 -      done
 21.1098 -  qed
 21.1099 +  fix T
 21.1100 +  assume "S \<subseteq> T" "convex T"
 21.1101 +  then show "?hull \<subseteq> T"
 21.1102 +    by (blast intro: convex_sum)
 21.1103  next
 21.1104    fix x y u v
 21.1105    assume uv: "0 \<le> u" "0 \<le> v" "u + v = (1::real)"
 21.1106    assume xy: "x \<in> ?hull" "y \<in> ?hull"
 21.1107    from xy obtain k1 u1 x1 where
 21.1108 -    x: "\<forall>i\<in>{1::nat..k1}. 0\<le>u1 i \<and> x1 i \<in> s" "sum u1 {Suc 0..k1} = 1" "(\<Sum>i = Suc 0..k1. u1 i *\<^sub>R x1 i) = x"
 21.1109 +    x [rule_format]: "\<forall>i\<in>{1::nat..k1}. 0\<le>u1 i \<and> x1 i \<in> S" 
 21.1110 +                      "sum u1 {Suc 0..k1} = 1" "(\<Sum>i = Suc 0..k1. u1 i *\<^sub>R x1 i) = x"
 21.1111      by auto
 21.1112    from xy obtain k2 u2 x2 where
 21.1113 -    y: "\<forall>i\<in>{1::nat..k2}. 0\<le>u2 i \<and> x2 i \<in> s" "sum u2 {Suc 0..k2} = 1" "(\<Sum>i = Suc 0..k2. u2 i *\<^sub>R x2 i) = y"
 21.1114 +    y [rule_format]: "\<forall>i\<in>{1::nat..k2}. 0\<le>u2 i \<and> x2 i \<in> S" 
 21.1115 +                     "sum u2 {Suc 0..k2} = 1" "(\<Sum>i = Suc 0..k2. u2 i *\<^sub>R x2 i) = y"
 21.1116      by auto
 21.1117 -  have *: "\<And>P (x1::'a) x2 s1 s2 i.
 21.1118 -    (if P i then s1 else s2) *\<^sub>R (if P i then x1 else x2) = (if P i then s1 *\<^sub>R x1 else s2 *\<^sub>R x2)"
 21.1119 -    "{1..k1 + k2} \<inter> {1..k1} = {1..k1}" "{1..k1 + k2} \<inter> - {1..k1} = (\<lambda>i. i + k1) ` {1..k2}"
 21.1120 -    prefer 3
 21.1121 -    apply (rule, rule)
 21.1122 -    unfolding image_iff
 21.1123 -    apply (rule_tac x = "x - k1" in bexI)
 21.1124 -    apply (auto simp add: not_le)
 21.1125 -    done
 21.1126 +  have *: "\<And>P (x::'a) y s t i. (if P i then s else t) *\<^sub>R (if P i then x else y) = (if P i then s *\<^sub>R x else t *\<^sub>R y)"
 21.1127 +          "{1..k1 + k2} \<inter> {1..k1} = {1..k1}" "{1..k1 + k2} \<inter> - {1..k1} = (\<lambda>i. i + k1) ` {1..k2}"
 21.1128 +    by auto
 21.1129    have inj: "inj_on (\<lambda>i. i + k1) {1..k2}"
 21.1130      unfolding inj_on_def by auto
 21.1131 +  let ?uu = "\<lambda>i. if i \<in> {1..k1} then u * u1 i else v * u2 (i - k1)"
 21.1132 +  let ?xx = "\<lambda>i. if i \<in> {1..k1} then x1 i else x2 (i - k1)"
 21.1133    show "u *\<^sub>R x + v *\<^sub>R y \<in> ?hull"
 21.1134 -    apply rule
 21.1135 -    apply (rule_tac x="k1 + k2" in exI)
 21.1136 -    apply (rule_tac x="\<lambda>i. if i \<in> {1..k1} then u * u1 i else v * u2 (i - k1)" in exI)
 21.1137 -    apply (rule_tac x="\<lambda>i. if i \<in> {1..k1} then x1 i else x2 (i - k1)" in exI)
 21.1138 -    apply (rule, rule)
 21.1139 -    defer
 21.1140 -    apply rule
 21.1141 -    unfolding * and sum.If_cases[OF finite_atLeastAtMost[of 1 "k1 + k2"]] and
 21.1142 -      sum.reindex[OF inj] and o_def Collect_mem_eq
 21.1143 -    unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] sum_distrib_left[symmetric]
 21.1144 -  proof -
 21.1145 -    fix i
 21.1146 -    assume i: "i \<in> {1..k1+k2}"
 21.1147 -    show "0 \<le> (if i \<in> {1..k1} then u * u1 i else v * u2 (i - k1)) \<and>
 21.1148 -      (if i \<in> {1..k1} then x1 i else x2 (i - k1)) \<in> s"
 21.1149 -    proof (cases "i\<in>{1..k1}")
 21.1150 -      case True
 21.1151 -      then show ?thesis
 21.1152 -        using uv(1) x(1)[THEN bspec[where x=i]] by auto
 21.1153 -    next
 21.1154 -      case False
 21.1155 -      define j where "j = i - k1"
 21.1156 -      from i False have "j \<in> {1..k2}"
 21.1157 -        unfolding j_def by auto
 21.1158 -      then show ?thesis
 21.1159 -        using False uv(2) y(1)[THEN bspec[where x=j]]
 21.1160 -        by (auto simp: j_def[symmetric])
 21.1161 -    qed
 21.1162 -  qed (auto simp add: not_le x(2,3) y(2,3) uv(3))
 21.1163 +  proof (intro CollectI exI conjI ballI)
 21.1164 +    show "0 \<le> ?uu i" "?xx i \<in> S" if "i \<in> {1..k1+k2}" for i
 21.1165 +      using that by (auto simp add: le_diff_conv uv(1) x(1) uv(2) y(1))
 21.1166 +    show "(\<Sum>i = 1..k1 + k2. ?uu i) = 1"  "(\<Sum>i = 1..k1 + k2. ?uu i *\<^sub>R ?xx i) = u *\<^sub>R x + v *\<^sub>R y"
 21.1167 +      unfolding * sum.If_cases[OF finite_atLeastAtMost[of 1 "k1 + k2"]]
 21.1168 +        sum.reindex[OF inj] Collect_mem_eq o_def
 21.1169 +      unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] sum_distrib_left[symmetric]
 21.1170 +      by (simp_all add: sum_distrib_left[symmetric]  x(2,3) y(2,3) uv(3))
 21.1171 +  qed 
 21.1172  qed
 21.1173  
 21.1174  lemma convex_hull_finite:
 21.1175 -  fixes s :: "'a::real_vector set"
 21.1176 -  assumes "finite s"
 21.1177 -  shows "convex hull s = {y. \<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and>
 21.1178 -    sum u s = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y}"
 21.1179 -  (is "?HULL = ?set")
 21.1180 -proof (rule hull_unique, auto simp add: convex_def[of ?set])
 21.1181 +  fixes S :: "'a::real_vector set"
 21.1182 +  assumes "finite S"
 21.1183 +  shows "convex hull S = {y. \<exists>u. (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y}"
 21.1184 +  (is "?HULL = _")
 21.1185 +proof (rule hull_unique [OF _ convexI]; clarify)
 21.1186    fix x
 21.1187 -  assume "x \<in> s"
 21.1188 -  then show "\<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> (\<Sum>x\<in>s. u x *\<^sub>R x) = x"
 21.1189 -    apply (rule_tac x="\<lambda>y. if x=y then 1 else 0" in exI)
 21.1190 -    apply auto
 21.1191 -    unfolding sum.delta'[OF assms] and sum_delta''[OF assms]
 21.1192 -    apply auto
 21.1193 -    done
 21.1194 +  assume "x \<in> S"
 21.1195 +  then show "\<exists>u. (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> (\<Sum>x\<in>S. u x *\<^sub>R x) = x"
 21.1196 +    by (rule_tac x="\<lambda>y. if x=y then 1 else 0" in exI) (auto simp: sum.delta'[OF assms] sum_delta''[OF assms])
 21.1197  next
 21.1198    fix u v :: real
 21.1199    assume uv: "0 \<le> u" "0 \<le> v" "u + v = 1"
 21.1200 -  fix ux assume ux: "\<forall>x\<in>s. 0 \<le> ux x" "sum ux s = (1::real)"
 21.1201 -  fix uy assume uy: "\<forall>x\<in>s. 0 \<le> uy x" "sum uy s = (1::real)"
 21.1202 -  {
 21.1203 -    fix x
 21.1204 -    assume "x\<in>s"
 21.1205 -    then have "0 \<le> u * ux x + v * uy x"
 21.1206 -      using ux(1)[THEN bspec[where x=x]] uy(1)[THEN bspec[where x=x]] and uv(1,2)
 21.1207 -      by auto
 21.1208 -  }
 21.1209 +  fix ux assume ux [rule_format]: "\<forall>x\<in>S. 0 \<le> ux x" "sum ux S = (1::real)"
 21.1210 +  fix uy assume uy [rule_format]: "\<forall>x\<in>S. 0 \<le> uy x" "sum uy S = (1::real)"
 21.1211 +  have "0 \<le> u * ux x + v * uy x" if "x\<in>S" for x
 21.1212 +    by (simp add: that uv ux(1) uy(1))
 21.1213    moreover
 21.1214 -  have "(\<Sum>x\<in>s. u * ux x + v * uy x) = 1"
 21.1215 -    unfolding sum.distrib and sum_distrib_left[symmetric] and ux(2) uy(2)
 21.1216 +  have "(\<Sum>x\<in>S. u * ux x + v * uy x) = 1"
 21.1217 +    unfolding sum.distrib and sum_distrib_left[symmetric] ux(2) uy(2)
 21.1218      using uv(3) by auto
 21.1219    moreover
 21.1220 -  have "(\<Sum>x\<in>s. (u * ux x + v * uy x) *\<^sub>R x) = u *\<^sub>R (\<Sum>x\<in>s. ux x *\<^sub>R x) + v *\<^sub>R (\<Sum>x\<in>s. uy x *\<^sub>R x)"
 21.1221 -    unfolding scaleR_left_distrib and sum.distrib and scaleR_scaleR[symmetric]
 21.1222 -      and scaleR_right.sum [symmetric]
 21.1223 +  have "(\<Sum>x\<in>S. (u * ux x + v * uy x) *\<^sub>R x) = u *\<^sub>R (\<Sum>x\<in>S. ux x *\<^sub>R x) + v *\<^sub>R (\<Sum>x\<in>S. uy x *\<^sub>R x)"
 21.1224 +    unfolding scaleR_left_distrib sum.distrib scaleR_scaleR[symmetric] scaleR_right.sum [symmetric]
 21.1225      by auto
 21.1226    ultimately
 21.1227 -  show "\<exists>uc. (\<forall>x\<in>s. 0 \<le> uc x) \<and> sum uc s = 1 \<and>
 21.1228 -      (\<Sum>x\<in>s. uc x *\<^sub>R x) = u *\<^sub>R (\<Sum>x\<in>s. ux x *\<^sub>R x) + v *\<^sub>R (\<Sum>x\<in>s. uy x *\<^sub>R x)"
 21.1229 -    apply (rule_tac x="\<lambda>x. u * ux x + v * uy x" in exI)
 21.1230 -    apply auto
 21.1231 -    done
 21.1232 -next
 21.1233 -  fix t
 21.1234 -  assume t: "s \<subseteq> t" "convex t"
 21.1235 -  fix u
 21.1236 -  assume u: "\<forall>x\<in>s. 0 \<le> u x" "sum u s = (1::real)"
 21.1237 -  then show "(\<Sum>x\<in>s. u x *\<^sub>R x) \<in> t"
 21.1238 -    using t(2)[unfolded convex_explicit, THEN spec[where x=s], THEN spec[where x=u]]
 21.1239 -    using assms and t(1) by auto
 21.1240 -qed
 21.1241 +  show "\<exists>uc. (\<forall>x\<in>S. 0 \<le> uc x) \<and> sum uc S = 1 \<and>
 21.1242 +             (\<Sum>x\<in>S. uc x *\<^sub>R x) = u *\<^sub>R (\<Sum>x\<in>S. ux x *\<^sub>R x) + v *\<^sub>R (\<Sum>x\<in>S. uy x *\<^sub>R x)"
 21.1243 +    by (rule_tac x="\<lambda>x. u * ux x + v * uy x" in exI, auto)
 21.1244 +qed (use assms in \<open>auto simp: convex_explicit\<close>)
 21.1245  
 21.1246  
 21.1247  subsubsection%unimportant \<open>Another formulation from Lars Schewe\<close>
 21.1248 @@ -2787,7 +2606,7 @@
 21.1249  lemma convex_hull_explicit:
 21.1250    fixes p :: "'a::real_vector set"
 21.1251    shows "convex hull p =
 21.1252 -    {y. \<exists>s u. finite s \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) s = y}"
 21.1253 +    {y. \<exists>S u. finite S \<and> S \<subseteq> p \<and> (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> sum (\<lambda>v. u v *\<^sub>R v) S = y}"
 21.1254    (is "?lhs = ?rhs")
 21.1255  proof -
 21.1256    {
 21.1257 @@ -2817,10 +2636,9 @@
 21.1258        using sum_image_gen[OF fin, of "\<lambda>i. u i *\<^sub>R y i" y, symmetric]
 21.1259        unfolding scaleR_left.sum using obt(3) by auto
 21.1260      ultimately
 21.1261 -    have "\<exists>s u. finite s \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = x"
 21.1262 +    have "\<exists>S u. finite S \<and> S \<subseteq> p \<and> (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = 1 \<and> (\<Sum>v\<in>S. u v *\<^sub>R v) = x"
 21.1263        apply (rule_tac x="y ` {1..k}" in exI)
 21.1264 -      apply (rule_tac x="\<lambda>v. sum u {i\<in>{1..k}. y i = v}" in exI)
 21.1265 -      apply auto
 21.1266 +      apply (rule_tac x="\<lambda>v. sum u {i\<in>{1..k}. y i = v}" in exI, auto)
 21.1267        done
 21.1268      then have "x\<in>?rhs" by auto
 21.1269    }
 21.1270 @@ -2828,55 +2646,50 @@
 21.1271    {
 21.1272      fix y
 21.1273      assume "y\<in>?rhs"
 21.1274 -    then obtain s u where
 21.1275 -      obt: "finite s" "s \<subseteq> p" "\<forall>x\<in>s. 0 \<le> u x" "sum u s = 1" "(\<Sum>v\<in>s. u v *\<^sub>R v) = y"
 21.1276 +    then obtain S u where
 21.1277 +      obt: "finite S" "S \<subseteq> p" "\<forall>x\<in>S. 0 \<le> u x" "sum u S = 1" "(\<Sum>v\<in>S. u v *\<^sub>R v) = y"
 21.1278        by auto
 21.1279  
 21.1280 -    obtain f where f: "inj_on f {1..card s}" "f ` {1..card s} = s"
 21.1281 +    obtain f where f: "inj_on f {1..card S}" "f ` {1..card S} = S"
 21.1282        using ex_bij_betw_nat_finite_1[OF obt(1)] unfolding bij_betw_def by auto
 21.1283  
 21.1284      {
 21.1285        fix i :: nat
 21.1286 -      assume "i\<in>{1..card s}"
 21.1287 -      then have "f i \<in> s"
 21.1288 -        apply (subst f(2)[symmetric])
 21.1289 -        apply auto
 21.1290 -        done
 21.1291 +      assume "i\<in>{1..card S}"
 21.1292 +      then have "f i \<in> S"
 21.1293 +        using f(2) by blast
 21.1294        then have "0 \<le> u (f i)" "f i \<in> p" using obt(2,3) by auto
 21.1295      }
 21.1296 -    moreover have *: "finite {1..card s}" by auto
 21.1297 +    moreover have *: "finite {1..card S}" by auto
 21.1298      {
 21.1299        fix y
 21.1300 -      assume "y\<in>s"
 21.1301 -      then obtain i where "i\<in>{1..card s}" "f i = y"
 21.1302 -        using f using image_iff[of y f "{1..card s}"]
 21.1303 +      assume "y\<in>S"
 21.1304 +      then obtain i where "i\<in>{1..card S}" "f i = y"
 21.1305 +        using f using image_iff[of y f "{1..card S}"]
 21.1306          by auto
 21.1307 -      then have "{x. Suc 0 \<le> x \<and> x \<le> card s \<and> f x = y} = {i}"
 21.1308 +      then have "{x. Suc 0 \<le> x \<and> x \<le> card S \<and> f x = y} = {i}"
 21.1309          apply auto
 21.1310          using f(1)[unfolded inj_on_def]
 21.1311 -        apply(erule_tac x=x in ballE)
 21.1312 -        apply auto
 21.1313 -        done
 21.1314 -      then have "card {x. Suc 0 \<le> x \<and> x \<le> card s \<and> f x = y} = 1" by auto
 21.1315 -      then have "(\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x)) = u y"
 21.1316 -          "(\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x) *\<^sub>R f x) = u y *\<^sub>R y"
 21.1317 -        by (auto simp add: sum_constant_scaleR)
 21.1318 +        by (metis One_nat_def atLeastAtMost_iff)
 21.1319 +      then have "card {x. Suc 0 \<le> x \<and> x \<le> card S \<and> f x = y} = 1" by auto
 21.1320 +      then have "(\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x)) = u y"
 21.1321 +          "(\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x) *\<^sub>R f x) = u y *\<^sub>R y"
 21.1322 +        by (auto simp: sum_constant_scaleR)
 21.1323      }
 21.1324 -    then have "(\<Sum>x = 1..card s. u (f x)) = 1" "(\<Sum>i = 1..card s. u (f i) *\<^sub>R f i) = y"
 21.1325 +    then have "(\<Sum>x = 1..card S. u (f x)) = 1" "(\<Sum>i = 1..card S. u (f i) *\<^sub>R f i) = y"
 21.1326        unfolding sum_image_gen[OF *(1), of "\<lambda>x. u (f x) *\<^sub>R f x" f]
 21.1327          and sum_image_gen[OF *(1), of "\<lambda>x. u (f x)" f]
 21.1328        unfolding f
 21.1329 -      using sum.cong [of s s "\<lambda>y. (\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x) *\<^sub>R f x)" "\<lambda>v. u v *\<^sub>R v"]
 21.1330 -      using sum.cong [of s s "\<lambda>y. (\<Sum>x\<in>{x \<in> {1..card s}. f x = y}. u (f x))" u]
 21.1331 +      using sum.cong [of S S "\<lambda>y. (\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x) *\<^sub>R f x)" "\<lambda>v. u v *\<^sub>R v"]
 21.1332 +      using sum.cong [of S S "\<lambda>y. (\<Sum>x\<in>{x \<in> {1..card S}. f x = y}. u (f x))" u]
 21.1333        unfolding obt(4,5)
 21.1334        by auto
 21.1335      ultimately
 21.1336      have "\<exists>k u x. (\<forall>i\<in>{1..k}. 0 \<le> u i \<and> x i \<in> p) \<and> sum u {1..k} = 1 \<and>
 21.1337          (\<Sum>i::nat = 1..k. u i *\<^sub>R x i) = y"
 21.1338 -      apply (rule_tac x="card s" in exI)
 21.1339 +      apply (rule_tac x="card S" in exI)
 21.1340        apply (rule_tac x="u \<circ> f" in exI)
 21.1341 -      apply (rule_tac x=f in exI)
 21.1342 -      apply fastforce
 21.1343 +      apply (rule_tac x=f in exI, fastforce)
 21.1344        done
 21.1345      then have "y \<in> ?lhs"
 21.1346        unfolding convex_hull_indexed by auto
 21.1347 @@ -2889,70 +2702,57 @@
 21.1348  subsubsection%unimportant \<open>A stepping theorem for that expansion\<close>
 21.1349  
 21.1350  lemma convex_hull_finite_step:
 21.1351 -  fixes s :: "'a::real_vector set"
 21.1352 -  assumes "finite s"
 21.1353 +  fixes S :: "'a::real_vector set"
 21.1354 +  assumes "finite S"
 21.1355    shows
 21.1356 -    "(\<exists>u. (\<forall>x\<in>insert a s. 0 \<le> u x) \<and> sum u (insert a s) = w \<and> sum (\<lambda>x. u x *\<^sub>R x) (insert a s) = y)
 21.1357 -      \<longleftrightarrow> (\<exists>v\<ge>0. \<exists>u. (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = w - v \<and> sum (\<lambda>x. u x *\<^sub>R x) s = y - v *\<^sub>R a)"
 21.1358 +    "(\<exists>u. (\<forall>x\<in>insert a S. 0 \<le> u x) \<and> sum u (insert a S) = w \<and> sum (\<lambda>x. u x *\<^sub>R x) (insert a S) = y)
 21.1359 +      \<longleftrightarrow> (\<exists>v\<ge>0. \<exists>u. (\<forall>x\<in>S. 0 \<le> u x) \<and> sum u S = w - v \<and> sum (\<lambda>x. u x *\<^sub>R x) S = y - v *\<^sub>R a)"
 21.1360    (is "?lhs = ?rhs")
 21.1361 -proof (rule, case_tac[!] "a\<in>s")
 21.1362 -  assume "a \<in> s"
 21.1363 -  then have *: "insert a s = s" by auto
 21.1364 +proof (rule, case_tac[!] "a\<in>S")
 21.1365 +  assume "a \<in> S"
 21.1366 +  then have *: "insert a S = S" by auto
 21.1367    assume ?lhs
 21.1368    then show ?rhs
 21.1369 -    unfolding *
 21.1370 -    apply (rule_tac x=0 in exI)
 21.1371 -    apply auto
 21.1372 -    done
 21.1373 +    unfolding *  by (rule_tac x=0 in exI, auto)
 21.1374  next
 21.1375    assume ?lhs
 21.1376    then obtain u where
 21.1377 -      u: "\<forall>x\<in>insert a s. 0 \<le> u x" "sum u (insert a s) = w" "(\<Sum>x\<in>insert a s. u x *\<^sub>R x) = y"
 21.1378 +      u: "\<forall>x\<in>insert a S. 0 \<le> u x" "sum u (insert a S) = w" "(\<Sum>x\<in>insert a S. u x *\<^sub>R x) = y"
 21.1379      by auto
 21.1380 -  assume "a \<notin> s"
 21.1381 +  assume "a \<notin> S"
 21.1382    then show ?rhs
 21.1383      apply (rule_tac x="u a" in exI)
 21.1384      using u(1)[THEN bspec[where x=a]]
 21.1385      apply simp
 21.1386      apply (rule_tac x=u in exI)
 21.1387 -    using u[unfolded sum_clauses(2)[OF assms]] and \<open>a\<notin>s\<close>
 21.1388 +    using u[unfolded sum_clauses(2)[OF assms]] and \<open>a\<notin>S\<close>
 21.1389      apply auto
 21.1390      done
 21.1391  next
 21.1392 -  assume "a \<in> s"
 21.1393 -  then have *: "insert a s = s" by auto
 21.1394 -  have fin: "finite (insert a s)" using assms by auto
 21.1395 +  assume "a \<in> S"
 21.1396 +  then have *: "insert a S = S" by auto
 21.1397 +  have fin: "finite (insert a S)" using assms by auto
 21.1398    assume ?rhs
 21.1399 -  then obtain v u where uv: "v\<ge>0" "\<forall>x\<in>s. 0 \<le> u x" "sum u s = w - v" "(\<Sum>x\<in>s. u x *\<^sub>R x) = y - v *\<^sub>R a"
 21.1400 +  then obtain v u where uv: "v\<ge>0" "\<forall>x\<in>S. 0 \<le> u x" "sum u S = w - v" "(\<Sum>x\<in>S. u x *\<^sub>R x) = y - v *\<^sub>R a"
 21.1401      by auto
 21.1402    show ?lhs
 21.1403      apply (rule_tac x = "\<lambda>x. (if a = x then v else 0) + u x" in exI)
 21.1404      unfolding scaleR_left_distrib and sum.distrib and sum_delta''[OF fin] and sum.delta'[OF fin]
 21.1405      unfolding sum_clauses(2)[OF assms]
 21.1406 -    using uv and uv(2)[THEN bspec[where x=a]] and \<open>a\<in>s\<close>
 21.1407 +    using uv and uv(2)[THEN bspec[where x=a]] and \<open>a\<in>S\<close>
 21.1408      apply auto
 21.1409      done
 21.1410  next
 21.1411    assume ?rhs
 21.1412 -  then obtain v u where
 21.1413 -    uv: "v\<ge>0" "\<forall>x\<in>s. 0 \<le> u x" "sum u s = w - v" "(\<Sum>x\<in>s. u x *\<^sub>R x) = y - v *\<^sub>R a"
 21.1414 +  then obtain v u where uv: "v\<ge>0" "\<forall>x\<in>S. 0 \<le> u x" "sum u S = w - v" "(\<Sum>x\<in>S. u x *\<^sub>R x) = y - v *\<^sub>R a"
 21.1415      by auto
 21.1416 -  moreover
 21.1417 -  assume "a \<notin> s"
 21.1418 +  moreover assume "a \<notin> S"
 21.1419    moreover
 21.1420 -  have "(\<Sum>x\<in>s. if a = x then v else u x) = sum u s"
 21.1421 -    and "(\<Sum>x\<in>s. (if a = x then v else u x) *\<^sub>R x) = (\<Sum>x\<in>s. u x *\<^sub>R x)"
 21.1422 -    apply (rule_tac sum.cong) apply rule
 21.1423 -    defer
 21.1424 -    apply (rule_tac sum.cong) apply rule
 21.1425 -    using \<open>a \<notin> s\<close>
 21.1426 -    apply auto
 21.1427 -    done
 21.1428 +  have "(\<Sum>x\<in>S. if a = x then v else u x) = sum u S"  "(\<Sum>x\<in>S. (if a = x then v else u x) *\<^sub>R x) = (\<Sum>x\<in>S. u x *\<^sub>R x)"
 21.1429 +    using \<open>a \<notin> S\<close>
 21.1430 +    by (auto simp: intro!: sum.cong)
 21.1431    ultimately show ?lhs
 21.1432 -    apply (rule_tac x="\<lambda>x. if a = x then v else u x" in exI)
 21.1433 -    unfolding sum_clauses(2)[OF assms]
 21.1434 -    apply auto
 21.1435 -    done
 21.1436 +    by (rule_tac x="\<lambda>x. if a = x then v else u x" in exI) (auto simp: sum_clauses(2)[OF assms])
 21.1437  qed
 21.1438  
 21.1439  
 21.1440 @@ -2969,12 +2769,9 @@
 21.1441      unfolding convex_hull_finite_step[OF **, of a 1, unfolded * conj_assoc]
 21.1442      apply auto
 21.1443      apply (rule_tac x=v in exI)
 21.1444 -    apply (rule_tac x="1 - v" in exI)
 21.1445 -    apply simp
 21.1446 -    apply (rule_tac x=u in exI)
 21.1447 -    apply simp
 21.1448 -    apply (rule_tac x="\<lambda>x. v" in exI)
 21.1449 -    apply simp
 21.1450 +    apply (rule_tac x="1 - v" in exI, simp)
 21.1451 +    apply (rule_tac x=u in exI, simp)
 21.1452 +    apply (rule_tac x="\<lambda>x. v" in exI, simp)
 21.1453      done
 21.1454  qed
 21.1455  
 21.1456 @@ -2989,7 +2786,7 @@
 21.1457      unfolding *
 21.1458      apply auto
 21.1459      apply (rule_tac[!] x=u in exI)
 21.1460 -    apply (auto simp add: algebra_simps)
 21.1461 +    apply (auto simp: algebra_simps)
 21.1462      done
 21.1463  qed
 21.1464  
 21.1465 @@ -2999,22 +2796,17 @@
 21.1466    have fin: "finite {a,b,c}" "finite {b,c}" "finite {c}"
 21.1467      by auto
 21.1468    have *: "\<And>x y z ::real. x + y + z = 1 \<longleftrightarrow> x = 1 - y - z"
 21.1469 -    by (auto simp add: field_simps)
 21.1470 +    by (auto simp: field_simps)
 21.1471    show ?thesis
 21.1472      unfolding convex_hull_finite[OF fin(1)] and convex_hull_finite_step[OF fin(2)] and *
 21.1473      unfolding convex_hull_finite_step[OF fin(3)]
 21.1474 -    apply (rule Collect_cong)
 21.1475 -    apply simp
 21.1476 +    apply (rule Collect_cong, simp)
 21.1477      apply auto
 21.1478      apply (rule_tac x=va in exI)
 21.1479 -    apply (rule_tac x="u c" in exI)
 21.1480 -    apply simp
 21.1481 -    apply (rule_tac x="1 - v - w" in exI)
 21.1482 -    apply simp
 21.1483 -    apply (rule_tac x=v in exI)
 21.1484 -    apply simp
 21.1485 -    apply (rule_tac x="\<lambda>x. w" in exI)
 21.1486 -    apply simp
 21.1487 +    apply (rule_tac x="u c" in exI, simp)
 21.1488 +    apply (rule_tac x="1 - v - w" in exI, simp)
 21.1489 +    apply (rule_tac x=v in exI, simp)
 21.1490 +    apply (rule_tac x="\<lambda>x. w" in exI, simp)
 21.1491      done
 21.1492  qed
 21.1493  
 21.1494 @@ -3025,7 +2817,7 @@
 21.1495      by auto
 21.1496    show ?thesis
 21.1497      unfolding convex_hull_3
 21.1498 -    apply (auto simp add: *)
 21.1499 +    apply (auto simp: *)
 21.1500      apply (rule_tac x=v in exI)
 21.1501      apply (rule_tac x=w in exI)
 21.1502      apply (simp add: algebra_simps)
 21.1503 @@ -3084,36 +2876,24 @@
 21.1504      apply auto
 21.1505      done
 21.1506    have "(\<Sum>x\<in>insert a t. if x = a then - (\<Sum>x\<in>t. u (x - a)) else u (x - a)) = 0"
 21.1507 -    unfolding sum_clauses(2)[OF fin]
 21.1508 -    using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close>
 21.1509 -    apply auto
 21.1510 -    unfolding *
 21.1511 -    apply auto
 21.1512 -    done
 21.1513 +    unfolding sum_clauses(2)[OF fin] * using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close> by auto
 21.1514    moreover have "\<exists>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) \<noteq> 0"
 21.1515 -    apply (rule_tac x="v + a" in bexI)
 21.1516 -    using obt(3,4) and \<open>0\<notin>S\<close>
 21.1517 -    unfolding t_def
 21.1518 -    apply auto
 21.1519 -    done
 21.1520 +    using obt(3,4) \<open>0\<notin>S\<close>
 21.1521 +    by (rule_tac x="v + a" in bexI) (auto simp: t_def)
 21.1522    moreover have *: "\<And>P Q. (\<Sum>x\<in>t. (if x = a then P x else Q x) *\<^sub>R x) = (\<Sum>x\<in>t. Q x *\<^sub>R x)"
 21.1523 -    apply (rule sum.cong)
 21.1524 -    using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close>
 21.1525 -    apply auto
 21.1526 -    done
 21.1527 +    using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close> by (auto intro!: sum.cong)
 21.1528    have "(\<Sum>x\<in>t. u (x - a)) *\<^sub>R a = (\<Sum>v\<in>t. u (v - a) *\<^sub>R v)"
 21.1529      unfolding scaleR_left.sum
 21.1530      unfolding t_def and sum.reindex[OF inj] and o_def
 21.1531      using obt(5)
 21.1532 -    by (auto simp add: sum.distrib scaleR_right_distrib)
 21.1533 +    by (auto simp: sum.distrib scaleR_right_distrib)
 21.1534    then have "(\<Sum>v\<in>insert a t. (if v = a then - (\<Sum>x\<in>t. u (x - a)) else u (v - a)) *\<^sub>R v) = 0"
 21.1535      unfolding sum_clauses(2)[OF fin]
 21.1536      using \<open>a\<notin>s\<close> \<open>t\<subseteq>s\<close>
 21.1537 -    by (auto simp add: *)
 21.1538 +    by (auto simp: *)
 21.1539    ultimately show ?thesis
 21.1540      unfolding affine_dependent_explicit
 21.1541 -    apply (rule_tac x="insert a t" in exI)
 21.1542 -    apply auto
 21.1543 +    apply (rule_tac x="insert a t" in exI, auto)
 21.1544      done
 21.1545  qed
 21.1546  
 21.1547 @@ -3130,10 +2910,8 @@
 21.1548        using \<open>?lhs\<close>[unfolded convex_def, THEN conjunct1]
 21.1549        apply (erule_tac x="2*\<^sub>R x" in ballE)
 21.1550        apply (erule_tac x="2*\<^sub>R y" in ballE)
 21.1551 -      apply (erule_tac x="1/2" in allE)
 21.1552 -      apply simp
 21.1553 -      apply (erule_tac x="1/2" in allE)
 21.1554 -      apply auto
 21.1555 +      apply (erule_tac x="1/2" in allE, simp)
 21.1556 +      apply (erule_tac x="1/2" in allE, auto)
 21.1557        done
 21.1558    }
 21.1559    then show ?thesis
 21.1560 @@ -3150,49 +2928,36 @@
 21.1561    have *: "{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})"
 21.1562      by auto
 21.1563    have "card {x - a |x. x \<in> s - {a}} = card (s - {a})"
 21.1564 -    unfolding *
 21.1565 -    apply (rule card_image)
 21.1566 -    unfolding inj_on_def
 21.1567 -    apply auto
 21.1568 -    done
 21.1569 +    unfolding * by (simp add: card_image inj_on_def)
 21.1570    also have "\<dots> > DIM('a)" using assms(2)
 21.1571      unfolding card_Diff_singleton[OF assms(1) \<open>a\<in>s\<close>] by auto
 21.1572    finally show ?thesis
 21.1573      apply (subst insert_Diff[OF \<open>a\<in>s\<close>, symmetric])
 21.1574      apply (rule dependent_imp_affine_dependent)
 21.1575 -    apply (rule dependent_biggerset)
 21.1576 -    apply auto
 21.1577 +    apply (rule dependent_biggerset, auto)
 21.1578      done
 21.1579  qed
 21.1580  
 21.1581  lemma affine_dependent_biggerset_general:
 21.1582 -  assumes "finite (s :: 'a::euclidean_space set)"
 21.1583 -    and "card s \<ge> dim s + 2"
 21.1584 -  shows "affine_dependent s"
 21.1585 +  assumes "finite (S :: 'a::euclidean_space set)"
 21.1586 +    and "card S \<ge> dim S + 2"
 21.1587 +  shows "affine_dependent S"
 21.1588  proof -
 21.1589 -  from assms(2) have "s \<noteq> {}" by auto
 21.1590 -  then obtain a where "a\<in>s" by auto
 21.1591 -  have *: "{x - a |x. x \<in> s - {a}} = (\<lambda>x. x - a) ` (s - {a})"
 21.1592 +  from assms(2) have "S \<noteq> {}" by auto
 21.1593 +  then obtain a where "a\<in>S" by auto
 21.1594 +  have *: "{x - a |x. x \<in> S - {a}} = (\<lambda>x. x - a) ` (S - {a})"
 21.1595      by auto
 21.1596 -  have **: "card {x - a |x. x \<in> s - {a}} = card (s - {a})"
 21.1597 -    unfolding *
 21.1598 -    apply (rule card_image)
 21.1599 -    unfolding inj_on_def
 21.1600 -    apply auto
 21.1601 -    done
 21.1602 -  have "dim {x - a |x. x \<in> s - {a}} \<le> dim s"
 21.1603 -    apply (rule subset_le_dim)
 21.1604 -    unfolding subset_eq
 21.1605 -    using \<open>a\<in>s\<close>
 21.1606 -    apply (auto simp add:span_base span_diff)
 21.1607 -    done
 21.1608 -  also have "\<dots> < dim s + 1" by auto
 21.1609 -  also have "\<dots> \<le> card (s - {a})"
 21.1610 +  have **: "card {x - a |x. x \<in> S - {a}} = card (S - {a})"
 21.1611 +    by (metis (no_types, lifting) "*" card_image diff_add_cancel inj_on_def)
 21.1612 +  have "dim {x - a |x. x \<in> S - {a}} \<le> dim S"
 21.1613 +    using \<open>a\<in>S\<close> by (auto simp: span_superset span_diff intro: subset_le_dim)
 21.1614 +  also have "\<dots> < dim S + 1" by auto
 21.1615 +  also have "\<dots> \<le> card (S - {a})"
 21.1616      using assms
 21.1617 -    using card_Diff_singleton[OF assms(1) \<open>a\<in>s\<close>]
 21.1618 +    using card_Diff_singleton[OF assms(1) \<open>a\<in>S\<close>]
 21.1619      by auto
 21.1620    finally show ?thesis
 21.1621 -    apply (subst insert_Diff[OF \<open>a\<in>s\<close>, symmetric])
 21.1622 +    apply (subst insert_Diff[OF \<open>a\<in>S\<close>, symmetric])
 21.1623      apply (rule dependent_imp_affine_dependent)
 21.1624      apply (rule dependent_biggerset_general)
 21.1625      unfolding **
 21.1626 @@ -3384,10 +3149,10 @@
 21.1627      using assms by auto
 21.1628    then have h0: "independent  ((\<lambda>x. -a + x) ` (S-{a}))"
 21.1629      using affine_dependent_iff_dependent2 assms by auto
 21.1630 -  then obtain B where B:
 21.1631 +  obtain B where B:
 21.1632      "(\<lambda>x. -a+x) ` (S - {a}) \<subseteq> B \<and> B \<subseteq> (\<lambda>x. -a+x) ` V \<and> independent B \<and> (\<lambda>x. -a+x) ` V \<subseteq> span B"
 21.1633 -     using maximal_independent_subset_extend[of "(\<lambda>x. -a+x) ` (S-{a})" "(\<lambda>x. -a + x) ` V"] assms
 21.1634 -     by blast
 21.1635 +    using assms
 21.1636 +    by (blast intro: maximal_independent_subset_extend[OF _ h0, of "(\<lambda>x. -a + x) ` V"])
 21.1637    define T where "T = (\<lambda>x. a+x) ` insert 0 B"
 21.1638    then have "T = insert a ((\<lambda>x. a+x) ` B)"
 21.1639      by auto
 21.1640 @@ -3457,8 +3222,7 @@
 21.1641        some_eq_ex[of "\<lambda>d. \<exists>B. affine hull B = affine hull V \<and> \<not> affine_dependent B \<and> of_nat (card B) = d + 1"]
 21.1642      apply auto
 21.1643      apply (rule exI[of _ "int (card B) - (1 :: int)"])
 21.1644 -    apply (rule exI[of _ "B"])
 21.1645 -    apply auto
 21.1646 +    apply (rule exI[of _ "B"], auto)
 21.1647      done
 21.1648  qed
 21.1649  
 21.1650 @@ -3493,10 +3257,7 @@
 21.1651      then have "card ((\<lambda>x. -a + x) ` (B - {a})) > 0"
 21.1652        using fin by auto
 21.1653      moreover have h1: "card ((\<lambda>x. -a + x) ` (B-{a})) = card (B-{a})"
 21.1654 -       apply (rule card_image)
 21.1655 -       using translate_inj_on
 21.1656 -       apply (auto simp del: uminus_add_conv_diff)
 21.1657 -       done
 21.1658 +      by (rule card_image) (use translate_inj_on in blast)
 21.1659      ultimately have "card (B-{a}) > 0" by auto
 21.1660      then have *: "finite (B - {a})"
 21.1661        using card_gt_0_iff[of "(B - {a})"] by auto
 21.1662 @@ -3592,23 +3353,10 @@
 21.1663      by auto
 21.1664    let ?t = "{x::'a::euclidean_space. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x\<bullet>i = 0}"
 21.1665    have "\<exists>f. linear f \<and> f ` B = d \<and> f ` span B = ?t \<and> inj_on f (span B)"
 21.1666 -    apply (rule basis_to_basis_subspace_isomorphism[of "span B" ?t B "d"])
 21.1667 -    apply (rule subspace_span)
 21.1668 -    apply (rule subspace_substandard)
 21.1669 -    defer
 21.1670 -    apply (rule span_superset)
 21.1671 -    apply (rule assms)
 21.1672 -    defer
 21.1673 -    unfolding dim_span[of B]
 21.1674 -    apply(rule B)
 21.1675 -    unfolding span_substd_basis[OF d, symmetric]
 21.1676 -    apply (rule span_superset)
 21.1677 -    apply (rule independent_substdbasis[OF d])
 21.1678 -    apply rule
 21.1679 -    apply assumption
 21.1680 -    unfolding t[symmetric] span_substd_basis[OF d] dim_substandard[OF d]
 21.1681 -    apply auto
 21.1682 -    done
 21.1683 +  proof (intro basis_to_basis_subspace_isomorphism subspace_span subspace_substandard span_inc)
 21.1684 +    show "d \<subseteq> {x. \<forall>i\<in>Basis. i \<notin> d \<longrightarrow> x \<bullet> i = 0}"
 21.1685 +      using d inner_not_same_Basis by blast
 21.1686 +  qed (auto simp: span_substd_basis independent_substdbasis dim_substandard d t B assms)
 21.1687    with t \<open>card B = dim B\<close> d show ?thesis by auto
 21.1688  qed
 21.1689  
 21.1690 @@ -3694,7 +3442,7 @@
 21.1691    assume "a \<noteq> b"
 21.1692    then have "aff_dim{a,b} = card{a,b} - 1"
 21.1693      using affine_independent_2 [of a b] aff_dim_affine_independent by fastforce
 21.1694 -  also have "... = 1"
 21.1695 +  also have "\<dots> = 1"
 21.1696      using \<open>a \<noteq> b\<close> by simp
 21.1697    finally show "aff_dim {a, b} = 1" .
 21.1698  qed
 21.1699 @@ -3923,9 +3671,9 @@
 21.1700      by blast
 21.1701    then have "card {b - a |b. b \<in> S - {a}} = card ((\<lambda>b. b-a) ` (S - {a}))"
 21.1702      by simp
 21.1703 -  also have "... = card (S - {a})"
 21.1704 +  also have "\<dots> = card (S - {a})"
 21.1705      by (metis (no_types, lifting) card_image diff_add_cancel inj_onI)
 21.1706 -  also have "... = card S - 1"
 21.1707 +  also have "\<dots> = card S - 1"
 21.1708      by (simp add: aff_independent_finite assms)
 21.1709    finally have 4: "card {b - a |b. b \<in> S - {a}} = card S - 1" .
 21.1710    have "finite S"
 21.1711 @@ -4156,8 +3904,7 @@
 21.1712    assume "\<exists>s u. finite s \<and> s \<subseteq> p \<and> (\<forall>x\<in>s. 0 \<le> u x) \<and> sum u s = 1 \<and> (\<Sum>v\<in>s. u v *\<^sub>R v) = y"
 21.1713    then obtain N where "?P N" by auto
 21.1714    then have "\<exists>n\<le>N. (\<forall>k<n. \<not> ?P k) \<and> ?P n"
 21.1715 -    apply (rule_tac ex_least_nat_le)
 21.1716 -    apply auto
 21.1717 +    apply (rule_tac ex_least_nat_le, auto)
 21.1718      done
 21.1719    then obtain n where "?P n" and smallest: "\<forall>k<n. \<not> ?P k"
 21.1720      by blast
 21.1721 @@ -4178,8 +3925,7 @@
 21.1722      proof (rule ccontr, simp add: not_less)
 21.1723        assume as:"\<forall>x\<in>s. 0 \<le> w x"
 21.1724        then have "sum w (s - {v}) \<ge> 0"
 21.1725 -        apply (rule_tac sum_nonneg)
 21.1726 -        apply auto
 21.1727 +        apply (rule_tac sum_nonneg, auto)
 21.1728          done
 21.1729        then have "sum w s > 0"
 21.1730          unfolding sum.remove[OF obt(1) \<open>v\<in>s\<close>]
 21.1731 @@ -4229,7 +3975,7 @@
 21.1732        apply (rule_tac x="(s - {a})" in exI)
 21.1733        apply (rule_tac x="\<lambda>v. u v + t * w v" in exI)
 21.1734        using obt(1-3) and t and a
 21.1735 -      apply (auto simp add: * scaleR_left_distrib)
 21.1736 +      apply (auto simp: * scaleR_left_distrib)
 21.1737        done
 21.1738      then show False
 21.1739        using smallest[THEN spec[where x="n - 1"]] by auto
 21.1740 @@ -4245,9 +3991,8 @@
 21.1741          (is "?lhs = ?rhs")
 21.1742  proof
 21.1743    show "?lhs \<subseteq> ?rhs"
 21.1744 -    apply (subst convex_hull_caratheodory_aff_dim)
 21.1745 -    apply clarify
 21.1746 -    apply (rule_tac x="s" in exI)
 21.1747 +    apply (subst convex_hull_caratheodory_aff_dim, clarify)
 21.1748 +    apply (rule_tac x=s in exI)
 21.1749      apply (simp add: hull_subset convex_explicit [THEN iffD1, OF convex_convex_hull])
 21.1750      done
 21.1751  next
 21.1752 @@ -4272,7 +4017,7 @@
 21.1753  next
 21.1754    fix x
 21.1755    assume "x \<in> ?rhs" then show "x \<in> ?lhs"
 21.1756 -    by (auto simp add: convex_hull_explicit)
 21.1757 +    by (auto simp: convex_hull_explicit)
 21.1758  qed
 21.1759  
 21.1760  theorem%important caratheodory:
 21.1761 @@ -4331,14 +4076,13 @@
 21.1762  qed
 21.1763  
 21.1764  lemma mem_rel_interior: "x \<in> rel_interior S \<longleftrightarrow> (\<exists>T. open T \<and> x \<in> T \<inter> S \<and> T \<inter> affine hull S \<subseteq> S)"
 21.1765 -  by (auto simp add: rel_interior)
 21.1766 +  by (auto simp: rel_interior)
 21.1767  
 21.1768  lemma mem_rel_interior_ball:
 21.1769    "x \<in> rel_interior S \<longleftrightarrow> x \<in> S \<and> (\<exists>e. e > 0 \<and> ball x e \<inter> affine hull S \<subseteq> S)"
 21.1770    apply (simp add: rel_interior, safe)
 21.1771 -  apply (force simp add: open_contains_ball)
 21.1772 -  apply (rule_tac x = "ball x e" in exI)
 21.1773 -  apply simp
 21.1774 +  apply (force simp: open_contains_ball)
 21.1775 +  apply (rule_tac x = "ball x e" in exI, simp)
 21.1776    done
 21.1777  
 21.1778  lemma rel_interior_ball:
 21.1779 @@ -4348,10 +4092,9 @@
 21.1780  lemma mem_rel_interior_cball:
 21.1781    "x \<in> rel_interior S \<longleftrightarrow> x \<in> S \<and> (\<exists>e. e > 0 \<and> cball x e \<inter> affine hull S \<subseteq> S)"
 21.1782    apply (simp add: rel_interior, safe)
 21.1783 -  apply (force simp add: open_contains_cball)
 21.1784 +  apply (force simp: open_contains_cball)
 21.1785    apply (rule_tac x = "ball x e" in exI)
 21.1786 -  apply (simp add: subset_trans [OF ball_subset_cball])
 21.1787 -  apply auto
 21.1788 +  apply (simp add: subset_trans [OF ball_subset_cball], auto)
 21.1789    done
 21.1790  
 21.1791  lemma rel_interior_cball:
 21.1792 @@ -4359,7 +4102,7 @@
 21.1793    using mem_rel_interior_cball [of _ S] by auto
 21.1794  
 21.1795  lemma rel_interior_empty [simp]: "rel_interior {} = {}"
 21.1796 -   by (auto simp add: rel_interior_def)
 21.1797 +   by (auto simp: rel_interior_def)
 21.1798  
 21.1799  lemma affine_hull_sing [simp]: "affine hull {a :: 'n::euclidean_space} = {a}"
 21.1800    by (metis affine_hull_eq affine_sing)
 21.1801 @@ -4367,8 +4110,7 @@
 21.1802  lemma rel_interior_sing [simp]:
 21.1803      fixes a :: "'n::euclidean_space"  shows "rel_interior {a} = {a}"
 21.1804    apply (auto simp: rel_interior_ball)
 21.1805 -  apply (rule_tac x=1 in exI)
 21.1806 -  apply force
 21.1807 +  apply (rule_tac x=1 in exI, force)
 21.1808    done
 21.1809  
 21.1810  lemma subset_rel_interior:
 21.1811 @@ -4376,16 +4118,16 @@
 21.1812    assumes "S \<subseteq> T"
 21.1813      and "affine hull S = affine hull T"
 21.1814    shows "rel_interior S \<subseteq> rel_interior T"
 21.1815 -  using assms by (auto simp add: rel_interior_def)
 21.1816 +  using assms by (auto simp: rel_interior_def)
 21.1817  
 21.1818  lemma rel_interior_subset: "rel_interior S \<subseteq> S"
 21.1819 -  by (auto simp add: rel_interior_def)
 21.1820 +  by (auto simp: rel_interior_def)
 21.1821  
 21.1822  lemma rel_interior_subset_closure: "rel_interior S \<subseteq> closure S"
 21.1823 -  using rel_interior_subset by (auto simp add: closure_def)
 21.1824 +  using rel_interior_subset by (auto simp: closure_def)
 21.1825  
 21.1826  lemma interior_subset_rel_interior: "interior S \<subseteq> rel_interior S"
 21.1827 -  by (auto simp add: rel_interior interior_def)
 21.1828 +  by (auto simp: rel_interior interior_def)
 21.1829  
 21.1830  lemma interior_rel_interior:
 21.1831    fixes S :: "'n::euclidean_space set"
 21.1832 @@ -4464,7 +4206,7 @@
 21.1833      fix y
 21.1834      assume as: "dist (x - e *\<^sub>R (x - c)) y < e * d" "y \<in> affine hull S"
 21.1835      have *: "y = (1 - (1 - e)) *\<^sub>R ((1 / e) *\<^sub>R y - ((1 - e) / e) *\<^sub>R x) + (1 - e) *\<^sub>R x"
 21.1836 -      using \<open>e > 0\<close> by (auto simp add: scaleR_left_diff_distrib scaleR_right_diff_distrib)
 21.1837 +      using \<open>e > 0\<close> by (auto simp: scaleR_left_diff_distrib scaleR_right_diff_distrib)
 21.1838      have "x \<in> affine hull S"
 21.1839        using assms hull_subset[of S] by auto
 21.1840      moreover have "1 / e + - ((1 - e) / e) = 1"
 21.1841 @@ -4476,17 +4218,17 @@
 21.1842        unfolding dist_norm norm_scaleR[symmetric]
 21.1843        apply (rule arg_cong[where f=norm])
 21.1844        using \<open>e > 0\<close>
 21.1845 -      apply (auto simp add: euclidean_eq_iff[where 'a='a] field_simps inner_simps)
 21.1846 +      apply (auto simp: euclidean_eq_iff[where 'a='a] field_simps inner_simps)
 21.1847        done
 21.1848      also have "\<dots> = \<bar>1/e\<bar> * norm (x - e *\<^sub>R (x - c) - y)"
 21.1849        by (auto intro!:arg_cong[where f=norm] simp add: algebra_simps)
 21.1850      also have "\<dots> < d"
 21.1851        using as[unfolded dist_norm] and \<open>e > 0\<close>
 21.1852 -      by (auto simp add:pos_divide_less_eq[OF \<open>e > 0\<close>] mult.commute)
 21.1853 +      by (auto simp:pos_divide_less_eq[OF \<open>e > 0\<close>] mult.commute)
 21.1854      finally have "y \<in> S"
 21.1855        apply (subst *)
 21.1856        apply (rule assms(1)[unfolded convex_alt,rule_format])
 21.1857 -      apply (rule d[unfolded subset_eq,rule_format])
 21.1858 +      apply (rule d[THEN subsetD])
 21.1859        unfolding mem_ball
 21.1860        using assms(3-5) **
 21.1861        apply auto
 21.1862 @@ -4518,7 +4260,7 @@
 21.1863      then have "y \<in> interior {a..}"
 21.1864        apply (simp add: mem_interior)
 21.1865        apply (rule_tac x="(y-a)" in exI)
 21.1866 -      apply (auto simp add: dist_norm)
 21.1867 +      apply (auto simp: dist_norm)
 21.1868        done
 21.1869    }
 21.1870    moreover
 21.1871 @@ -4528,7 +4270,7 @@
 21.1872      then obtain e where e: "e > 0" "cball y e \<subseteq> {a..}"
 21.1873        using mem_interior_cball[of y "{a..}"] by auto
 21.1874      moreover from e have "y - e \<in> cball y e"
 21.1875 -      by (auto simp add: cball_def dist_norm)
 21.1876 +      by (auto simp: cball_def dist_norm)
 21.1877      ultimately have "a \<le> y - e" by blast
 21.1878      then have "a < y" using e by auto
 21.1879    }
 21.1880 @@ -4558,7 +4300,7 @@
 21.1881      then have "y \<in> interior {..a}"
 21.1882        apply (simp add: mem_interior)
 21.1883        apply (rule_tac x="(a-y)" in exI)
 21.1884 -      apply (auto simp add: dist_norm)
 21.1885 +      apply (auto simp: dist_norm)
 21.1886        done
 21.1887    }
 21.1888    moreover
 21.1889 @@ -4568,7 +4310,7 @@
 21.1890      then obtain e where e: "e > 0" "cball y e \<subseteq> {..a}"
 21.1891        using mem_interior_cball[of y "{..a}"] by auto
 21.1892      moreover from e have "y + e \<in> cball y e"
 21.1893 -      by (auto simp add: cball_def dist_norm)
 21.1894 +      by (auto simp: cball_def dist_norm)
 21.1895      ultimately have "a \<ge> y + e" by auto
 21.1896      then have "a > y" using e by auto
 21.1897    }
 21.1898 @@ -4578,9 +4320,9 @@
 21.1899  lemma interior_atLeastAtMost_real [simp]: "interior {a..b} = {a<..<b :: real}"
 21.1900  proof-
 21.1901    have "{a..b} = {a..} \<inter> {..b}" by auto
 21.1902 -  also have "interior ... = {a<..} \<inter> {..<b}"
 21.1903 +  also have "interior \<dots> = {a<..} \<inter> {..<b}"
 21.1904      by (simp add: interior_real_semiline interior_real_semiline')
 21.1905 -  also have "... = {a<..<b}" by auto
 21.1906 +  also have "\<dots> = {a<..<b}" by auto
 21.1907    finally show ?thesis .
 21.1908  qed
 21.1909  
 21.1910 @@ -4599,7 +4341,7 @@
 21.1911  lemma frontier_real_Iic [simp]:
 21.1912    fixes a :: real
 21.1913    shows "frontier {..a} = {a}"
 21.1914 -  unfolding frontier_def by (auto simp add: interior_real_semiline')
 21.1915 +  unfolding frontier_def by (auto simp: interior_real_semiline')
 21.1916  
 21.1917  lemma rel_interior_real_box [simp]:
 21.1918    fixes a b :: real
 21.1919 @@ -4638,8 +4380,7 @@
 21.1920  
 21.1921  lemma openin_rel_interior: "openin (subtopology euclidean (affine hull S)) (rel_interior S)"
 21.1922    apply (simp add: rel_interior_def)
 21.1923 -  apply (subst openin_subopen)
 21.1924 -  apply blast
 21.1925 +  apply (subst openin_subopen, blast)
 21.1926    done
 21.1927  
 21.1928  lemma openin_set_rel_interior:
 21.1929 @@ -4718,8 +4459,7 @@
 21.1930    proof (cases "x \<in> S")
 21.1931      case True
 21.1932      then show ?thesis using \<open>e > 0\<close> \<open>d > 0\<close>
 21.1933 -      apply (rule_tac bexI[where x=x])
 21.1934 -      apply (auto)
 21.1935 +      apply (rule_tac bexI[where x=x], auto)
 21.1936        done
 21.1937    next
 21.1938      case False
 21.1939 @@ -4739,7 +4479,7 @@
 21.1940      next
 21.1941        case False
 21.1942        then have "0 < e * d / (1 - e)" and *: "1 - e > 0"
 21.1943 -        using \<open>e \<le> 1\<close> \<open>e > 0\<close> \<open>d > 0\<close> by (auto)
 21.1944 +        using \<open>e \<le> 1\<close> \<open>e > 0\<close> \<open>d > 0\<close> by auto
 21.1945        then obtain y where "y \<in> S" "y \<noteq> x" "dist y x < e * d / (1 - e)"
 21.1946          using x[unfolded islimpt_approachable,THEN spec[where x="e*d / (1 - e)"]] by auto
 21.1947        then show ?thesis
 21.1948 @@ -4755,11 +4495,11 @@
 21.1949    define z where "z = c + ((1 - e) / e) *\<^sub>R (x - y)"
 21.1950    have *: "x - e *\<^sub>R (x - c) = y - e *\<^sub>R (y - z)"
 21.1951      unfolding z_def using \<open>e > 0\<close>
 21.1952 -    by (auto simp add: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib)
 21.1953 +    by (auto simp: scaleR_right_diff_distrib scaleR_right_distrib scaleR_left_diff_distrib)
 21.1954    have zball: "z \<in> ball c d"
 21.1955      using mem_ball z_def dist_norm[of c]
 21.1956      using y and assms(4,5)
 21.1957 -    by (auto simp add:field_simps norm_minus_commute)
 21.1958 +    by (auto simp:field_simps norm_minus_commute)
 21.1959    have "x \<in> affine hull S"
 21.1960      using closure_affine_hull assms by auto
 21.1961    moreover have "y \<in> affine hull S"
 21.1962 @@ -4770,7 +4510,7 @@
 21.1963      using z_def affine_affine_hull[of S]
 21.1964        mem_affine_3_minus [of "affine hull S" c x y "(1 - e) / e"]
 21.1965        assms
 21.1966 -    by (auto simp add: field_simps)
 21.1967 +    by (auto simp: field_simps)
 21.1968    then have "z \<in> S" using d zball by auto
 21.1969    obtain d1 where "d1 > 0" and d1: "ball z d1 \<le> ball c d"
 21.1970      using zball open_ball[of c d] openE[of "ball c d" z] by auto
 21.1971 @@ -4868,24 +4608,17 @@
 21.1972  lemma affine_hull_linear_image:
 21.1973    assumes "bounded_linear f"
 21.1974    shows "f ` (affine hull s) = affine hull f ` s"
 21.1975 -  apply rule
 21.1976 -  unfolding subset_eq ball_simps
 21.1977 -  apply (rule_tac[!] hull_induct, rule hull_inc)
 21.1978 -  prefer 3
 21.1979 -  apply (erule imageE)
 21.1980 -  apply (rule_tac x=xa in image_eqI)
 21.1981 -  apply assumption
 21.1982 -  apply (rule hull_subset[unfolded subset_eq, rule_format])
 21.1983 -  apply assumption
 21.1984  proof -
 21.1985    interpret f: bounded_linear f by fact
 21.1986 -  show "affine {x. f x \<in> affine hull f ` s}"
 21.1987 +  have "affine {x. f x \<in> affine hull f ` s}"
 21.1988      unfolding affine_def
 21.1989 -    by (auto simp add: f.scaleR f.add affine_affine_hull[unfolded affine_def, rule_format])
 21.1990 -  show "affine {x. x \<in> f ` (affine hull s)}"
 21.1991 +    by (auto simp: f.scaleR f.add affine_affine_hull[unfolded affine_def, rule_format])
 21.1992 +  moreover have "affine {x. x \<in> f ` (affine hull s)}"
 21.1993      using affine_affine_hull[unfolded affine_def, of s]
 21.1994 -    unfolding affine_def by (auto simp add: f.scaleR [symmetric] f.add [symmetric])
 21.1995 -qed auto
 21.1996 +    unfolding affine_def by (auto simp: f.scaleR [symmetric] f.add [symmetric])
 21.1997 +  ultimately show ?thesis
 21.1998 +    by (auto simp: hull_inc elim!: hull_induct)
 21.1999 +qed 
 21.2000  
 21.2001  
 21.2002  lemma rel_interior_injective_on_span_linear_image:
 21.2003 @@ -5012,114 +4745,77 @@
 21.2004  subsection%unimportant \<open>Openness and compactness are preserved by convex hull operation\<close>
 21.2005  
 21.2006  lemma open_convex_hull[intro]:
 21.2007 -  fixes s :: "'a::real_normed_vector set"
 21.2008 -  assumes "open s"
 21.2009 -  shows "open (convex hull s)"
 21.2010 -  unfolding open_contains_cball convex_hull_explicit
 21.2011 -  unfolding mem_Collect_eq ball_simps(8)
 21.2012 -proof (rule, rule)
 21.2013 -  fix a
 21.2014 -  assume "\<exists>sa u. finite sa \<and> sa \<subseteq> s \<and> (\<forall>x\<in>sa. 0 \<le> u x) \<and> sum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = a"
 21.2015 -  then obtain t u where obt: "finite t" "t\<subseteq>s" "\<forall>x\<in>t. 0 \<le> u x" "sum u t = 1" "(\<Sum>v\<in>t. u v *\<^sub>R v) = a"
 21.2016 -    by auto
 21.2017 +  fixes S :: "'a::real_normed_vector set"
 21.2018 +  assumes "open S"
 21.2019 +  shows "open (convex hull S)"
 21.2020 +proof (clarsimp simp: open_contains_cball convex_hull_explicit)
 21.2021 +  fix T and u :: "'a\<Rightarrow>real"
 21.2022 +  assume obt: "finite T" "T\<subseteq>S" "\<forall>x\<in>T. 0 \<le> u x" "sum u T = 1" 
 21.2023  
 21.2024    from assms[unfolded open_contains_cball] obtain b
 21.2025 -    where b: "\<forall>x\<in>s. 0 < b x \<and> cball x (b x) \<subseteq> s"
 21.2026 -    using bchoice[of s "\<lambda>x e. e > 0 \<and> cball x e \<subseteq> s"] by auto
 21.2027 -  have "b ` t \<noteq> {}"
 21.2028 +    where b: "\<And>x. x\<in>S \<Longrightarrow> 0 < b x \<and> cball x (b x) \<subseteq> S" by metis
 21.2029 +  have "b ` T \<noteq> {}"
 21.2030      using obt by auto
 21.2031 -  define i where "i = b ` t"
 21.2032 -
 21.2033 -  show "\<exists>e > 0.
 21.2034 -    cball a e \<subseteq> {y. \<exists>sa u. finite sa \<and> sa \<subseteq> s \<and> (\<forall>x\<in>sa. 0 \<le> u x) \<and> sum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = y}"
 21.2035 -    apply (rule_tac x = "Min i" in exI)
 21.2036 -    unfolding subset_eq
 21.2037 -    apply rule
 21.2038 -    defer
 21.2039 -    apply rule
 21.2040 -    unfolding mem_Collect_eq
 21.2041 -  proof -
 21.2042 +  define i where "i = b ` T"
 21.2043 +  let ?\<Phi> = "\<lambda>y. \<exists>F. finite F \<and> F \<subseteq> S \<and> (\<exists>u. (\<forall>x\<in>F. 0 \<le> u x) \<and> sum u F = 1 \<and> (\<Sum>v\<in>F. u v *\<^sub>R v) = y)"
 21.2044 +  let ?a = "\<Sum>v\<in>T. u v *\<^sub>R v"
 21.2045 +  show "\<exists>e > 0. cball ?a e \<subseteq> {y. ?\<Phi> y}"
 21.2046 +  proof (intro exI subsetI conjI)
 21.2047      show "0 < Min i"
 21.2048 -      unfolding i_def and Min_gr_iff[OF finite_imageI[OF obt(1)] \<open>b ` t\<noteq>{}\<close>]
 21.2049 -      using b
 21.2050 -      apply simp
 21.2051 -      apply rule
 21.2052 -      apply (erule_tac x=x in ballE)
 21.2053 -      using \<open>t\<subseteq>s\<close>
 21.2054 -      apply auto
 21.2055 -      done
 21.2056 +      unfolding i_def and Min_gr_iff[OF finite_imageI[OF obt(1)] \<open>b ` T\<noteq>{}\<close>]
 21.2057 +      using b \<open>T\<subseteq>S\<close> by auto
 21.2058    next
 21.2059      fix y
 21.2060 -    assume "y \<in> cball a (Min i)"
 21.2061 -    then have y: "norm (a - y) \<le> Min i"
 21.2062 +    assume "y \<in> cball ?a (Min i)"
 21.2063 +    then have y: "norm (?a - y) \<le> Min i"
 21.2064        unfolding dist_norm[symmetric] by auto
 21.2065 -    {
 21.2066 -      fix x
 21.2067 -      assume "x \<in> t"
 21.2068 +    { fix x
 21.2069 +      assume "x \<in> T"
 21.2070        then have "Min i \<le> b x"
 21.2071 -        unfolding i_def
 21.2072 -        apply (rule_tac Min_le)
 21.2073 -        using obt(1)
 21.2074 -        apply auto
 21.2075 -        done
 21.2076 -      then have "x + (y - a) \<in> cball x (b x)"
 21.2077 +        by (simp add: i_def obt(1))
 21.2078 +      then have "x + (y - ?a) \<in> cball x (b x)"
 21.2079          using y unfolding mem_cball dist_norm by auto
 21.2080 -      moreover from \<open>x\<in>t\<close> have "x \<in> s"
 21.2081 -        using obt(2) by auto
 21.2082 -      ultimately have "x + (y - a) \<in> s"
 21.2083 -        using y and b[THEN bspec[where x=x]] unfolding subset_eq by fast
 21.2084 +      moreover have "x \<in> S"
 21.2085 +        using \<open>x\<in>T\<close> \<open>T\<subseteq>S\<close> by auto
 21.2086 +      ultimately have "x + (y - ?a) \<in> S"
 21.2087 +        using y b by blast
 21.2088      }
 21.2089      moreover
 21.2090 -    have *: "inj_on (\<lambda>v. v + (y - a)) t"
 21.2091 +    have *: "inj_on (\<lambda>v. v + (y - ?a)) T"
 21.2092        unfolding inj_on_def by auto
 21.2093 -    have "(\<Sum>v\<in>(\<lambda>v. v + (y - a)) ` t. u (v - (y - a))) = 1"
 21.2094 -      unfolding sum.reindex[OF *] o_def using obt(4) by auto
 21.2095 -    moreover have "(\<Sum>v\<in>(\<lambda>v. v + (y - a)) ` t. u (v - (y - a)) *\<^sub>R v) = y"
 21.2096 -      unfolding sum.reindex[OF *] o_def using obt(4,5)
 21.2097 +    have "(\<Sum>v\<in>(\<lambda>v. v + (y - ?a)) ` T. u (v - (y - ?a)) *\<^sub>R v) = y"
 21.2098 +      unfolding sum.reindex[OF *] o_def using obt(4)
 21.2099        by (simp add: sum.distrib sum_subtractf scaleR_left.sum[symmetric] scaleR_right_distrib)
 21.2100 -    ultimately
 21.2101 -    show "\<exists>sa u. finite sa \<and> (\<forall>x\<in>sa. x \<in> s) \<and> (\<forall>x\<in>sa. 0 \<le> u x) \<and> sum u sa = 1 \<and> (\<Sum>v\<in>sa. u v *\<^sub>R v) = y"
 21.2102 -      apply (rule_tac x="(\<lambda>v. v + (y - a)) ` t" in exI)
 21.2103 -      apply (rule_tac x="\<lambda>v. u (v - (y - a))" in exI)
 21.2104 -      using obt(1, 3)
 21.2105 -      apply auto
 21.2106 -      done
 21.2107 +    ultimately show "y \<in> {y. ?\<Phi> y}"
 21.2108 +    proof (intro CollectI exI conjI)
 21.2109 +      show "finite ((\<lambda>v. v + (y - ?a)) ` T)"
 21.2110 +        by (simp add: obt(1))
 21.2111 +      show "sum (\<lambda>v. u (v - (y - ?a))) ((\<lambda>v. v + (y - ?a)) ` T) = 1"
 21.2112 +        unfolding sum.reindex[OF *] o_def using obt(4) by auto
 21.2113 +    qed (use obt(1, 3) in auto)
 21.2114    qed
 21.2115  qed
 21.2116  
 21.2117  lemma compact_convex_combinations:
 21.2118 -  fixes s t :: "'a::real_normed_vector set"
 21.2119 -  assumes "compact s" "compact t"
 21.2120 -  shows "compact { (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> s \<and> y \<in> t}"
 21.2121 +  fixes S T :: "'a::real_normed_vector set"
 21.2122 +  assumes "compact S" "compact T"
 21.2123 +  shows "compact { (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> T}"
 21.2124  proof -
 21.2125 -  let ?X = "{0..1} \<times> s \<times> t"
 21.2126 +  let ?X = "{0..1} \<times> S \<times> T"
 21.2127    let ?h = "(\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
 21.2128 -  have *: "{ (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> s \<and> y \<in> t} = ?h ` ?X"
 21.2129 -    apply (rule set_eqI)
 21.2130 -    unfolding image_iff mem_Collect_eq
 21.2131 -    apply rule
 21.2132 -    apply auto
 21.2133 -    apply (rule_tac x=u in rev_bexI)
 21.2134 -    apply simp
 21.2135 -    apply (erule rev_bexI)
 21.2136 -    apply (erule rev_bexI)
 21.2137 -    apply simp
 21.2138 -    apply auto
 21.2139 -    done
 21.2140 +  have *: "{ (1 - u) *\<^sub>R x + u *\<^sub>R y | x y u. 0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> T} = ?h ` ?X"
 21.2141 +    by force
 21.2142    have "continuous_on ?X (\<lambda>z. (1 - fst z) *\<^sub>R fst (snd z) + fst z *\<^sub>R snd (snd z))"
 21.2143      unfolding continuous_on by (rule ballI) (intro tendsto_intros)
 21.2144 -  then show ?thesis
 21.2145 -    unfolding *
 21.2146 -    apply (rule compact_continuous_image)
 21.2147 -    apply (intro compact_Times compact_Icc assms)
 21.2148 -    done
 21.2149 +  with assms show ?thesis
 21.2150 +    by (simp add: * compact_Times compact_continuous_image)
 21.2151  qed
 21.2152  
 21.2153  lemma finite_imp_compact_convex_hull:
 21.2154 -  fixes s :: "'a::real_normed_vector set"
 21.2155 -  assumes "finite s"
 21.2156 -  shows "compact (convex hull s)"
 21.2157 -proof (cases "s = {}")
 21.2158 +  fixes S :: "'a::real_normed_vector set"
 21.2159 +  assumes "finite S"
 21.2160 +  shows "compact (convex hull S)"
 21.2161 +proof (cases "S = {}")
 21.2162    case True
 21.2163    then show ?thesis by simp
 21.2164  next
 21.2165 @@ -5142,8 +4838,7 @@
 21.2166        unfolding convex_hull_insert [OF \<open>A \<noteq> {}\<close>]
 21.2167        apply safe
 21.2168        apply (rule_tac x=a in exI, simp)
 21.2169 -      apply (rule_tac x="1 - a" in exI, simp)
 21.2170 -      apply fast
 21.2171 +      apply (rule_tac x="1 - a" in exI, simp, fast)
 21.2172        apply (rule_tac x="(u, b)" in image_eqI, simp_all)
 21.2173        done
 21.2174      finally show "compact (convex hull (insert x A))" .
 21.2175 @@ -5151,20 +4846,20 @@
 21.2176  qed
 21.2177  
 21.2178  lemma compact_convex_hull:
 21.2179 -  fixes s :: "'a::euclidean_space set"
 21.2180 -  assumes "compact s"
 21.2181 -  shows "compact (convex hull s)"
 21.2182 -proof (cases "s = {}")
 21.2183 +  fixes S :: "'a::euclidean_space set"
 21.2184 +  assumes "compact S"
 21.2185 +  shows "compact (convex hull S)"
 21.2186 +proof (cases "S = {}")
 21.2187    case True
 21.2188    then show ?thesis using compact_empty by simp
 21.2189  next
 21.2190    case False
 21.2191 -  then obtain w where "w \<in> s" by auto
 21.2192 +  then obtain w where "w \<in> S" by auto
 21.2193    show ?thesis
 21.2194 -    unfolding caratheodory[of s]
 21.2195 +    unfolding caratheodory[of S]
 21.2196    proof (induct ("DIM('a) + 1"))
 21.2197      case 0
 21.2198 -    have *: "{x.\<exists>sa. finite sa \<and> sa \<subseteq> s \<and> card sa \<le> 0 \<and> x \<in> convex hull sa} = {}"
 21.2199 +    have *: "{x.\<exists>sa. finite sa \<and> sa \<subseteq> S \<and> card sa \<le> 0 \<and> x \<in> convex hull sa} = {}"
 21.2200        using compact_empty by auto
 21.2201      from 0 show ?case unfolding * by simp
 21.2202    next
 21.2203 @@ -5172,27 +4867,27 @@
 21.2204      show ?case
 21.2205      proof (cases "n = 0")
 21.2206        case True
 21.2207 -      have "{x. \<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t} = s"
 21.2208 +      have "{x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T} = S"
 21.2209          unfolding set_eq_iff and mem_Collect_eq
 21.2210        proof (rule, rule)
 21.2211          fix x
 21.2212 -        assume "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
 21.2213 -        then obtain t where t: "finite t" "t \<subseteq> s" "card t \<le> Suc n" "x \<in> convex hull t"
 21.2214 +        assume "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
 21.2215 +        then obtain T where T: "finite T" "T \<subseteq> S" "card T \<le> Suc n" "x \<in> convex hull T"
 21.2216            by auto
 21.2217 -        show "x \<in> s"
 21.2218 -        proof (cases "card t = 0")
 21.2219 +        show "x \<in> S"
 21.2220 +        proof (cases "card T = 0")
 21.2221            case True
 21.2222            then show ?thesis
 21.2223 -            using t(4) unfolding card_0_eq[OF t(1)] by simp
 21.2224 +            using T(4) unfolding card_0_eq[OF T(1)] by simp
 21.2225          next
 21.2226            case False
 21.2227 -          then have "card t = Suc 0" using t(3) \<open>n=0\<close> by auto
 21.2228 -          then obtain a where "t = {a}" unfolding card_Suc_eq by auto
 21.2229 -          then show ?thesis using t(2,4) by simp
 21.2230 +          then have "card T = Suc 0" using T(3) \<open>n=0\<close> by auto
 21.2231 +          then obtain a where "T = {a}" unfolding card_Suc_eq by auto
 21.2232 +          then show ?thesis using T(2,4) by simp
 21.2233          qed
 21.2234        next
 21.2235 -        fix x assume "x\<in>s"
 21.2236 -        then show "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
 21.2237 +        fix x assume "x\<in>S"
 21.2238 +        then show "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
 21.2239            apply (rule_tac x="{x}" in exI)
 21.2240            unfolding convex_hull_singleton
 21.2241            apply auto
 21.2242 @@ -5201,57 +4896,56 @@
 21.2243        then show ?thesis using assms by simp
 21.2244      next
 21.2245        case False
 21.2246 -      have "{x. \<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t} =
 21.2247 +      have "{x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T} =
 21.2248          {(1 - u) *\<^sub>R x + u *\<^sub>R y | x y u.
 21.2249 -          0 \<le> u \<and> u \<le> 1 \<and> x \<in> s \<and> y \<in> {x. \<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> n \<and> x \<in> convex hull t}}"
 21.2250 +          0 \<le> u \<and> u \<le> 1 \<and> x \<in> S \<and> y \<in> {x. \<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> x \<in> convex hull T}}"
 21.2251          unfolding set_eq_iff and mem_Collect_eq
 21.2252        proof (rule, rule)
 21.2253          fix x
 21.2254          assume "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
 21.2255 -          0 \<le> c \<and> c \<le> 1 \<and> u \<in> s \<and> (\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> n \<and> v \<in> convex hull t)"
 21.2256 -        then obtain u v c t where obt: "x = (1 - c) *\<^sub>R u + c *\<^sub>R v"
 21.2257 -          "0 \<le> c \<and> c \<le> 1" "u \<in> s" "finite t" "t \<subseteq> s" "card t \<le> n"  "v \<in> convex hull t"
 21.2258 +          0 \<le> c \<and> c \<le> 1 \<and> u \<in> S \<and> (\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> v \<in> convex hull T)"
 21.2259 +        then obtain u v c T where obt: "x = (1 - c) *\<^sub>R u + c *\<^sub>R v"
 21.2260 +          "0 \<le> c \<and> c \<le> 1" "u \<in> S" "finite T" "T \<subseteq> S" "card T \<le> n"  "v \<in> convex hull T"
 21.2261            by auto
 21.2262 -        moreover have "(1 - c) *\<^sub>R u + c *\<^sub>R v \<in> convex hull insert u t"
 21.2263 +        moreover have "(1 - c) *\<^sub>R u + c *\<^sub>R v \<in> convex hull insert u T"
 21.2264            apply (rule convexD_alt)
 21.2265 -          using obt(2) and convex_convex_hull and hull_subset[of "insert u t" convex]
 21.2266 -          using obt(7) and hull_mono[of t "insert u t"]
 21.2267 +          using obt(2) and convex_convex_hull and hull_subset[of "insert u T" convex]
 21.2268 +          using obt(7) and hull_mono[of T "insert u T"]
 21.2269            apply auto
 21.2270            done
 21.2271 -        ultimately show "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
 21.2272 -          apply (rule_tac x="insert u t" in exI)
 21.2273 -          apply (auto simp add: card_insert_if)
 21.2274 +        ultimately show "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
 21.2275 +          apply (rule_tac x="insert u T" in exI)
 21.2276 +          apply (auto simp: card_insert_if)
 21.2277            done
 21.2278        next
 21.2279          fix x
 21.2280 -        assume "\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> Suc n \<and> x \<in> convex hull t"
 21.2281 -        then obtain t where t: "finite t" "t \<subseteq> s" "card t \<le> Suc n" "x \<in> convex hull t"
 21.2282 +        assume "\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> Suc n \<and> x \<in> convex hull T"
 21.2283 +        then obtain T where T: "finite T" "T \<subseteq> S" "card T \<le> Suc n" "x \<in> convex hull T"
 21.2284            by auto
 21.2285          show "\<exists>u v c. x = (1 - c) *\<^sub>R u + c *\<^sub>R v \<and>
 21.2286 -          0 \<le> c \<and> c \<le> 1 \<and> u \<in> s \<and> (\<exists>t. finite t \<and> t \<subseteq> s \<and> card t \<le> n \<and> v \<in> convex hull t)"
 21.2287 -        proof (cases "card t = Suc n")
 21.2288 +          0 \<le> c \<and> c \<le> 1 \<and> u \<in> S \<and> (\<exists>T. finite T \<and> T \<subseteq> S \<and> card T \<le> n \<and> v \<in> convex hull T)"
 21.2289 +        proof (cases "card T = Suc n")
 21.2290            case False
 21.2291 -          then have "card t \<le> n" using t(3) by auto
 21.2292 +          then have "card T \<le> n" using T(3) by auto
 21.2293            then show ?thesis
 21.2294              apply (rule_tac x=w in exI, rule_tac x=x in exI, rule_tac x=1 in exI)
 21.2295 -            using \<open>w\<in>s\<close> and t
 21.2296 -            apply (auto intro!: exI[where x=t])
 21.2297 +            using \<open>w\<in>S\<close> and T
 21.2298 +            apply (auto intro!: exI[where x=T])
 21.2299              done
 21.2300          next
 21.2301            case True
 21.2302 -          then obtain a u where au: "t = insert a u" "a\<notin>u"
 21.2303 -            apply (drule_tac card_eq_SucD)
 21.2304 -            apply auto
 21.2305 +          then obtain a u where au: "T = insert a u" "a\<notin>u"
 21.2306 +            apply (drule_tac card_eq_SucD, auto)
 21.2307              done
 21.2308            show ?thesis
 21.2309            proof (cases "u = {}")
 21.2310              case True
 21.2311 -            then have "x = a" using t(4)[unfolded au] by auto
 21.2312 +            then have "x = a" using T(4)[unfolded au] by auto
 21.2313              show ?thesis unfolding \<open>x = a\<close>
 21.2314                apply (rule_tac x=a in exI)
 21.2315                apply (rule_tac x=a in exI)
 21.2316                apply (rule_tac x=1 in exI)
 21.2317 -              using t and \<open>n \<noteq> 0\<close>
 21.2318 +              using T and \<open>n \<noteq> 0\<close>
 21.2319                unfolding au
 21.2320                apply (auto intro!: exI[where x="{a}"])
 21.2321                done
 21.2322 @@ -5259,14 +4953,14 @@
 21.2323              case False
 21.2324              obtain ux vx b where obt: "ux\<ge>0" "vx\<ge>0" "ux + vx = 1"
 21.2325                "b \<in> convex hull u" "x = ux *\<^sub>R a + vx *\<^sub>R b"
 21.2326 -              using t(4)[unfolded au convex_hull_insert[OF False]]
 21.2327 +              using T(4)[unfolded au convex_hull_insert[OF False]]
 21.2328                by auto
 21.2329              have *: "1 - vx = ux" using obt(3) by auto
 21.2330              show ?thesis
 21.2331                apply (rule_tac x=a in exI)
 21.2332                apply (rule_tac x=b in exI)
 21.2333                apply (rule_tac x=vx in exI)
 21.2334 -              using obt and t(1-3)
 21.2335 +              using obt and T(1-3)
 21.2336                unfolding au and * using card_insert_disjoint[OF _ au(2)]
 21.2337                apply (auto intro!: exI[where x=u])
 21.2338                done
 21.2339 @@ -5318,25 +5012,25 @@
 21.2340    using dist_increases_online[of d a 0] unfolding dist_norm by auto
 21.2341  
 21.2342  lemma simplex_furthest_lt:
 21.2343 -  fixes s :: "'a::real_inner set"
 21.2344 -  assumes "finite s"
 21.2345 -  shows "\<forall>x \<in> convex hull s.  x \<notin> s \<longrightarrow> (\<exists>y \<in> convex hull s. norm (x - a) < norm(y - a))"
 21.2346 +  fixes S :: "'a::real_inner set"
 21.2347 +  assumes "finite S"
 21.2348 +  shows "\<forall>x \<in> convex hull S.  x \<notin> S \<longrightarrow> (\<exists>y \<in> convex hull S. norm (x - a) < norm(y - a))"
 21.2349    using assms
 21.2350  proof induct
 21.2351 -  fix x s
 21.2352 -  assume as: "finite s" "x\<notin>s" "\<forall>x\<in>convex hull s. x \<notin> s \<longrightarrow> (\<exists>y\<in>convex hull s. norm (x - a) < norm (y - a))"
 21.2353 -  show "\<forall>xa\<in>convex hull insert x s. xa \<notin> insert x s \<longrightarrow>
 21.2354 -    (\<exists>y\<in>convex hull insert x s. norm (xa - a) < norm (y - a))"
 21.2355 -  proof (rule, rule, cases "s = {}")
 21.2356 +  fix x S
 21.2357 +  assume as: "finite S" "x\<notin>S" "\<forall>x\<in>convex hull S. x \<notin> S \<longrightarrow> (\<exists>y\<in>convex hull S. norm (x - a) < norm (y - a))"
 21.2358 +  show "\<forall>xa\<in>convex hull insert x S. xa \<notin> insert x S \<longrightarrow>
 21.2359 +    (\<exists>y\<in>convex hull insert x S. norm (xa - a) < norm (y - a))"
 21.2360 +  proof (intro impI ballI, cases "S = {}")
 21.2361      case False
 21.2362      fix y
 21.2363 -    assume y: "y \<in> convex hull insert x s" "y \<notin> insert x s"
 21.2364 -    obtain u v b where obt: "u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull s" "y = u *\<^sub>R x + v *\<^sub>R b"
 21.2365 +    assume y: "y \<in> convex hull insert x S" "y \<notin> insert x S"
 21.2366 +    obtain u v b where obt: "u\<ge>0" "v\<ge>0" "u + v = 1" "b \<in> convex hull S" "y = u *\<^sub>R x + v *\<^sub>R b"
 21.2367        using y(1)[unfolded convex_hull_insert[OF False]] by auto
 21.2368 -    show "\<exists>z\<in>convex hull insert x s. norm (y - a) < norm (z - a)"
 21.2369 -    proof (cases "y \<in> convex hull s")
 21.2370 +    show "\<exists>z\<in>convex hull insert x S. norm (y - a) < norm (z - a)"
 21.2371 +    proof (cases "y \<in> convex hull S")
 21.2372        case True
 21.2373 -      then obtain z where "z \<in> convex hull s" "norm (y - a) < norm (z - a)"
 21.2374 +      then obtain z where "z \<in> convex hull S" "norm (y - a) < norm (z - a)"
 21.2375          using as(3)[THEN bspec[where x=y]] and y(2) by auto
 21.2376        then show ?thesis
 21.2377          apply (rule_tac x=z in bexI)
 21.2378 @@ -5363,7 +5057,7 @@
 21.2379          proof
 21.2380            assume "x = b"
 21.2381            then have "y = b" unfolding obt(5)
 21.2382 -            using obt(3) by (auto simp add: scaleR_left_distrib[symmetric])
 21.2383 +            using obt(3) by (auto simp: scaleR_left_distrib[symmetric])
 21.2384            then show False using obt(4) and False by simp
 21.2385          qed
 21.2386          then have *: "w *\<^sub>R (x - b) \<noteq> 0" using w(1) by auto
 21.2387 @@ -5375,15 +5069,12 @@
 21.2388              unfolding dist_commute[of a]
 21.2389              unfolding dist_norm obt(5)
 21.2390              by (simp add: algebra_simps)
 21.2391 -          moreover have "(u + w) *\<^sub>R x + (v - w) *\<^sub>R b \<in> convex hull insert x s"
 21.2392 -            unfolding convex_hull_insert[OF \<open>s\<noteq>{}\<close>] and mem_Collect_eq
 21.2393 -            apply (rule_tac x="u + w" in exI)
 21.2394 -            apply rule
 21.2395 -            defer
 21.2396 -            apply (rule_tac x="v - w" in exI)
 21.2397 -            using \<open>u \<ge> 0\<close> and w and obt(3,4)
 21.2398 -            apply auto
 21.2399 -            done
 21.2400 +          moreover have "(u + w) *\<^sub>R x + (v - w) *\<^sub>R b \<in> convex hull insert x S"
 21.2401 +            unfolding convex_hull_insert[OF \<open>S\<noteq>{}\<close>]
 21.2402 +          proof (intro CollectI conjI exI)
 21.2403 +            show "u + w \<ge> 0" "v - w \<ge> 0"
 21.2404 +              using obt(1) w by auto
 21.2405 +          qed (use obt in auto)
 21.2406            ultimately show ?thesis by auto
 21.2407          next
 21.2408            assume "dist a y < dist a (y - w *\<^sub>R (x - b))"
 21.2409 @@ -5391,39 +5082,36 @@
 21.2410              unfolding dist_commute[of a]
 21.2411              unfolding dist_norm obt(5)
 21.2412              by (simp add: algebra_simps)
 21.2413 -          moreover have "(u - w) *\<^sub>R x + (v + w) *\<^sub>R b \<in> convex hull insert x s"
 21.2414 -            unfolding convex_hull_insert[OF \<open>s\<noteq>{}\<close>] and mem_Collect_eq
 21.2415 -            apply (rule_tac x="u - w" in exI)
 21.2416 -            apply rule
 21.2417 -            defer
 21.2418 -            apply (rule_tac x="v + w" in exI)
 21.2419 -            using \<open>u \<ge> 0\<close> and w and obt(3,4)
 21.2420 -            apply auto
 21.2421 -            done
 21.2422 +          moreover have "(u - w) *\<^sub>R x + (v + w) *\<^sub>R b \<in> convex hull insert x S"
 21.2423 +            unfolding convex_hull_insert[OF \<open>S\<noteq>{}\<close>]
 21.2424 +          proof (intro CollectI conjI exI)
 21.2425 +            show "u - w \<ge> 0" "v + w \<ge> 0"
 21.2426 +              using obt(1) w by auto
 21.2427 +          qed (use obt in auto)
 21.2428            ultimately show ?thesis by auto
 21.2429          qed
 21.2430        qed auto
 21.2431      qed
 21.2432    qed auto
 21.2433 -qed (auto simp add: assms)
 21.2434 +qed (auto simp: assms)
 21.2435  
 21.2436  lemma simplex_furthest_le:
 21.2437 -  fixes s :: "'a::real_inner set"
 21.2438 -  assumes "finite s"
 21.2439 -    and "s \<noteq> {}"
 21.2440 -  shows "\<exists>y\<in>s. \<forall>x\<in> convex hull s. norm (x - a) \<le> norm (y - a)"
 21.2441 +  fixes S :: "'a::real_inner set"
 21.2442 +  assumes "finite S"
 21.2443 +    and "S \<noteq> {}"
 21.2444 +  shows "\<exists>y\<in>S. \<forall>x\<in> convex hull S. norm (x - a) \<le> norm (y - a)"
 21.2445  proof -
 21.2446 -  have "convex hull s \<noteq> {}"
 21.2447 -    using hull_subset[of s convex] and assms(2) by auto
 21.2448 -  then obtain x where x: "x \<in> convex hull s" "\<forall>y\<in>convex hull s. norm (y - a) \<le> norm (x - a)"
 21.2449 -    using distance_attains_sup[OF finite_imp_compact_convex_hull[OF assms(1)], of a]
 21.2450 +  have "convex hull S \<noteq> {}"
 21.2451 +    using hull_subset[of S convex] and assms(2) by auto
 21.2452 +  then obtain x where x: "x \<in> convex hull S" "\<forall>y\<in>convex hull S. norm (y - a) \<le> norm (x - a)"
 21.2453 +    using distance_attains_sup[OF finite_imp_compact_convex_hull[OF \<open>finite S\<close>], of a]
 21.2454      unfolding dist_commute[of a]
 21.2455      unfolding dist_norm
 21.2456      by auto
 21.2457    show ?thesis
 21.2458 -  proof (cases "x \<in> s")
 21.2459 +  proof (cases "x \<in> S")
 21.2460      case False
 21.2461 -    then obtain y where "y \<in> convex hull s" "norm (x - a) < norm (y - a)"
 21.2462 +    then obtain y where "y \<in> convex hull S" "norm (x - a) < norm (y - a)"
 21.2463        using simplex_furthest_lt[OF assms(1), THEN bspec[where x=x]] and x(1)
 21.2464        by auto
 21.2465      then show ?thesis
 21.2466 @@ -5435,82 +5123,82 @@
 21.2467  qed
 21.2468  
 21.2469  lemma simplex_furthest_le_exists:
 21.2470 -  fixes s :: "('a::real_inner) set"
 21.2471 -  shows "finite s \<Longrightarrow> \<forall>x\<in>(convex hull s). \<exists>y\<in>s. norm (x - a) \<le> norm (y - a)"
 21.2472 -  using simplex_furthest_le[of s] by (cases "s = {}") auto
 21.2473 +  fixes S :: "('a::real_inner) set"
 21.2474 +  shows "finite S \<Longrightarrow> \<forall>x\<in>(convex hull S). \<exists>y\<in>S. norm (x - a) \<le> norm (y - a)"
 21.2475 +  using simplex_furthest_le[of S] by (cases "S = {}") auto
 21.2476  
 21.2477  lemma simplex_extremal_le:
 21.2478 -  fixes s :: "'a::real_inner set"
 21.2479 -  assumes "finite s"
 21.2480 -    and "s \<noteq> {}"
 21.2481 -  shows "\<exists>u\<in>s. \<exists>v\<in>s. \<forall>x\<in>convex hull s. \<forall>y \<in> convex hull s. norm (x - y) \<le> norm (u - v)"
 21.2482 +  fixes S :: "'a::real_inner set"
 21.2483 +  assumes "finite S"
 21.2484 +    and "S \<noteq> {}"
 21.2485 +  shows "\<exists>u\<in>S. \<exists>v\<in>S. \<forall>x\<in>convex hull S. \<forall>y \<in> convex hull S. norm (x - y) \<le> norm (u - v)"
 21.2486  proof -
 21.2487 -  have "convex hull s \<noteq> {}"
 21.2488 -    using hull_subset[of s convex] and assms(2) by auto
 21.2489 -  then obtain u v where obt: "u \<in> convex hull s" "v \<in> convex hull s"
 21.2490 -    "\<forall>x\<in>convex hull s. \<forall>y\<in>convex hull s. norm (x - y) \<le> norm (u - v)"
 21.2491 +  have "convex hull S \<noteq> {}"
 21.2492 +    using hull_subset[of S convex] and assms(2) by auto
 21.2493 +  then obtain u v where obt: "u \<in> convex hull S" "v \<in> convex hull S"
 21.2494 +    "\<forall>x\<in>convex hull S. \<forall>y\<in>convex hull S. norm (x - y) \<le> norm (u - v)"
 21.2495      using compact_sup_maxdistance[OF finite_imp_compact_convex_hull[OF assms(1)]]
 21.2496      by (auto simp: dist_norm)
 21.2497    then show ?thesis
 21.2498 -  proof (cases "u\<notin>s \<or> v\<notin>s", elim disjE)
 21.2499 -    assume "u \<notin> s"
 21.2500 -    then obtain y where "y \<in> convex hull s" "norm (u - v) < norm (y - v)"
 21.2501 +  proof (cases "u\<notin>S \<or> v\<notin>S", elim disjE)
 21.2502 +    assume "u \<notin> S"
 21.2503 +    then obtain y where "y \<in> convex hull S" "norm (u - v) < norm (y - v)"
 21.2504        using simplex_furthest_lt[OF assms(1), THEN bspec[where x=u]] and obt(1)
 21.2505        by auto
 21.2506      then show ?thesis
 21.2507        using obt(3)[THEN bspec[where x=y], THEN bspec[where x=v]] and obt(2)
 21.2508        by auto
 21.2509    next
 21.2510 -    assume "v \<notin> s"
 21.2511 -    then obtain y where "y \<in> convex hull s" "norm (v - u) < norm (y - u)"
 21.2512 +    assume "v \<notin> S"
 21.2513 +    then obtain y where "y \<in> convex hull S" "norm (v - u) < norm (y - u)"
 21.2514        using simplex_furthest_lt[OF assms(1), THEN bspec[where x=v]] and obt(2)
 21.2515        by auto
 21.2516      then show ?thesis
 21.2517        using obt(3)[THEN bspec[where x=u], THEN bspec[where x=y]] and obt(1)
 21.2518 -      by (auto simp add: norm_minus_commute)
 21.2519 +      by (auto simp: norm_minus_commute)
 21.2520    qed auto
 21.2521  qed
 21.2522  
 21.2523  lemma simplex_extremal_le_exists:
 21.2524 -  fixes s :: "'a::real_inner set"
 21.2525 -  shows "finite s \<Longrightarrow> x \<in> convex hull s \<Longrightarrow> y \<in> convex hull s \<Longrightarrow>
 21.2526 -    \<exists>u\<in>s. \<exists>v\<in>s. norm (x - y) \<le> norm (u - v)"
 21.2527 -  using convex_hull_empty simplex_extremal_le[of s]
 21.2528 -  by(cases "s = {}") auto
 21.2529 +  fixes S :: "'a::real_inner set"
 21.2530 +  shows "finite S \<Longrightarrow> x \<in> convex hull S \<Longrightarrow> y \<in> convex hull S \<Longrightarrow>
 21.2531 +    \<exists>u\<in>S. \<exists>v\<in>S. norm (x - y) \<le> norm (u - v)"
 21.2532 +  using convex_hull_empty simplex_extremal_le[of S]
 21.2533 +  by(cases "S = {}") auto
 21.2534  
 21.2535  
 21.2536  subsection \<open>Closest point of a convex set is unique, with a continuous projection\<close>
 21.2537  
 21.2538  definition%important closest_point :: "'a::{real_inner,heine_borel} set \<Rightarrow> 'a \<Rightarrow> 'a"
 21.2539 -  where "closest_point s a = (SOME x. x \<in> s \<and> (\<forall>y\<in>s. dist a x \<le> dist a y))"
 21.2540 +  where "closest_point S a = (SOME x. x \<in> S \<and> (\<forall>y\<in>S. dist a x \<le> dist a y))"
 21.2541  
 21.2542  lemma closest_point_exists:
 21.2543 -  assumes "closed s"
 21.2544 -    and "s \<noteq> {}"
 21.2545 -  shows "closest_point s a \<in> s"
 21.2546 -    and "\<forall>y\<in>s. dist a (closest_point s a) \<le> dist a y"
 21.2547 +  assumes "closed S"
 21.2548 +    and "S \<noteq> {}"
 21.2549 +  shows "closest_point S a \<in> S"
 21.2550 +    and "\<forall>y\<in>S. dist a (closest_point S a) \<le> dist a y"
 21.2551    unfolding closest_point_def
 21.2552    apply(rule_tac[!] someI2_ex)
 21.2553    apply (auto intro: distance_attains_inf[OF assms(1,2), of a])
 21.2554    done
 21.2555  
 21.2556 -lemma closest_point_in_set: "closed s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> closest_point s a \<in> s"
 21.2557 +lemma closest_point_in_set: "closed S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> closest_point S a \<in> S"
 21.2558    by (meson closest_point_exists)
 21.2559  
 21.2560 -lemma closest_point_le: "closed s \<Longrightarrow> x \<in> s \<Longrightarrow> dist a (closest_point s a) \<le> dist a x"
 21.2561 -  using closest_point_exists[of s] by auto
 21.2562 +lemma closest_point_le: "closed S \<Longrightarrow> x \<in> S \<Longrightarrow> dist a (closest_point S a) \<le> dist a x"
 21.2563 +  using closest_point_exists[of S] by auto
 21.2564  
 21.2565  lemma closest_point_self:
 21.2566 -  assumes "x \<in> s"
 21.2567 -  shows "closest_point s x = x"
 21.2568 +  assumes "x \<in> S"
 21.2569 +  shows "closest_point S x = x"
 21.2570    unfolding closest_point_def
 21.2571    apply (rule some1_equality, rule ex1I[of _ x])
 21.2572    using assms
 21.2573    apply auto
 21.2574    done
 21.2575  
 21.2576 -lemma closest_point_refl: "closed s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> closest_point s x = x \<longleftrightarrow> x \<in> s"
 21.2577 -  using closest_point_in_set[of s x] closest_point_self[of x s]
 21.2578 +lemma closest_point_refl: "closed S \<Longrightarrow> S \<noteq> {} \<Longrightarrow> closest_point S x = x \<longleftrightarrow> x \<in> S"
 21.2579 +  using closest_point_in_set[of S x] closest_point_self[of x S]
 21.2580    by auto
 21.2581  
 21.2582  lemma closer_points_lemma:
 21.2583 @@ -5519,18 +5207,13 @@
 21.2584  proof -
 21.2585    have z: "inner z z > 0"
 21.2586      unfolding inner_gt_zero_iff using assms by auto
 21.2587 +  have "norm (v *\<^sub>R z - y) < norm y"
 21.2588 +    if "0 < v" and "v \<le> inner y z / inner z z" for v
 21.2589 +    unfolding norm_lt using z assms that
 21.2590 +    by (simp add: field_simps inner_diff inner_commute mult_strict_left_mono[OF _ \<open>0<v\<close>])
 21.2591    then show ?thesis
 21.2592 -    using assms
 21.2593 -    apply (rule_tac x = "inner y z / inner z z" in exI)
 21.2594 -    apply rule
 21.2595 -    defer
 21.2596 -  proof rule+
 21.2597 -    fix v
 21.2598 -    assume "0 < v" and "v \<le> inner y z / inner z z"
 21.2599 -    then show "norm (v *\<^sub>R z - y) < norm y"
 21.2600 -      unfolding norm_lt using z and assms
 21.2601 -      by (simp add: field_simps inner_diff inner_commute mult_strict_left_mono[OF _ \<open>0<v\<close>])
 21.2602 -  qed auto
 21.2603 +    using assms z
 21.2604 +    by (rule_tac x = "inner y z / inner z z" in exI) auto
 21.2605  qed
 21.2606  
 21.2607  lemma closer_point_lemma:
 21.2608 @@ -5543,50 +5226,50 @@
 21.2609    show ?thesis
 21.2610      apply (rule_tac x="min u 1" in exI)
 21.2611      using u[THEN spec[where x="min u 1"]] and \<open>u > 0\<close>
 21.2612 -    unfolding dist_norm by (auto simp add: norm_minus_commute field_simps)
 21.2613 +    unfolding dist_norm by (auto simp: norm_minus_commute field_simps)
 21.2614  qed
 21.2615  
 21.2616  lemma any_closest_point_dot:
 21.2617 -  assumes "convex s" "closed s" "x \<in> s" "y \<in> s" "\<forall>z\<in>s. dist a x \<le> dist a z"
 21.2618 +  assumes "convex S" "closed S" "x \<in> S" "y \<in> S" "\<forall>z\<in>S. dist a x \<le> dist a z"
 21.2619    shows "inner (a - x) (y - x) \<le> 0"
 21.2620  proof (rule ccontr)
 21.2621    assume "\<not> ?thesis"
 21.2622    then obtain u where u: "u>0" "u\<le>1" "dist (x + u *\<^sub>R (y - x)) a < dist x a"
 21.2623      using closer_point_lemma[of a x y] by auto
 21.2624    let ?z = "(1 - u) *\<^sub>R x + u *\<^sub>R y"
 21.2625 -  have "?z \<in> s"
 21.2626 +  have "?z \<in> S"
 21.2627      using convexD_alt[OF assms(1,3,4), of u] using u by auto
 21.2628    then show False
 21.2629      using assms(5)[THEN bspec[where x="?z"]] and u(3)
 21.2630 -    by (auto simp add: dist_commute algebra_simps)
 21.2631 +    by (auto simp: dist_commute algebra_simps)
 21.2632  qed
 21.2633  
 21.2634  lemma any_closest_point_unique:
 21.2635    fixes x :: "'a::real_inner"
 21.2636 -  assumes "convex s" "closed s" "x \<in> s" "y \<in> s"
 21.2637 -    "\<forall>z\<in>s. dist a x \<le> dist a z" "\<forall>z\<in>s. dist a y \<le> dist a z"
 21.2638 +  assumes "convex S" "closed S" "x \<in> S" "y \<in> S"
 21.2639 +    "\<forall>z\<in>S. dist a x \<le> dist a z" "\<forall>z\<in>S. dist a y \<le> dist a z"
 21.2640    shows "x = y"
 21.2641    using any_closest_point_dot[OF assms(1-4,5)] and any_closest_point_dot[OF assms(1-2,4,3,6)]
 21.2642    unfolding norm_pths(1) and norm_le_square
 21.2643 -  by (auto simp add: algebra_simps)
 21.2644 +  by (auto simp: algebra_simps)
 21.2645  
 21.2646  lemma closest_point_unique:
 21.2647 -  assumes "convex s" "closed s" "x \<in> s" "\<forall>z\<in>s. dist a x \<le> dist a z"
 21.2648 -  shows "x = closest_point s a"
 21.2649 -  using any_closest_point_unique[OF assms(1-3) _ assms(4), of "closest_point s a"]
 21.2650 +  assumes "convex S" "closed S" "x \<in> S" "\<forall>z\<in>S. dist a x \<le> dist a z"
 21.2651 +  shows "x = closest_point S a"
 21.2652 +  using any_closest_point_unique[OF assms(1-3) _ assms(4), of "closest_point S a"]
 21.2653    using closest_point_exists[OF assms(2)] and assms(3) by auto
 21.2654  
 21.2655  lemma closest_point_dot:
 21.2656 -  assumes "convex s" "closed s" "x \<in> s"
 21.2657 -  shows "inner (a - closest_point s a) (x - closest_point s a) \<le> 0"
 21.2658 +  assumes "convex S" "closed S" "x \<in> S"
 21.2659 +  shows "inner (a - closest_point S a) (x - closest_point S a) \<le> 0"
 21.2660    apply (rule any_closest_point_dot[OF assms(1,2) _ assms(3)])
 21.2661    using closest_point_exists[OF assms(2)] and assms(3)
 21.2662    apply auto
 21.2663    done
 21.2664  
 21.2665  lemma closest_point_lt:
 21.2666 -  assumes "convex s" "closed s" "x \<in> s" "x \<noteq> closest_point s a"
 21.2667 -  shows "dist a (closest_point s a) < dist a x"
 21.2668 +  assumes "convex S" "closed S" "x \<in> S" "x \<noteq> closest_point S a"
 21.2669 +  shows "dist a (closest_point S a) < dist a x"
 21.2670    apply (rule ccontr)
 21.2671    apply (rule_tac notE[OF assms(4)])
 21.2672    apply (rule closest_point_unique[OF assms(1-3), of a])
 21.2673 @@ -5595,34 +5278,34 @@
 21.2674    done
 21.2675  
 21.2676  lemma closest_point_lipschitz:
 21.2677 -  assumes "convex s"
 21.2678 -    and "closed s" "s \<noteq> {}"
 21.2679 -  shows "dist (closest_point s x) (closest_point s y) \<le> dist x y"
 21.2680 +  assumes "convex S"
 21.2681 +    and "closed S" "S \<noteq> {}"
 21.2682 +  shows "dist (closest_point S x) (closest_point S y) \<le> dist x y"
 21.2683  proof -
 21.2684 -  have "inner (x - closest_point s x) (closest_point s y - closest_point s x) \<le> 0"
 21.2685 -    and "inner (y - closest_point s y) (closest_point s x - closest_point s y) \<le> 0"
 21.2686 +  have "inner (x - closest_point S x) (closest_point S y - closest_point S x) \<le> 0"
 21.2687 +    and "inner (y - closest_point S y) (closest_point S x - closest_point S y) \<le> 0"
 21.2688      apply (rule_tac[!] any_closest_point_dot[OF assms(1-2)])
 21.2689      using closest_point_exists[OF assms(2-3)]
 21.2690      apply auto
 21.2691      done
 21.2692    then show ?thesis unfolding dist_norm and norm_le
 21.2693 -    using inner_ge_zero[of "(x - closest_point s x) - (y - closest_point s y)"]
 21.2694 +    using inner_ge_zero[of "(x - closest_point S x) - (y - closest_point S y)"]
 21.2695      by (simp add: inner_add inner_diff inner_commute)
 21.2696  qed
 21.2697  
 21.2698  lemma continuous_at_closest_point:
 21.2699 -  assumes "convex s"
 21.2700 -    and "closed s"
 21.2701 -    and "s \<noteq> {}"
 21.2702 -  shows "continuous (at x) (closest_point s)"
 21.2703 +  assumes "convex S"
 21.2704 +    and "closed S"
 21.2705 +    and "S \<noteq> {}"
 21.2706 +  shows "continuous (at x) (closest_point S)"
 21.2707    unfolding continuous_at_eps_delta
 21.2708    using le_less_trans[OF closest_point_lipschitz[OF assms]] by auto
 21.2709  
 21.2710  lemma continuous_on_closest_point:
 21.2711 -  assumes "convex s"
 21.2712 -    and "closed s"
 21.2713 -    and "s \<noteq> {}"
 21.2714 -  shows "continuous_on t (closest_point s)"
 21.2715 +  assumes "convex S"
 21.2716 +    and "closed S"
 21.2717 +    and "S \<noteq> {}"
 21.2718 +  shows "continuous_on t (closest_point S)"
 21.2719    by (metis continuous_at_imp_continuous_on continuous_at_closest_point[OF assms])
 21.2720  
 21.2721  proposition closest_point_in_rel_interior:
 21.2722 @@ -5647,7 +5330,7 @@
 21.2723        by (simp add: y_def algebra_simps)
 21.2724      then have "norm (x - y) = abs ((1 - min 1 (e / norm (closest_point S x - x)))) * norm(x - closest_point S x)"
 21.2725        by simp
 21.2726 -    also have "... < norm(x - closest_point S x)"
 21.2727 +    also have "\<dots> < norm(x - closest_point S x)"
 21.2728        using clo_notx \<open>e > 0\<close>
 21.2729        by (auto simp: mult_less_cancel_right2 divide_simps)
 21.2730      finally have no_less: "norm (x - y) < norm (x - closest_point S x)" .
 21.2731 @@ -5673,121 +5356,84 @@
 21.2732  
 21.2733  lemma supporting_hyperplane_closed_point:
 21.2734    fixes z :: "'a::{real_inner,heine_borel}"
 21.2735 -  assumes "convex s"
 21.2736 -    and "closed s"
 21.2737 -    and "s \<noteq> {}"
 21.2738 -    and "z \<notin> s"
 21.2739 -  shows "\<exists>a b. \<exists>y\<in>s. inner a z < b \<and> inner a y = b \<and> (\<forall>x\<in>s. inner a x \<ge> b)"
 21.2740 +  assumes "convex S"
 21.2741 +    and "closed S"
 21.2742 +    and "S \<noteq> {}"
 21.2743 +    and "z \<notin> S"
 21.2744 +  shows "\<exists>a b. \<exists>y\<in>S. inner a z < b \<and> inner a y = b \<and> (\<forall>x\<in>S. inner a x \<ge> b)"
 21.2745  proof -
 21.2746 -  obtain y where "y \<in> s" and y: "\<forall>x\<in>s. dist z y \<le> dist z x"
 21.2747 +  obtain y where "y \<in> S" and y: "\<forall>x\<in>S. dist z y \<le> dist z x"
 21.2748      by (metis distance_attains_inf[OF assms(2-3)])
 21.2749    show ?thesis
 21.2750 -    apply (rule_tac x="y - z" in exI)
 21.2751 -    apply (rule_tac x="inner (y - z) y" in exI)
 21.2752 -    apply (rule_tac x=y in bexI)
 21.2753 -    apply rule
 21.2754 -    defer
 21.2755 -    apply rule
 21.2756 -    defer
 21.2757 -    apply rule
 21.2758 -    apply (rule ccontr)
 21.2759 -    using \<open>y \<in> s\<close>
 21.2760 -  proof -
 21.2761 -    show "inner (y - z) z < inner (y - z) y"
 21.2762 -      apply (subst diff_gt_0_iff_gt [symmetric])
 21.2763 -      unfolding inner_diff_right[symmetric] and inner_gt_zero_iff
 21.2764 -      using \<open>y\<in>s\<close> \<open>z\<notin>s\<close>
 21.2765 -      apply auto
 21.2766 -      done
 21.2767 -  next
 21.2768 -    fix x
 21.2769 -    assume "x \<in> s"
 21.2770 -    have *: "\<forall>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> dist z y \<le> dist z ((1 - u) *\<^sub>R y + u *\<^sub>R x)"
 21.2771 -      using assms(1)[unfolded convex_alt] and y and \<open>x\<in>s\<close> and \<open>y\<in>s\<close> by auto
 21.2772 -    assume "\<not> inner (y - z) y \<le> inner (y - z) x"
 21.2773 -    then obtain v where "v > 0" "v \<le> 1" "dist (y + v *\<^sub>R (x - y)) z < dist y z"
 21.2774 -      using closer_point_lemma[of z y x] by (auto simp add: inner_diff)
 21.2775 -    then show False
 21.2776 -      using *[THEN spec[where x=v]] by (auto simp add: dist_commute algebra_simps)
 21.2777 -  qed auto
 21.2778 +  proof (intro exI bexI conjI ballI)
 21.2779 +    show "(y - z) \<bullet> z < (y - z) \<bullet> y"
 21.2780 +      by (metis \<open>y \<in> S\<close> assms(4) diff_gt_0_iff_gt inner_commute inner_diff_left inner_gt_zero_iff right_minus_eq)
 21.2781 +    show "(y - z) \<bullet> y \<le> (y - z) \<bullet> x" if "x \<in> S" for x
 21.2782 +    proof (rule ccontr)
 21.2783 +      have *: "\<And>u. 0 \<le> u \<and> u \<le> 1 \<longrightarrow> dist z y \<le> dist z ((1 - u) *\<^sub>R y + u *\<^sub>R x)"
 21.2784 +        using assms(1)[unfolded convex_alt] and y and \<open>x\<in>S\<close> and \<open>y\<in>S\<close> by auto
 21.2785 +      assume "\<not> (y - z) \<bullet> y \<le> (y - z) \<bullet> x"
 21.2786 +      then obtain v where "v > 0" "v \<le> 1" "dist (y + v *\<^sub>R (x - y)) z < dist y z"
 21.2787 +        using closer_point_lemma[of z y x] by (auto simp: inner_diff)
 21.2788 +      then show False
 21.2789 +        using *[of v] by (auto simp: dist_commute algebra_simps)
 21.2790 +    qed
 21.2791 +  qed (use \<open>y \<in> S\<close> in auto)
 21.2792  qed
 21.2793  
 21.2794  lemma separating_hyperplane_closed_point:
 21.2795    fixes z :: "'a::{real_inner,heine_borel}"
 21.2796 -  assumes "convex s"
 21.2797 -    and "closed s"
 21.2798 -    and "z \<notin> s"
 21.2799 -  shows "\<exists>a b. inner a z < b \<and> (\<forall>x\<in>s. inner a x > b)"
 21.2800 -proof (cases "s = {}")
 21.2801 +  assumes "convex S"
 21.2802 +    and "closed S"
 21.2803 +    and "z \<notin> S"
 21.2804 +  shows "\<exists>a b. inner a z < b \<and> (\<forall>x\<in>S. inner a x > b)"
 21.2805 +proof (cases "S = {}")
 21.2806    case True
 21.2807    then show ?thesis
 21.2808 -    apply (rule_tac x="-z" in exI)
 21.2809 -    apply (rule_tac x=1 in exI)
 21.2810 -    using less_le_trans[OF _ inner_ge_zero[of z]]
 21.2811 -    apply auto
 21.2812 -    done
 21.2813 +    by (simp add: gt_ex)
 21.2814  next
 21.2815    case False
 21.2816 -  obtain y where "y \<in> s" and y: "\<forall>x\<in>s. dist z y \<le> dist z x"
 21.2817 +  obtain y where "y \<in> S" and y: "\<And>x. x \<in> S \<Longrightarrow> dist z y \<le> dist z x"
 21.2818      by (metis distance_attains_inf[OF assms(2) False])
 21.2819    show ?thesis
 21.2820 -    apply (rule_tac x="y - z" in exI)
 21.2821 -    apply (rule_tac x="inner (y - z) z + (norm (y - z))\<^sup>2 / 2" in exI)
 21.2822 -    apply rule
 21.2823 -    defer
 21.2824 -    apply rule
 21.2825 -  proof -
 21.2826 +  proof (intro exI conjI ballI)
 21.2827 +    show "(y - z) \<bullet> z < inner (y - z) z + (norm (y - z))\<^sup>2 / 2"
 21.2828 +      using \<open>y\<in>S\<close> \<open>z\<notin>S\<close> by auto
 21.2829 +  next
 21.2830      fix x
 21.2831 -    assume "x \<in> s"
 21.2832 -    have "\<not> 0 < inner (z - y) (x - y)"
 21.2833 -      apply (rule notI)
 21.2834 -      apply (drule closer_point_lemma)
 21.2835 +    assume "x \<in> S"
 21.2836 +    have "False" if *: "0 < inner (z - y) (x - y)"
 21.2837      proof -
 21.2838 -      assume "\<exists>u>0. u \<le> 1 \<and> dist (y + u *\<^sub>R (x - y)) z < dist y z"
 21.2839 -      then obtain u where "u > 0" "u \<le> 1" "dist (y + u *\<^sub>R (x - y)) z < dist y z"
 21.2840 -        by auto
 21.2841 -      then show False using y[THEN bspec[where x="y + u *\<^sub>R (x - y)"]]
 21.2842 -        using assms(1)[unfolded convex_alt, THEN bspec[where x=y]]
 21.2843 -        using \<open>x\<in>s\<close> \<open>y\<in>s\<close> by (auto simp add: dist_commute algebra_simps)
 21.2844 +      obtain u where "u > 0" "u \<le> 1" "dist (y + u *\<^sub>R (x - y)) z < dist y z"
 21.2845 +        using * closer_point_lemma by blast
 21.2846 +      then show False using y[of "y + u *\<^sub>R (x - y)"] convexD_alt [OF \<open>convex S\<close>]
 21.2847 +        using \<open>x\<in>S\<close> \<open>y\<in>S\<close> by (auto simp: dist_commute algebra_simps)
 21.2848      qed
 21.2849      moreover have "0 < (norm (y - z))\<^sup>2"
 21.2850 -      using \<open>y\<in>s\<close> \<open>z\<notin>s\<close> by auto
 21.2851 +      using \<open>y\<in>S\<close> \<open>z\<notin>S\<close> by auto
 21.2852      then have "0 < inner (y - z) (y - z)"
 21.2853        unfolding power2_norm_eq_inner by simp
 21.2854 -    ultimately show "inner (y - z) z + (norm (y - z))\<^sup>2 / 2 < inner (y - z) x"
 21.2855 -      unfolding power2_norm_eq_inner and not_less
 21.2856 -      by (auto simp add: field_simps inner_commute inner_diff)
 21.2857 -  qed (insert \<open>y\<in>s\<close> \<open>z\<notin>s\<close>, auto)
 21.2858 +    ultimately show "(y - z) \<bullet> z + (norm (y - z))\<^sup>2 / 2 < (y - z) \<bullet> x"
 21.2859 +      by (force simp: field_simps power2_norm_eq_inner inner_commute inner_diff)
 21.2860 +  qed 
 21.2861  qed
 21.2862  
 21.2863  lemma separating_hyperplane_closed_0:
 21.2864 -  assumes "convex (s::('a::euclidean_space) set)"
 21.2865 -    and "closed s"
 21.2866 -    and "0 \<notin> s"
 21.2867 -  shows "\<exists>a b. a \<noteq> 0 \<and> 0 < b \<and> (\<forall>x\<in>s. inner a x > b)"
 21.2868 -proof (cases "s = {}")
 21.2869 +  assumes "convex (S::('a::euclidean_space) set)"
 21.2870 +    and "closed S"
 21.2871 +    and "0 \<notin> S"
 21.2872 +  shows "\<exists>a b. a \<noteq> 0 \<and> 0 < b \<and> (\<forall>x\<in>S. inner a x > b)"
 21.2873 +proof (cases "S = {}")
 21.2874    case True
 21.2875 -  have "norm ((SOME i. i\<in>Basis)::'a) = 1" "(SOME i. i\<in>Basis) \<noteq> (0::'a)"
 21.2876 -    defer
 21.2877 -    apply (subst norm_le_zero_iff[symmetric])
 21.2878 -    apply (auto simp: SOME_Basis)
 21.2879 -    done
 21.2880 +  have "(SOME i. i\<in>Basis) \<noteq> (0::'a)"
 21.2881 +    by (metis Basis_zero SOME_Basis)
 21.2882    then show ?thesis
 21.2883 -    apply (rule_tac x="SOME i. i\<in>Basis" in exI)
 21.2884 -    apply (rule_tac x=1 in exI)
 21.2885 -    using True using DIM_positive[where 'a='a]
 21.2886 -    apply auto
 21.2887 -    done
 21.2888 +    using True zero_less_one by blast
 21.2889  next
 21.2890    case False
 21.2891    then show ?thesis
 21.2892      using False using separating_hyperplane_closed_point[OF assms]
 21.2893 -    apply (elim exE)
 21.2894 -    unfolding inner_zero_right
 21.2895 -    apply (rule_tac x=a in exI)
 21.2896 -    apply (rule_tac x=b in exI)
 21.2897 -    apply auto
 21.2898 -    done
 21.2899 +    by (metis all_not_in_conv inner_zero_left inner_zero_right less_eq_real_def not_le)
 21.2900  qed
 21.2901  
 21.2902  
 21.2903 @@ -5826,7 +5472,7 @@
 21.2904      apply rule
 21.2905      apply rule
 21.2906      apply (erule_tac x="x - y" in ballE)
 21.2907 -    apply (auto simp add: inner_diff)
 21.2908 +    apply (auto simp: inner_diff)
 21.2909      done
 21.2910    define k where "k = (SUP x:T. a \<bullet> x)"
 21.2911    show ?thesis
 21.2912 @@ -5876,8 +5522,7 @@
 21.2913      by auto
 21.2914    then show ?thesis
 21.2915      apply (rule_tac x="-a" in exI)
 21.2916 -    apply (rule_tac x="-b" in exI)
 21.2917 -    apply auto
 21.2918 +    apply (rule_tac x="-b" in exI, auto)
 21.2919      done
 21.2920  qed
 21.2921  
 21.2922 @@ -5885,13 +5530,13 @@
 21.2923  subsubsection%unimportant \<open>General case without assuming closure and getting non-strict separation\<close>
 21.2924  
 21.2925  lemma separating_hyperplane_set_0:
 21.2926 -  assumes "convex s" "(0::'a::euclidean_space) \<notin> s"
 21.2927 -  shows "\<exists>a. a \<noteq> 0 \<and> (\<forall>x\<in>s. 0 \<le> inner a x)"
 21.2928 +  assumes "convex S" "(0::'a::euclidean_space) \<notin> S"
 21.2929 +  shows "\<exists>a. a \<noteq> 0 \<and> (\<forall>x\<in>S. 0 \<le> inner a x)"
 21.2930  proof -
 21.2931    let ?k = "\<lambda>c. {x::'a. 0 \<le> inner c x}"
 21.2932 -  have *: "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}" if as: "f \<subseteq> ?k ` s" "finite f" for f
 21.2933 +  have *: "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}" if as: "f \<subseteq> ?k ` S" "finite f" for f
 21.2934    proof -
 21.2935 -    obtain c where c: "f = ?k ` c" "c \<subseteq> s" "finite c"
 21.2936 +    obtain c where c: "f = ?k ` c" "c \<subseteq> S" "finite c"
 21.2937        using finite_subset_image[OF as(2,1)] by auto
 21.2938      then obtain a b where ab: "a \<noteq> 0" "0 < b" "\<forall>x\<in>convex hull c. b < inner a x"
 21.2939        using separating_hyperplane_closed_0[OF convex_convex_hull, of c]
 21.2940 @@ -5902,50 +5547,50 @@
 21.2941        apply (rule_tac x = "inverse(norm a) *\<^sub>R a" in exI)
 21.2942        using hull_subset[of c convex]
 21.2943        unfolding subset_eq and inner_scaleR
 21.2944 -      by (auto simp add: inner_commute del: ballE elim!: ballE)
 21.2945 +      by (auto simp: inner_commute del: ballE elim!: ballE)
 21.2946      then show "frontier (cball 0 1) \<inter> \<Inter>f \<noteq> {}"
 21.2947        unfolding c(1) frontier_cball sphere_def dist_norm by auto
 21.2948    qed
 21.2949 -  have "frontier (cball 0 1) \<inter> (\<Inter>(?k ` s)) \<noteq> {}"
 21.2950 +  have "frontier (cball 0 1) \<inter> (\<Inter>(?k ` S)) \<noteq> {}"
 21.2951      apply (rule compact_imp_fip)
 21.2952      apply (rule compact_frontier[OF compact_cball])
 21.2953      using * closed_halfspace_ge
 21.2954      by auto
 21.2955 -  then obtain x where "norm x = 1" "\<forall>y\<in>s. x\<in>?k y"
 21.2956 +  then obtain x where "norm x = 1" "\<forall>y\<in>S. x\<in>?k y"
 21.2957      unfolding frontier_cball dist_norm sphere_def by auto
 21.2958    then show ?thesis
 21.2959      by (metis inner_commute mem_Collect_eq norm_eq_zero zero_neq_one)
 21.2960  qed
 21.2961  
 21.2962  lemma separating_hyperplane_sets:
 21.2963 -  fixes s t :: "'a::euclidean_space set"
 21.2964 -  assumes "convex s"
 21.2965 -    and "convex t"
 21.2966 -    and "s \<noteq> {}"
 21.2967 -    and "t \<noteq> {}"
 21.2968 -    and "s \<inter> t = {}"
 21.2969 -  shows "\<exists>a b. a \<noteq> 0 \<and> (\<forall>x\<in>s. inner a x \<le> b) \<and> (\<forall>x\<in>t. inner a x \<ge> b)"
 21.2970 +  fixes S T :: "'a::euclidean_space set"
 21.2971 +  assumes "convex S"
 21.2972 +    and "convex T"
 21.2973 +    and "S \<noteq> {}"
 21.2974 +    and "T \<noteq> {}"
 21.2975 +    and "S \<inter> T = {}"
 21.2976 +  shows "\<exists>a b. a \<noteq> 0 \<and> (\<forall>x\<in>S. inner a x \<le> b) \<and> (\<forall>x\<in>T. inner a x \<ge> b)"
 21.2977  proof -
 21.2978    from separating_hyperplane_set_0[OF convex_differences[OF assms(2,1)]]
 21.2979 -  obtain a where "a \<noteq> 0" "\<forall>x\<in>{x - y |x y. x \<in> t \<and> y \<in> s}. 0 \<le> inner a x"
 21.2980 +  obtain a where "a \<noteq> 0" "\<forall>x\<in>{x - y |x y. x \<in> T \<and> y \<in> S}. 0 \<le> inner a x"
 21.2981      using assms(3-5) by force
 21.2982 -  then have *: "\<And>x y. x \<in> t \<Longrightarrow> y \<in> s \<Longrightarrow> inner a y \<le> inner a x"
 21.2983 -    by (force simp add: inner_diff)
 21.2984 -  then have bdd: "bdd_above (((\<bullet>) a)`s)"
 21.2985 -    using \<open>t \<noteq> {}\<close> by (auto intro: bdd_aboveI2[OF *])
 21.2986 +  then have *: "\<And>x y. x \<in> T \<Longrightarrow> y \<in> S \<Longrightarrow> inner a y \<le> inner a x"
 21.2987 +    by (force simp: inner_diff)
 21.2988 +  then have bdd: "bdd_above (((\<bullet>) a)`S)"
 21.2989 +    using \<open>T \<noteq> {}\<close> by (auto intro: bdd_aboveI2[OF *])
 21.2990    show ?thesis
 21.2991      using \<open>a\<noteq>0\<close>
 21.2992 -    by (intro exI[of _ a] exI[of _ "SUP x:s. a \<bullet> x"])
 21.2993 -       (auto intro!: cSUP_upper bdd cSUP_least \<open>a \<noteq> 0\<close> \<open>s \<noteq> {}\<close> *)
 21.2994 +    by (intro exI[of _ a] exI[of _ "SUP x:S. a \<bullet> x"])
 21.2995 +       (auto intro!: cSUP_upper bdd cSUP_least \<open>a \<noteq> 0\<close> \<open>S \<noteq> {}\<close> *)
 21.2996  qed
 21.2997  
 21.2998  
 21.2999  subsection%unimportant \<open>More convexity generalities\<close>
 21.3000  
 21.3001  lemma convex_closure [intro,simp]:
 21.3002 -  fixes s :: "'a::real_normed_vector set"
 21.3003 -  assumes "convex s"
 21.3004 -  shows "convex (closure s)"
 21.3005 +  fixes S :: "'a::real_normed_vector set"
 21.3006 +  assumes "convex S"
 21.3007 +  shows "convex (closure S)"
 21.3008    apply (rule convexI)
 21.3009    apply (unfold closure_sequential, elim exE)
 21.3010    apply (rule_tac x="\<lambda>n. u *\<^sub>R xa n + v *\<^sub>R xb n" in exI)
 21.3011 @@ -5955,65 +5600,58 @@
 21.3012    done
 21.3013  
 21.3014  lemma convex_interior [intro,simp]:
 21.3015 -  fixes s :: "'a::real_normed_vector set"
 21.3016 -  assumes "convex s"
 21.3017 -  shows "convex (interior s)"
 21.3018 +  fixes S :: "'a::real_normed_vector set"
 21.3019 +  assumes "convex S"
 21.3020 +  shows "convex (interior S)"
 21.3021    unfolding convex_alt Ball_def mem_interior
 21.3022 -  apply (rule,rule,rule,rule,rule,rule)
 21.3023 -  apply (elim exE conjE)
 21.3024 -proof -
 21.3025 +proof clarify
 21.3026    fix x y u
 21.3027    assume u: "0 \<le> u" "u \<le> (1::real)"
 21.3028    fix e d
 21.3029 -  assume ed: "ball x e \<subseteq> s" "ball y d \<subseteq> s" "0<d" "0<e"
 21.3030 -  show "\<exists>e>0. ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) e \<subseteq> s"
 21.3031 -    apply (rule_tac x="min d e" in exI)
 21.3032 -    apply rule
 21.3033 -    unfolding subset_eq
 21.3034 -    defer
 21.3035 -    apply rule
 21.3036 -  proof -
 21.3037 +  assume ed: "ball x e \<subseteq> S" "ball y d \<subseteq> S" "0<d" "0<e"
 21.3038 +  show "\<exists>e>0. ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) e \<subseteq> S"
 21.3039 +  proof (intro exI conjI subsetI)
 21.3040      fix z
 21.3041      assume "z \<in> ball ((1 - u) *\<^sub>R x + u *\<^sub>R y) (min d e)"
 21.3042 -    then have "(1- u) *\<^sub>R (z - u *\<^sub>R (y - x)) + u *\<^sub>R (z + (1 - u) *\<^sub>R (y - x)) \<in> s"
 21.3043 +    then have "(1- u) *\<^sub>R (z - u *\<^sub>R (y - x)) + u *\<^sub>R (z + (1 - u) *\<^sub>R (y - x)) \<in> S"
 21.3044        apply (rule_tac assms[unfolded convex_alt, rule_format])
 21.3045        using ed(1,2) and u
 21.3046        unfolding subset_eq mem_ball Ball_def dist_norm
 21.3047 -      apply (auto simp add: algebra_simps)
 21.3048 +      apply (auto simp: algebra_simps)
 21.3049        done
 21.3050 -    then show "z \<in> s"
 21.3051 -      using u by (auto simp add: algebra_simps)
 21.3052 +    then show "z \<in> S"
 21.3053 +      using u by (auto simp: algebra_simps)
 21.3054    qed(insert u ed(3-4), auto)
 21.3055  qed
 21.3056  
 21.3057 -lemma convex_hull_eq_empty[simp]: "convex hull s = {} \<longleftrightarrow> s = {}"
 21.3058 -  using hull_subset[of s convex] convex_hull_empty by auto
 21.3059 +lemma convex_hull_eq_empty[simp]: "convex hull S = {} \<longleftrightarrow> S = {}"
 21.3060 +  using hull_subset[of S convex] convex_hull_empty by auto
 21.3061  
 21.3062  
 21.3063  subsection%unimportant \<open>Moving and scaling convex hulls\<close>
 21.3064  
 21.3065  lemma convex_hull_set_plus:
 21.3066 -  "convex hull (s + t) = convex hull s + convex hull t"
 21.3067 +  "convex hull (S + T) = convex hull S + convex hull T"
 21.3068    unfolding set_plus_image
 21.3069    apply (subst convex_hull_linear_image [symmetric])
 21.3070    apply (simp add: linear_iff scaleR_right_distrib)
 21.3071    apply (simp add: convex_hull_Times)
 21.3072    done
 21.3073  
 21.3074 -lemma translation_eq_singleton_plus: "(\<lambda>x. a + x) ` t = {a} + t"
 21.3075 +lemma translation_eq_singleton_plus: "(\<lambda>x. a + x) ` T = {a} + T"
 21.3076    unfolding set_plus_def by auto
 21.3077  
 21.3078  lemma convex_hull_translation:
 21.3079 -  "convex hull ((\<lambda>x. a + x) ` s) = (\<lambda>x. a + x) ` (convex hull s)"
 21.3080 +  "convex hull ((\<lambda>x. a + x) ` S) = (\<lambda>x. a + x) ` (convex hull S)"
 21.3081    unfolding translation_eq_singleton_plus
 21.3082    by (simp only: convex_hull_set_plus convex_hull_singleton)
 21.3083  
 21.3084  lemma convex_hull_scaling:
 21.3085 -  "convex hull ((\<lambda>x. c *\<^sub>R x) ` s) = (\<lambda>x. c *\<^sub>R x) ` (convex hull s)"
 21.3086 -  by (simp add: convex_hull_linear_image)
 21.3087 +  "convex hull ((\<lambda>x. c *\<^sub>R x) ` S) = (\<lambda>x. c *\<^sub>R x) ` (convex hull S)"
 21.3088 +  using linear_scaleR by (rule convex_hull_linear_image [symmetric])
 21.3089  
 21.3090  lemma convex_hull_affinity:
 21.3091 -  "convex hull ((\<lambda>x. a + c *\<^sub>R x) ` s) = (\<lambda>x. a + c *\<^sub>R x) ` (convex hull s)"
 21.3092 +  "convex hull ((\<lambda>x. a + c *\<^sub>R x) ` S) = (\<lambda>x. a + c *\<^sub>R x) ` (convex hull S)"
 21.3093    by(simp only: image_image[symmetric] convex_hull_scaling convex_hull_translation)
 21.3094  
 21.3095  
 21.3096 @@ -6051,7 +5689,7 @@
 21.3097        using assms mem_convex_alt[of S xx yy cx cy] x y by auto
 21.3098      then have "cx *\<^sub>R xx + cy *\<^sub>R yy \<in> cone hull S"
 21.3099        using mem_cone_hull[of "(cx/(cx+cy)) *\<^sub>R xx + (cy/(cx+cy)) *\<^sub>R yy" S "cx+cy"] \<open>cx+cy>0\<close>
 21.3100 -      by (auto simp add: scaleR_right_distrib)
 21.3101 +      by (auto simp: scaleR_right_distrib)
 21.3102      then have "u *\<^sub>R x + v *\<^sub>R y \<in> cone hull S"
 21.3103        using x y by auto
 21.3104    }
 21.3105 @@ -6091,8 +5729,7 @@
 21.3106    fixes s :: "('a::euclidean_space) set"
 21.3107    assumes "closed s" "convex s"
 21.3108    shows "s = \<Inter>{h. s \<subseteq> h \<and> (\<exists>a b. h = {x. inner a x \<le> b})}"
 21.3109 -  apply (rule set_eqI)
 21.3110 -  apply rule
 21.3111 +  apply (rule set_eqI, rule)
 21.3112    unfolding Inter_iff Ball_def mem_Collect_eq
 21.3113    apply (rule,rule,erule conjE)
 21.3114  proof -
 21.3115 @@ -6105,8 +5742,7 @@
 21.3116      apply (drule separating_hyperplane_closed_point[OF assms(2,1)])
 21.3117      apply (erule exE)+
 21.3118      apply (erule_tac x="-a" in allE)
 21.3119 -    apply (erule_tac x="-b" in allE)
 21.3120 -    apply auto
 21.3121 +    apply (erule_tac x="-b" in allE, auto)
 21.3122      done
 21.3123  qed auto
 21.3124  
 21.3125 @@ -6124,7 +5760,7 @@
 21.3126    then show ?thesis
 21.3127      apply (rule_tac x="\<lambda>v. if v\<in>s then u v else 0" in exI)
 21.3128      unfolding if_smult scaleR_zero_left and sum.inter_restrict[OF assms(1), symmetric]
 21.3129 -    apply (auto simp add: Int_absorb1)
 21.3130 +    apply (auto simp: Int_absorb1)
 21.3131      done
 21.3132  qed
 21.3133  
 21.3134 @@ -6179,8 +5815,7 @@
 21.3135      next
 21.3136        case False
 21.3137        then have "sum u c \<le> sum (\<lambda>x. if x=v then u v else 0) c"
 21.3138 -        apply (rule_tac sum_mono)
 21.3139 -        apply auto
 21.3140 +        apply (rule_tac sum_mono, auto)
 21.3141          done
 21.3142        then show ?thesis
 21.3143          unfolding sum.delta[OF assms(1)] using uv(2) and \<open>u v < 0\<close> and uv(1) by auto
 21.3144 @@ -6190,20 +5825,18 @@
 21.3145    then have *: "sum u {x\<in>c. u x > 0} > 0"
 21.3146      unfolding less_le
 21.3147      apply (rule_tac conjI)
 21.3148 -    apply (rule_tac sum_nonneg)
 21.3149 -    apply auto
 21.3150 +    apply (rule_tac sum_nonneg, auto)
 21.3151      done
 21.3152    moreover have "sum u ({x \<in> c. 0 < u x} \<union> {x \<in> c. u x < 0}) = sum u c"
 21.3153      "(\<Sum>x\<in>{x \<in> c. 0 < u x} \<union> {x \<in> c. u x < 0}. u x *\<^sub>R x) = (\<Sum>x\<in>c. u x *\<^sub>R x)"
 21.3154      using assms(1)
 21.3155 -    apply (rule_tac[!] sum.mono_neutral_left)
 21.3156 -    apply auto
 21.3157 +    apply (rule_tac[!] sum.mono_neutral_left, auto)
 21.3158      done
 21.3159    then have "sum u {x \<in> c. 0 < u x} = - sum u {x \<in> c. 0 > u x}"
 21.3160      "(\<Sum>x\<in>{x \<in> c. 0 < u x}. u x *\<^sub>R x) = - (\<Sum>x\<in>{x \<in> c. 0 > u x}. u x *\<^sub>R x)"
 21.3161      unfolding eq_neg_iff_add_eq_0
 21.3162      using uv(1,4)
 21.3163 -    by (auto simp add: sum.union_inter_neutral[OF fin, symmetric])
 21.3164 +    by (auto simp: sum.union_inter_neutral[OF fin, symmetric])
 21.3165    moreover have "\<forall>x\<in>{v \<in> c. u v < 0}. 0 \<le> inverse (sum u {x \<in> c. 0 < u x}) * - u x"
 21.3166      apply rule
 21.3167      apply (rule mult_nonneg_nonneg)
 21.3168 @@ -6215,7 +5848,7 @@
 21.3169      apply (rule_tac x="{v \<in> c. u v < 0}" in exI)
 21.3170      apply (rule_tac x="\<lambda>y. inverse (sum u {x\<in>c. u x > 0}) * - u y" in exI)
 21.3171      using assms(1) unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] and z_def
 21.3172 -    apply (auto simp add: sum_negf sum_distrib_left[symmetric])
 21.3173 +    apply (auto simp: sum_negf sum_distrib_left[symmetric])
 21.3174      done
 21.3175    moreover have "\<forall>x\<in>{v \<in> c. 0 < u v}. 0 \<le> inverse (sum u {x \<in> c. 0 < u x}) * u x"
 21.3176      apply rule
 21.3177 @@ -6230,12 +5863,11 @@
 21.3178      using assms(1)
 21.3179      unfolding scaleR_scaleR[symmetric] scaleR_right.sum [symmetric] and z_def
 21.3180      using *
 21.3181 -    apply (auto simp add: sum_negf sum_distrib_left[symmetric])
 21.3182 +    apply (auto simp: sum_negf sum_distrib_left[symmetric])
 21.3183      done
 21.3184    ultimately show ?thesis
 21.3185      apply (rule_tac x="{v\<in>c. u v \<le> 0}" in exI)
 21.3186 -    apply (rule_tac x="{v\<in>c. u v > 0}" in exI)
 21.3187 -    apply auto
 21.3188 +    apply (rule_tac x="{v\<in>c. u v > 0}" in exI, auto)
 21.3189      done
 21.3190  qed
 21.3191  
 21.3192 @@ -6269,7 +5901,7 @@
 21.3193      and "\<forall>s\<in>f. convex s" "\<forall>t\<subseteq>f. card t = DIM('a) + 1 \<longrightarrow> \<Inter>t \<noteq> {}"
 21.3194    shows "\<Inter>f \<noteq> {}"
 21.3195    using assms
 21.3196 -proof (induct n arbitrary: f)
 21.3197 +proof (induction n arbitrary: f)
 21.3198    case 0
 21.3199    then show ?case by auto
 21.3200  next
 21.3201 @@ -6277,46 +5909,39 @@
 21.3202    have "finite f"
 21.3203      using \<open>card f = Suc n\<close> by (auto intro: card_ge_0_finite)
 21.3204    show "\<Inter>f \<noteq> {}"
 21.3205 -    apply (cases "n = DIM('a)")
 21.3206 -    apply (rule Suc(5)[rule_format])
 21.3207 -    unfolding \<open>card f = Suc n\<close>
 21.3208 -  proof -
 21.3209 -    assume ng: "n \<noteq> DIM('a)"
 21.3210 -    then have "\<exists>X. \<forall>s\<in>f. X s \<in> \<Inter>(f - {s})"
 21.3211 -      apply (rule_tac bchoice)
 21.3212 -      unfolding ex_in_conv
 21.3213 -      apply (rule, rule Suc(1)[rule_format])
 21.3214 -      unfolding card_Diff_singleton_if[OF \<open>finite f\<close>] \<open>card f = Suc n\<close>
 21.3215 -      defer
 21.3216 -      defer
 21.3217 -      apply (rule Suc(4)[rule_format])
 21.3218 -      defer
 21.3219 -      apply (rule Suc(5)[rule_format])
 21.3220 -      using Suc(3) \<open>finite f\<close>
 21.3221 -      apply auto
 21.3222 -      done
 21.3223 -    then obtain X where X: "\<forall>s\<in>f. X s \<in> \<Inter>(f - {s})" by auto
 21.3224 +  proof (cases "n = DIM('a)")
 21.3225 +    case True
 21.3226 +    then show ?thesis
 21.3227 +      by (simp add: Suc.prems(1) Suc.prems(4))
 21.3228 +  next
 21.3229 +    case False
 21.3230 +    have "\<Inter>(f - {s}) \<noteq> {}" if "s \<in> f" for s
 21.3231 +    proof (rule Suc.IH[rule_format])
 21.3232 +      show "card (f - {s}) = n"
 21.3233 +        by (simp add: Suc.prems(1) \<open>finite f\<close> that)
 21.3234 +      show "DIM('a) + 1 \<le> n"
 21.3235 +        using False Suc.prems(2) by linarith
 21.3236 +      show "\<And>t. \<lbrakk>t \<subseteq> f - {s}; card t = DIM('a) + 1\<rbrakk> \<Longrightarrow> \<Inter>t \<noteq> {}"
 21.3237 +        by (simp add: Suc.prems(4) subset_Diff_insert)
 21.3238 +    qed (use Suc in auto)
 21.3239 +    then have "\<forall>s\<in>f. \<exists>x. x \<in> \<Inter>(f - {s})"
 21.3240 +      by blast
 21.3241 +    then obtain X where X: "\<And>s. s\<in>f \<Longrightarrow> X s \<in> \<Inter>(f - {s})"
 21.3242 +      by metis
 21.3243      show ?thesis
 21.3244      proof (cases "inj_on X f")
 21.3245        case False
 21.3246 -      then obtain s t where st: "s\<noteq>t" "s\<in>f" "t\<in>f" "X s = X t"
 21.3247 +      then obtain s t where "s\<noteq>t" and st: "s\<in>f" "t\<in>f" "X s = X t"
 21.3248          unfolding inj_on_def by auto
 21.3249        then have *: "\<Inter>f = \<Inter>(f - {s}) \<inter> \<Inter>(f - {t})" by auto
 21.3250        show ?thesis
 21.3251 -        unfolding *
 21.3252 -        unfolding ex_in_conv[symmetric]
 21.3253 -        apply (rule_tac x="X s" in exI)
 21.3254 -        apply rule
 21.3255 -        apply (rule X[rule_format])
 21.3256 -        using X st
 21.3257 -        apply auto
 21.3258 -        done
 21.3259 +        by (metis "*" X disjoint_iff_not_equal st)
 21.3260      next
 21.3261        case True
 21.3262        then obtain m p where mp: "m \<inter> p = {}" "m \<union> p = X ` f" "convex hull m \<inter> convex hull p \<noteq> {}"
 21.3263          using radon_partition[of "X ` f"] and affine_dependent_biggerset[of "X ` f"]
 21.3264          unfolding card_image[OF True] and \<open>card f = Suc n\<close>
 21.3265 -        using Suc(3) \<open>finite f\<close> and ng
 21.3266 +        using Suc(3) \<open>finite f\<close> and False
 21.3267          by auto
 21.3268        have "m \<subseteq> X ` f" "p \<subseteq> X ` f"
 21.3269          using mp(2) by auto
 21.3270 @@ -6333,38 +5958,17 @@
 21.3271          using inj_on_image_Int[OF True gh(3,4)]
 21.3272          by auto
 21.3273        have "convex hull (X ` h) \<subseteq> \<Inter>g" "convex hull (X ` g) \<subseteq> \<Inter>h"
 21.3274 -        apply (rule_tac [!] hull_minimal)
 21.3275 -        using Suc gh(3-4)
 21.3276 -        unfolding subset_eq
 21.3277 -        apply (rule_tac [2] convex_Inter, rule_tac [4] convex_Inter)
 21.3278 -        apply rule
 21.3279 -        prefer 3
 21.3280 -        apply rule
 21.3281 -      proof -
 21.3282 -        fix x
 21.3283 -        assume "x \<in> X ` g"
 21.3284 -        then obtain y where "y \<in> g" "x = X y"
 21.3285 -          unfolding image_iff ..
 21.3286 -        then show "x \<in> \<Inter>h"
 21.3287 -          using X[THEN bspec[where x=y]] using * f by auto
 21.3288 -      next
 21.3289 -        fix x
 21.3290 -        assume "x \<in> X ` h"
 21.3291 -        then obtain y where "y \<in> h" "x = X y"
 21.3292 -          unfolding image_iff ..
 21.3293 -        then show "x \<in> \<Inter>g"
 21.3294 -          using X[THEN bspec[where x=y]] using * f by auto
 21.3295 -      qed auto
 21.3296 +        by (rule hull_minimal; use X * f in \<open>auto simp: Suc.prems(3) convex_Inter\<close>)+
 21.3297        then show ?thesis
 21.3298          unfolding f using mp(3)[unfolded gh] by blast
 21.3299      qed
 21.3300 -  qed auto
 21.3301 +  qed 
 21.3302  qed
 21.3303  
 21.3304  theorem%important helly:
 21.3305    fixes f :: "'a::euclidean_space set set"
 21.3306    assumes "card f \<ge> DIM('a) + 1" "\<forall>s\<in>f. convex s"
 21.3307 -    and "\<forall>t\<subseteq>f. card t = DIM('a) + 1 \<longrightarrow> \<Inter>t \<noteq> {}"
 21.3308 +    and "\<And>t. \<lbrakk>t\<subseteq>f; card t = DIM('a) + 1\<rbrakk> \<Longrightarrow> \<Inter>t \<noteq> {}"
 21.3309    shows "\<Inter>f \<noteq> {}"
 21.3310    apply%unimportant (rule helly_induct)
 21.3311    using assms
 21.3312 @@ -6374,104 +5978,109 @@
 21.3313  
 21.3314  subsection \<open>Epigraphs of convex functions\<close>
 21.3315  
 21.3316 -definition%important "epigraph s (f :: _ \<Rightarrow> real) = {xy. fst xy \<in> s \<and> f (fst xy) \<le> snd xy}"
 21.3317 -
 21.3318 -lemma mem_epigraph: "(x, y) \<in> epigraph s f \<longleftrightarrow> x \<in> s \<and> f x \<le> y"
 21.3319 +definition%important "epigraph S (f :: _ \<Rightarrow> real) = {xy. fst xy \<in> S \<and> f (fst xy) \<le> snd xy}"
 21.3320 +
 21.3321 +lemma mem_epigraph: "(x, y) \<in> epigraph S f \<longleftrightarrow> x \<in> S \<and> f x \<le> y"
 21.3322    unfolding epigraph_def by auto
 21.3323  
 21.3324 -lemma convex_epigraph: "convex (epigraph s f) \<longleftrightarrow> convex_on s f \<and> convex s"
 21.3325 -  unfolding convex_def convex_on_def
 21.3326 -  unfolding Ball_def split_paired_All epigraph_def
 21.3327 -  unfolding mem_Collect_eq fst_conv snd_conv fst_add snd_add fst_scaleR snd_scaleR Ball_def[symmetric]
 21.3328 -  apply safe
 21.3329 -  defer
 21.3330 -  apply (erule_tac x=x in allE)
 21.3331 -  apply (erule_tac x="f x" in allE)
 21.3332 -  apply safe
 21.3333 -  apply (erule_tac x=xa in allE)
 21.3334 -  apply (erule_tac x="f xa" in allE)
 21.3335 -  prefer 3
 21.3336 -  apply (rule_tac y="u * f a + v * f aa" in order_trans)
 21.3337 -  defer
 21.3338 -  apply (auto intro!:mult_left_mono add_mono)
 21.3339 -  done
 21.3340 -
 21.3341 -lemma convex_epigraphI: "convex_on s f \<Longrightarrow> convex s \<Longrightarrow> convex (epigraph s f)"
 21.3342 +lemma convex_epigraph: "convex (epigraph S f) \<longleftrightarrow> convex_on S f \<and> convex S"
 21.3343 +proof safe
 21.3344 +  assume L: "convex (epigraph S f)"
 21.3345 +  then show "convex_on S f"
 21.3346 +    by (auto simp: convex_def convex_on_def epigraph_def)
 21.3347 +  show "convex S"
 21.3348 +    using L
 21.3349 +    apply (clarsimp simp: convex_def convex_on_def epigraph_def)
 21.3350 +    apply (erule_tac x=x in allE)
 21.3351 +    apply (erule_tac x="f x" in allE, safe)
 21.3352 +    apply (erule_tac x=y in allE)
 21.3353 +    apply (erule_tac x="f y" in allE)
 21.3354 +    apply (auto simp: )
 21.3355 +    done
 21.3356 +next
 21.3357 +  assume "convex_on S f" "convex S"
 21.3358 +  then show "convex (epigraph S f)"
 21.3359 +    unfolding convex_def convex_on_def epigraph_def
 21.3360 +    apply safe
 21.3361 +     apply (rule_tac [2] y="u * f a + v * f aa" in order_trans)
 21.3362 +      apply (auto intro!:mult_left_mono add_mono)
 21.3363 +    done
 21.3364 +qed
 21.3365 +
 21.3366 +lemma convex_epigraphI: "convex_on S f \<Longrightarrow> convex S \<Longrightarrow> convex (epigraph S f)"
 21.3367    unfolding convex_epigraph by auto
 21.3368  
 21.3369 -lemma convex_epigraph_convex: "convex s \<Longrightarrow> convex_on s f \<longleftrightarrow> convex(epigraph s f)"
 21.3370 +lemma convex_epigraph_convex: "convex S \<Longrightarrow> convex_on S f \<longleftrightarrow> convex(epigraph S f)"
 21.3371    by (simp add: convex_epigraph)
 21.3372  
 21.3373  
 21.3374  subsubsection%unimportant \<open>Use this to derive general bound property of convex function\<close>
 21.3375  
 21.3376  lemma convex_on:
 21.3377 -  assumes "convex s"
 21.3378 -  shows "convex_on s f \<longleftrightarrow>
 21.3379 -    (\<forall>k u x. (\<forall>i\<in>{1..k::nat}. 0 \<le> u i \<and> x i \<in> s) \<and> sum u {1..k} = 1 \<longrightarrow>
 21.3380 -      f (sum (\<lambda>i. u i *\<^sub>R x i) {1..k} ) \<le> sum (\<lambda>i. u i * f(x i)) {1..k})"
 21.3381 +  assumes "convex S"
 21.3382 +  shows "convex_on S f \<longleftrightarrow>
 21.3383 +    (\<forall>k u x. (\<forall>i\<in>{1..k::nat}. 0 \<le> u i \<and> x i \<in> S) \<and> sum u {1..k} = 1 \<longrightarrow>
 21.3384 +      f (sum (\<lambda>i. u i *\<^sub>R x i) {1..k}) \<le> sum (\<lambda>i. u i * f(x i)) {1..k})"
 21.3385 +
 21.3386    unfolding convex_epigraph_convex[OF assms] convex epigraph_def Ball_def mem_Collect_eq
 21.3387    unfolding fst_sum snd_sum fst_scaleR snd_scaleR
 21.3388    apply safe
 21.3389 -  apply (drule_tac x=k in spec)
 21.3390 -  apply (drule_tac x=u in spec)
 21.3391 -  apply (drule_tac x="\<lambda>i. (x i, f (x i))" in spec)
 21.3392 -  apply simp
 21.3393 -  using assms[unfolded convex]
 21.3394 -  apply simp
 21.3395 -  apply (rule_tac y="\<Sum>i = 1..k. u i * f (fst (x i))" in order_trans)
 21.3396 -  defer
 21.3397 -  apply (rule sum_mono)
 21.3398 -  apply (erule_tac x=i in allE)
 21.3399 +    apply (drule_tac x=k in spec)
 21.3400 +    apply (drule_tac x=u in spec)
 21.3401 +    apply (drule_tac x="\<lambda>i. (x i, f (x i))" in spec)
 21.3402 +    apply simp
 21.3403 +  using assms[unfolded convex] apply simp
 21.3404 +  apply (rule_tac y="\<Sum>i = 1..k. u i * f (fst (x i))" in order_trans, force)
 21.3405 +   apply (rule sum_mono)
 21.3406 +   apply (erule_tac x=i in allE)
 21.3407    unfolding real_scaleR_def
 21.3408 -  apply (rule mult_left_mono)
 21.3409 -  using assms[unfolded convex]
 21.3410 -  apply auto
 21.3411 +   apply (rule mult_left_mono)
 21.3412 +  using assms[unfolded convex] apply auto
 21.3413    done
 21.3414  
 21.3415  
 21.3416  subsection%unimportant \<open>Convexity of general and special intervals\<close>
 21.3417  
 21.3418  lemma is_interval_convex:
 21.3419 -  fixes s :: "'a::euclidean_space set"
 21.3420 -  assumes "is_interval s"
 21.3421 -  shows "convex s"
 21.3422 +  fixes S :: "'a::euclidean_space set"
 21.3423 +  assumes "is_interval S"
 21.3424 +  shows "convex S"
 21.3425  proof (rule convexI)
 21.3426    fix x y and u v :: real
 21.3427 -  assume as: "x \<in> s" "y \<in> s" "0 \<le> u" "0 \<le> v" "u + v = 1"
 21.3428 +  assume as: "x \<in> S" "y \<in> S" "0 \<le> u" "0 \<le> v" "u + v = 1"
 21.3429    then have *: "u = 1 - v" "1 - v \<ge> 0" and **: "v = 1 - u" "1 - u \<ge> 0"
 21.3430      by auto
 21.3431    {
 21.3432      fix a b
 21.3433      assume "\<not> b \<le> u * a + v * b"
 21.3434      then have "u * a < (1 - v) * b"
 21.3435 -      unfolding not_le using as(4) by (auto simp add: field_simps)
 21.3436 +      unfolding not_le using as(4) by (auto simp: field_simps)
 21.3437      then have "a < b"
 21.3438        unfolding * using as(4) *(2)
 21.3439        apply (rule_tac mult_left_less_imp_less[of "1 - v"])
 21.3440 -      apply (auto simp add: field_simps)
 21.3441 +      apply (auto simp: field_simps)
 21.3442        done
 21.3443      then have "a \<le> u * a + v * b"
 21.3444        unfolding * using as(4)
 21.3445 -      by (auto simp add: field_simps intro!:mult_right_mono)
 21.3446 +      by (auto simp: field_simps intro!:mult_right_mono)
 21.3447    }
 21.3448    moreover
 21.3449    {
 21.3450      fix a b
 21.3451      assume "\<not> u * a + v * b \<le> a"
 21.3452      then have "v * b > (1 - u) * a"
 21.3453 -      unfolding not_le using as(4) by (auto simp add: field_simps)
 21.3454 +      unfolding not_le using as(4) by (auto simp: field_simps)
 21.3455      then have "a < b"
 21.3456        unfolding * using as(4)
 21.3457        apply (rule_tac mult_left_less_imp_less)
 21.3458 -      apply (auto simp add: field_simps)
 21.3459 +      apply (auto simp: field_simps)
 21.3460        done
 21.3461      then have "u * a + v * b \<le> b"
 21.3462        unfolding **
 21.3463        using **(2) as(3)
 21.3464 -      by (auto simp add: field_simps intro!:mult_right_mono)
 21.3465 +      by (auto simp: field_simps intro!:mult_right_mono)
 21.3466    }
 21.3467 -  ultimately show "u *\<^sub>R x + v *\<^sub>R y \<in> s"
 21.3468 +  ultimately show "u *\<^sub>R x + v *\<^sub>R y \<in> S"
 21.3469      apply -
 21.3470      apply (rule assms[unfolded is_interval_def, rule_format, OF as(1,2)])
 21.3471      using as(3-) DIM_positive[where 'a='a]
 21.3472 @@ -6480,8 +6089,8 @@
 21.3473  qed
 21.3474  
 21.3475  lemma is_interval_connected:
 21.3476 -  fixes s :: "'a::euclidean_space set"
 21.3477 -  shows "is_interval s \<Longrightarrow> connected s"
 21.3478 +  fixes S :: "'a::euclidean_space set"
 21.3479 +  shows "is_interval S \<Longrightarrow> connected S"
 21.3480    using is_interval_convex convex_connected by auto
 21.3481  
 21.3482  lemma convex_box [simp]: "convex (cbox a b)" "convex (box a (b::'a::euclidean_space))"
 21.3483 @@ -6556,12 +6165,9 @@
 21.3484    ultimately show False
 21.3485      apply (rule_tac notE[OF as(1)[unfolded connected_def]])
 21.3486      apply (rule_tac x = ?halfl in exI)
 21.3487 -    apply (rule_tac x = ?halfr in exI)
 21.3488 -    apply rule
 21.3489 -    apply (rule open_lessThan)
 21.3490 -    apply rule
 21.3491 -    apply (rule open_greaterThan)
 21.3492 -    apply auto
 21.3493 +    apply (rule_tac x = ?halfr in exI, rule)
 21.3494 +    apply (rule open_lessThan, rule)
 21.3495 +    apply (rule open_greaterThan, auto)
 21.3496      done
 21.3497  qed
 21.3498  
 21.3499 @@ -6625,7 +6231,7 @@
 21.3500    fixes f :: "real \<Rightarrow> 'a::euclidean_space"
 21.3501    shows "a \<le> b \<Longrightarrow> \<forall>x\<in>{a..b}. continuous (at x) f \<Longrightarrow>
 21.3502      f a\<bullet>k \<le> y \<Longrightarrow> y \<le> f b\<bullet>k \<Longrightarrow> \<exists>x\<in>{a..b}. (f x)\<bullet>k = y"
 21.3503 -  by (rule ivt_increasing_component_on_1) (auto simp add: continuous_at_imp_continuous_on)
 21.3504 +  by (rule ivt_increasing_component_on_1) (auto simp: continuous_at_imp_continuous_on)
 21.3505  
 21.3506  lemma ivt_decreasing_component_on_1:
 21.3507    fixes f :: "real \<Rightarrow> 'a::euclidean_space"
 21.3508 @@ -6699,40 +6305,22 @@
 21.3509    assumes "finite A" and "\<forall>i\<in>A. finite (B i)" shows "finite (\<Sum>i\<in>A. B i)"
 21.3510    using assms by (induct set: finite, simp, simp add: finite_set_plus)
 21.3511  
 21.3512 -lemma set_sum_eq:
 21.3513 -  "finite A \<Longrightarrow> (\<Sum>i\<in>A. B i) = {\<Sum>i\<in>A. f i |f. \<forall>i\<in>A. f i \<in> B i}"
 21.3514 -  apply (induct set: finite)
 21.3515 -  apply simp
 21.3516 -  apply simp
 21.3517 -  apply (safe elim!: set_plus_elim)
 21.3518 -  apply (rule_tac x="fun_upd f x a" in exI)
 21.3519 -  apply simp
 21.3520 -  apply (rule_tac f="\<lambda>x. a + x" in arg_cong)
 21.3521 -  apply (rule sum.cong [OF refl])
 21.3522 -  apply clarsimp
 21.3523 -  apply fast
 21.3524 -  done
 21.3525 -
 21.3526  lemma box_eq_set_sum_Basis:
 21.3527    shows "{x. \<forall>i\<in>Basis. x\<bullet>i \<in> B i} = (\<Sum>i\<in>Basis. image (\<lambda>x. x *\<^sub>R i) (B i))"
 21.3528 -  apply (subst set_sum_eq [OF finite_Basis])
 21.3529 -  apply safe
 21.3530 +  apply (subst set_sum_alt [OF finite_Basis], safe)
 21.3531    apply (fast intro: euclidean_representation [symmetric])
 21.3532    apply (subst inner_sum_left)
 21.3533 +apply (rename_tac f)
 21.3534    apply (subgoal_tac "(\<Sum>x\<in>Basis. f x \<bullet> i) = f i \<bullet> i")
 21.3535    apply (drule (1) bspec)
 21.3536    apply clarsimp
 21.3537    apply (frule sum.remove [OF finite_Basis])
 21.3538 -  apply (erule trans)
 21.3539 -  apply simp
 21.3540 -  apply (rule sum.neutral)
 21.3541 -  apply clarsimp
 21.3542 +  apply (erule trans, simp)
 21.3543 +  apply (rule sum.neutral, clarsimp)
 21.3544    apply (frule_tac x=i in bspec, assumption)
 21.3545 -  apply (drule_tac x=x in bspec, assumption)
 21.3546 -  apply clarsimp
 21.3547 +  apply (drule_tac x=x in bspec, assumption, clarsimp)
 21.3548    apply (cut_tac u=x and v=i in inner_Basis, assumption+)
 21.3549 -  apply (rule ccontr)
 21.3550 -  apply simp
 21.3551 +  apply (rule ccontr, simp)
 21.3552    done
 21.3553  
 21.3554  lemma convex_hull_set_sum:
 21.3555 @@ -6750,8 +6338,8 @@
 21.3556    show "convex (cbox x y)"
 21.3557      by (rule convex_box)
 21.3558  next
 21.3559 -  fix s assume "{x, y} \<subseteq> s" and "convex s"
 21.3560 -  then show "cbox x y \<subseteq> s"
 21.3561 +  fix S assume "{x, y} \<subseteq> S" and "convex S"
 21.3562 +  then show "cbox x y \<subseteq> S"
 21.3563      unfolding is_interval_convex_1 [symmetric] is_interval_def Basis_real_def
 21.3564      by - (clarify, simp (no_asm_use), fast)
 21.3565  qed
 21.3566 @@ -6782,74 +6370,53 @@
 21.3567  text \<open>And this is a finite set of vertices.\<close>
 21.3568  
 21.3569  lemma unit_cube_convex_hull:
 21.3570 -  obtains s :: "'a::euclidean_space set"
 21.3571 -    where "finite s" and "cbox 0 (\<Sum>Basis) = convex hull s"
 21.3572 -  apply (rule that[of "{x::'a. \<forall>i\<in>Basis. x\<bullet>i=0 \<or> x\<bullet>i=1}"])
 21.3573 -  apply (rule finite_subset[of _ "(\<lambda>s. (\<Sum>i\<in>Basis. (if i\<in>s then 1 else 0) *\<^sub>R i)::'a) ` Pow Basis"])
 21.3574 -  prefer 3
 21.3575 -  apply (rule unit_interval_convex_hull)
 21.3576 -  apply rule
 21.3577 -  unfolding mem_Collect_eq
 21.3578 -proof -
 21.3579 -  fix x :: 'a
 21.3580 -  assume as: "\<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1"
 21.3581 -  show "x \<in> (\<lambda>s. \<Sum>i\<in>Basis. (if i\<in>s then 1 else 0) *\<^sub>R i) ` Pow Basis"
 21.3582 -    apply (rule image_eqI[where x="{i. i\<in>Basis \<and> x\<bullet>i = 1}"])
 21.3583 -    using as
 21.3584 -    apply (subst euclidean_eq_iff)
 21.3585 -    apply auto
 21.3586 -    done
 21.3587 -qed auto
 21.3588 +  obtains S :: "'a::euclidean_space set"
 21.3589 +  where "finite S" and "cbox 0 (\<Sum>Basis) = convex hull S"
 21.3590 +proof
 21.3591 +  show "finite {x::'a. \<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1}"
 21.3592 +  proof (rule finite_subset, clarify)
 21.3593 +    show "finite ((\<lambda>S. \<Sum>i\<in>Basis. (if i \<in> S then 1 else 0) *\<^sub>R i) ` Pow Basis)"
 21.3594 +      using finite_Basis by blast
 21.3595 +    fix x :: 'a
 21.3596 +    assume as: "\<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1"
 21.3597 +    show "x \<in> (\<lambda>S. \<Sum>i\<in>Basis. (if i\<in>S then 1 else 0) *\<^sub>R i) ` Pow Basis"
 21.3598 +      apply (rule image_eqI[where x="{i. i\<in>Basis \<and> x\<bullet>i = 1}"])
 21.3599 +      using as
 21.3600 +       apply (subst euclidean_eq_iff, auto)
 21.3601 +      done
 21.3602 +  qed
 21.3603 +  show "cbox 0 One = convex hull {x. \<forall>i\<in>Basis. x \<bullet> i = 0 \<or> x \<bullet> i = 1}"
 21.3604 +    using unit_interval_convex_hull by blast
 21.3605 +qed 
 21.3606  
 21.3607  text \<open>Hence any cube (could do any nonempty interval).\<close>
 21.3608  
 21.3609  lemma cube_convex_hull:
 21.3610    assumes "d > 0"
 21.3611 -  obtains s :: "'a::euclidean_space set" where
 21.3612 -    "finite s" and "cbox (x - (\<Sum>i\<in>Basis. d*\<^sub>Ri)) (x + (\<Sum>i\<in>Basis. d*\<^sub>Ri)) = convex hull s"
 21.3613 +  obtains S :: "'a::euclidean_space set" where
 21.3614 +    "finite S" and "cbox (x - (\<Sum>i\<in>Basis. d*\<^sub>Ri)) (x + (\<Sum>i\<in>Basis. d*\<^sub>Ri)) = convex hull S"
 21.3615  proof -
 21.3616 -  let ?d = "(\<Sum>i\<in>Basis. d*\<^sub>Ri)::'a"
 21.3617 +  let ?d = "(\<Sum>i\<in>Basis. d *\<^sub>R i)::'a"
 21.3618    have *: "cbox (x - ?d) (x + ?d) = (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` cbox 0 (\<Sum>Basis)"
 21.3619 -    apply (rule set_eqI, rule)
 21.3620 -    unfolding image_iff
 21.3621 -    defer
 21.3622 -    apply (erule bexE)
 21.3623 -  proof -
 21.3624 +  proof (intro set_eqI iffI)
 21.3625      fix y
 21.3626 -    assume as: "y\<in>cbox (x - ?d) (x + ?d)"
 21.3627 +    assume "y \<in> cbox (x - ?d) (x + ?d)"
 21.3628      then have "inverse (2 * d) *\<^sub>R (y - (x - ?d)) \<in> cbox 0 (\<Sum>Basis)"
 21.3629        using assms by (simp add: mem_box field_simps inner_simps)
 21.3630 -    with \<open>0 < d\<close> show "\<exists>z\<in>cbox 0 (\<Sum>Basis). y = x - ?d + (2 * d) *\<^sub>R z"
 21.3631 -      by (intro bexI[of _ "inverse (2 * d) *\<^sub>R (y - (x - ?d))"]) auto
 21.3632 +    with \<open>0 < d\<close> show "y \<in> (\<lambda>y. x - sum (( *\<^sub>R) d) Basis + (2 * d) *\<^sub>R y) ` cbox 0 One"
 21.3633 +      by (auto intro: image_eqI[where x= "inverse (2 * d) *\<^sub>R (y - (x - ?d))"])
 21.3634    next
 21.3635 -    fix y z
 21.3636 -    assume as: "z\<in>cbox 0 (\<Sum>Basis)" "y = x - ?d + (2*d) *\<^sub>R z"
 21.3637 -    have "\<And>i. i\<in>Basis \<Longrightarrow> 0 \<le> d * (z \<bullet> i) \<and> d * (z \<bullet> i) \<le> d"
 21.3638 -      using assms as(1)[unfolded mem_box]
 21.3639 -      apply (erule_tac x=i in ballE)
 21.3640 -      apply rule
 21.3641 -      prefer 2
 21.3642 -      apply (rule mult_right_le_one_le)
 21.3643 -      using assms
 21.3644 -      apply auto
 21.3645 -      done
 21.3646 +    fix y
 21.3647 +    assume "y \<in> (\<lambda>y. x - ?d + (2 * d) *\<^sub>R y) ` cbox 0 One"
 21.3648 +    then obtain z where z: "z \<in> cbox 0 One" "y = x - ?d + (2*d) *\<^sub>R z"
 21.3649 +      by auto
 21.3650      then show "y \<in> cbox (x - ?d) (x + ?d)"
 21.3651 -      unfolding as(2) mem_box
 21.3652 -      apply -
 21.3653 -      apply rule
 21.3654 -      using as(1)[unfolded mem_box]
 21.3655 -      apply (erule_tac x=i in ballE)
 21.3656 -      using assms
 21.3657 -      apply (auto simp: inner_simps)
 21.3658 -      done
 21.3659 +      using z assms by (auto simp: mem_box inner_simps)
 21.3660    qed
 21.3661 -  obtain s where "finite s" "cbox 0 (\<Sum>Basis::'a) = convex hull s"
 21.3662 +  obtain S where "finite S" "cbox 0 (\<Sum>Basis::'a) = convex hull S"
 21.3663      using unit_cube_convex_hull by auto
 21.3664    then show ?thesis
 21.3665 -    apply (rule_tac that[of "(\<lambda>y. x - ?d + (2 * d) *\<^sub>R y)` s"])
 21.3666 -    unfolding * and convex_hull_affinity
 21.3667 -    apply auto
 21.3668 -    done
 21.3669 +    by (rule_tac that[of "(\<lambda>y. x - ?d + (2 * d) *\<^sub>R y)` S"]) (auto simp: convex_hull_affinity *)
 21.3670  qed
 21.3671  
 21.3672  subsection%unimportant\<open>Representation of any interval as a finite convex hull\<close>
 21.3673 @@ -6877,13 +6444,13 @@
 21.3674      next
 21.3675        case False
 21.3676        then have *: "\<And>a b. a = m i * b \<longleftrightarrow> b = a / m i"
 21.3677 -        by (auto simp add: field_simps)
 21.3678 +        by (auto simp: field_simps)
 21.3679        from False have
 21.3680            "min (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) = (if 0 < m i then m i * (a \<bullet> i) else m i * (b \<bullet> i))"
 21.3681            "max (m i * (a \<bullet> i)) (m i * (b \<bullet> i)) = (if 0 < m i then m i * (b \<bullet> i) else m i * (a \<bullet> i))"
 21.3682          using a_le_b by (auto simp: min_def max_def mult_le_cancel_left)
 21.3683        with False show ?thesis using a_le_b
 21.3684 -        unfolding * by (auto simp add: le_divide_eq divide_le_eq ac_simps)
 21.3685 +        unfolding * by (auto simp: le_divide_eq divide_le_eq ac_simps)
 21.3686      qed
 21.3687    qed
 21.3688  qed simp
 21.3689 @@ -6895,7 +6462,7 @@
 21.3690  lemma cbox_translation: "cbox (c + a) (c + b) = image (\<lambda>x. c + x) (cbox a b)"
 21.3691    using image_affinity_cbox [of 1 c a b]
 21.3692    using box_ne_empty [of "a+c" "b+c"]  box_ne_empty [of a b]
 21.3693 -  by (auto simp add: inner_left_distrib add.commute)
 21.3694 +  by (auto simp: inner_left_distrib add.commute)
 21.3695  
 21.3696  lemma cbox_image_unit_interval:
 21.3697    fixes a :: "'a::euclidean_space"
 21.3698 @@ -6909,18 +6476,18 @@
 21.3699  
 21.3700  lemma closed_interval_as_convex_hull:
 21.3701    fixes a :: "'a::euclidean_space"
 21.3702 -  obtains s where "finite s" "cbox a b = convex hull s"
 21.3703 +  obtains S where "finite S" "cbox a b = convex hull S"
 21.3704  proof (cases "cbox a b = {}")
 21.3705    case True with convex_hull_empty that show ?thesis
 21.3706      by blast
 21.3707  next
 21.3708    case False
 21.3709 -  obtain s::"'a set" where "finite s" and eq: "cbox 0 One = convex hull s"
 21.3710 +  obtain S::"'a set" where "finite S" and eq: "cbox 0 One = convex hull S"
 21.3711      by (blast intro: unit_cube_convex_hull)
 21.3712    have lin: "linear (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k)"
 21.3713      by (rule linear_compose_sum) (auto simp: algebra_simps linearI)
 21.3714 -  have "finite ((+) a ` (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k) ` s)"
 21.3715 -    by (rule finite_imageI \<open>finite s\<close>)+
 21.3716 +  have "finite ((+) a ` (\<lambda>x. \<Sum>k\<in>Basis. ((b \<bullet> k - a \<bullet> k) * (x \<bullet> k)) *\<^sub>R k) ` S)"
 21.3717 +    by (rule finite_imageI \<open>finite S\<close>)+
 21.3718    then show ?thesis
 21.3719      apply (rule that)
 21.3720      apply (simp add: convex_hull_translation convex_hull_linear_image [OF lin, symmetric])
 21.3721 @@ -6932,31 +6499,23 @@
 21.3722  subsection%unimportant \<open>Bounded convex function on open set is continuous\<close>
 21.3723  
 21.3724  lemma convex_on_bounded_continuous:
 21.3725 -  fixes s :: "('a::real_normed_vector) set"
 21.3726 -  assumes "open s"
 21.3727 -    and "convex_on s f"
 21.3728 -    and "\<forall>x\<in>s. \<bar>f x\<bar> \<le> b"
 21.3729 -  shows "continuous_on s f"
 21.3730 +  fixes S :: "('a::real_normed_vector) set"
 21.3731 +  assumes "open S"
 21.3732 +    and "convex_on S f"
 21.3733 +    and "\<forall>x\<in>S. \<bar>f x\<bar> \<le> b"
 21.3734 +  shows "continuous_on S f"
 21.3735    apply (rule continuous_at_imp_continuous_on)
 21.3736    unfolding continuous_at_real_range
 21.3737  proof (rule,rule,rule)
 21.3738    fix x and e :: real
 21.3739 -  assume "x \<in> s" "e > 0"
 21.3740 +  assume "x \<in> S" "e > 0"
 21.3741    define B where "B = \<bar>b\<bar> + 1"
 21.3742 -  have B: "0 < B" "\<And>x. x\<in>s \<Longrightarrow> \<bar>f x\<bar> \<le> B"
 21.3743 -    unfolding B_def
 21.3744 -    defer
 21.3745 -    apply (drule assms(3)[rule_format])
 21.3746 -    apply auto
 21.3747 -    done
 21.3748 -  obtain k where "k > 0" and k: "cball x k \<subseteq> s"
 21.3749 -    using assms(1)[unfolded open_contains_cball, THEN bspec[where x=x]]
 21.3750 -    using \<open>x\<in>s\<close> by auto
 21.3751 +  then have B:  "0 < B""\<And>x. x\<in>S \<Longrightarrow> \<bar>f x\<bar> \<le> B"
 21.3752 +    using assms(3) by auto 
 21.3753 +  obtain k where "k > 0" and k: "cball x k \<subseteq> S"
 21.3754 +    using \<open>x \<in> S\<close> assms(1) open_contains_cball_eq by blast
 21.3755    show "\<exists>d>0. \<forall>x'. norm (x' - x) < d \<longrightarrow> \<bar>f x' - f x\<bar> < e"
 21.3756 -    apply (rule_tac x="min (k / 2) (e / (2 * B) * k)" in exI)
 21.3757 -    apply rule
 21.3758 -    defer
 21.3759 -  proof (rule, rule)
 21.3760 +  proof (intro exI conjI allI impI)
 21.3761      fix y
 21.3762      assume as: "norm (y - x) < min (k / 2) (e / (2 * B) * k)"
 21.3763      show "\<bar>f y - f x\<bar> < e"
 21.3764 @@ -6965,79 +6524,63 @@
 21.3765        define t where "t = k / norm (y - x)"
 21.3766        have "2 < t" "0<t"
 21.3767          unfolding t_def using as False and \<open>k>0\<close>
 21.3768 -        by (auto simp add:field_simps)
 21.3769 -      have "y \<in> s"
 21.3770 -        apply (rule k[unfolded subset_eq,rule_format])
 21.3771 +        by (auto simp:field_simps)
 21.3772 +      have "y \<in> S"
 21.3773 +        apply (rule k[THEN subsetD])
 21.3774          unfolding mem_cball dist_norm
 21.3775          apply (rule order_trans[of _ "2 * norm (x - y)"])
 21.3776          using as
 21.3777 -        by (auto simp add: field_simps norm_minus_commute)
 21.3778 +        by (auto simp: field_simps norm_minus_commute)
 21.3779        {
 21.3780          define w where "w = x + t *\<^sub>R (y - x)"
 21.3781 -        have "w \<in> s"
 21.3782 -          unfolding w_def
 21.3783 -          apply (rule k[unfolded subset_eq,rule_format])
 21.3784 -          unfolding mem_cball dist_norm
 21.3785 -          unfolding t_def
 21.3786 -          using \<open>k>0\<close>
 21.3787 -          apply auto
 21.3788 -          done
 21.3789 +        have "w \<in> S"
 21.3790 +          using \<open>k>0\<close> by (auto simp: dist_norm t_def w_def k[THEN subsetD])
 21.3791          have "(1 / t) *\<^sub>R x + - x + ((t - 1) / t) *\<^sub>R x = (1 / t - 1 + (t - 1) / t) *\<^sub>R x"
 21.3792 -          by (auto simp add: algebra_simps)
 21.3793 +          by (auto simp: algebra_simps)
 21.3794          also have "\<dots> = 0"
 21.3795 -          using \<open>t > 0\<close> by (auto simp add:field_simps)
 21.3796 +          using \<open>t > 0\<close> by (auto simp:field_simps)
 21.3797          finally have w: "(1 / t) *\<^sub>R w + ((t - 1) / t) *\<^sub>R x = y"
 21.3798            unfolding w_def using False and \<open>t > 0\<close>
 21.3799 -          by (auto simp add: algebra_simps)
 21.3800 -        have  "2 * B < e * t"
 21.3801 +          by (auto simp: algebra_simps)
 21.3802 +        have 2: "2 * B < e * t"
 21.3803            unfolding t_def using \<open>0 < e\<close> \<open>0 < k\<close> \<open>B > 0\<close> and as and False
 21.3804 -          by (auto simp add:field_simps)
 21.3805 -        then have "(f w - f x) / t < e"
 21.3806 -          using B(2)[OF \<open>w\<in>s\<close>] and B(2)[OF \<open>x\<in>s\<close>]
 21.3807 -          using \<open>t > 0\<close> by (auto simp add:field_simps)
 21.3808 -        then have th1: "f y - f x < e"
 21.3809 -          apply -
 21.3810 -          apply (rule le_less_trans)
 21.3811 -          defer
 21.3812 -          apply assumption
 21.3813 +          by (auto simp:field_simps)
 21.3814 +        have "f y - f x \<le> (f w - f x) / t"
 21.3815            using assms(2)[unfolded convex_on_def,rule_format,of w x "1/t" "(t - 1)/t", unfolded w]
 21.3816 -          using \<open>0 < t\<close> \<open>2 < t\<close> and \<open>x \<in> s\<close> \<open>w \<in> s\<close>
 21.3817 -          by (auto simp add:field_simps)
 21.3818 +          using \<open>0 < t\<close> \<open>2 < t\<close> and \<open>x \<in> S\<close> \<open>w \<in> S\<close>
 21.3819 +          by (auto simp:field_simps)
 21.3820 +        also have "... < e"
 21.3821 +          using B(2)[OF \<open>w\<in>S\<close>] and B(2)[OF \<open>x\<in>S\<close>] 2 \<open>t > 0\<close> by (auto simp: field_simps)
 21.3822 +        finally have th1: "f y - f x < e" .
 21.3823        }
 21.3824        moreover
 21.3825        {
 21.3826          define w where "w = x - t *\<^sub>R (y - x)"
 21.3827 -        have "w \<in> s"
 21.3828 -          unfolding w_def
 21.3829 -          apply (rule k[unfolded subset_eq,rule_format])
 21.3830 -          unfolding mem_cball dist_norm
 21.3831 -          unfolding t_def
 21.3832 -          using \<open>k > 0\<close>
 21.3833 -          apply auto
 21.3834 -          done
 21.3835 +        have "w \<in> S"
 21.3836 +          using \<open>k > 0\<close> by (auto simp: dist_norm t_def w_def k[THEN subsetD])
 21.3837          have "(1 / (1 + t)) *\<^sub>R x + (t / (1 + t)) *\<^sub>R x = (1 / (1 + t) + t / (1 + t)) *\<^sub>R x"
 21.3838 -          by (auto simp add: algebra_simps)
 21.3839 +          by (auto simp: algebra_simps)
 21.3840          also have "\<dots> = x"
 21.3841 -          using \<open>t > 0\<close> by (auto simp add:field_simps)
 21.3842 +          using \<open>t > 0\<close> by (auto simp:field_simps)
 21.3843          finally have w: "(1 / (1+t)) *\<^sub>R w + (t / (1 + t)) *\<^sub>R y = x"
 21.3844            unfolding w_def using False and \<open>t > 0\<close>
 21.3845 -          by (auto simp add: algebra_simps)
 21.3846 +          by (auto simp: algebra_simps)
 21.3847          have "2 * B < e * t"
 21.3848            unfolding t_def
 21.3849            using \<open>0 < e\<close> \<open>0 < k\<close> \<open>B > 0\<close> and as and False
 21.3850 -          by (auto simp add:field_simps)
 21.3851 +          by (auto simp:field_simps)
 21.3852          then have *: "(f w - f y) / t < e"
 21.3853 -          using B(2)[OF \<open>w\<in>s\<close>] and B(2)[OF \<open>y\<in>s\<close>]
 21.3854 +          using B(2)[OF \<open>w\<in>S\<close>] and B(2)[OF \<open>y\<in>S\<close>]
 21.3855            using \<open>t > 0\<close>
 21.3856 -          by (auto simp add:field_simps)
 21.3857 +          by (auto simp:field_simps)
 21.3858          have "f x \<le> 1 / (1 + t) * f w + (t / (1 + t)) * f y"
 21.3859            using assms(2)[unfolded convex_on_def,rule_format,of w y "1/(1+t)" "t / (1+t)",unfolded w]
 21.3860 -          using \<open>0 < t\<close> \<open>2 < t\<close> and \<open>y \<in> s\<close> \<open>w \<in> s\<close>
 21.3861 -          by (auto simp add:field_simps)
 21.3862 +          using \<open>0 < t\<close> \<open>2 < t\<close> and \<open>y \<in> S\<close> \<open>w \<in> S\<close>
 21.3863 +          by (auto simp:field_simps)
 21.3864          also have "\<dots> = (f w + t * f y) / (1 + t)"
 21.3865 -          using \<open>t > 0\<close> by (auto simp add: divide_simps)
 21.3866 +          using \<open>t > 0\<close> by (auto simp: divide_simps)
 21.3867          also have "\<dots> < e + f y"
 21.3868 -          using \<open>t > 0\<close> * \<open>e > 0\<close> by (auto simp add: field_simps)
 21.3869 +          using \<open>t > 0\<close> * \<open>e > 0\<close> by (auto simp: field_simps)
 21.3870          finally have "f x - f y < e" by auto
 21.3871        }
 21.3872        ultimately show ?thesis by auto
 21.3873 @@ -7062,13 +6605,13 @@
 21.3874    have *: "x - (2 *\<^sub>R x - y) = y - x"
 21.3875      by (simp add: scaleR_2)
 21.3876    have z: "z \<in> cball x e"
 21.3877 -    using y unfolding z_def mem_cball dist_norm * by (auto simp add: norm_minus_commute)
 21.3878 +    using y unfolding z_def mem_cball dist_norm * by (auto simp: norm_minus_commute)
 21.3879    have "(1 / 2) *\<^sub>R y + (1 / 2) *\<^sub>R z = x"
 21.3880 -    unfolding z_def by (auto simp add: algebra_simps)
 21.3881 +    unfolding z_def by (auto simp: algebra_simps)
 21.3882    then show "\<bar>f y\<bar> \<le> b + 2 * \<bar>f x\<bar>"
 21.3883      using assms(1)[unfolded convex_on_def,rule_format, OF y z, of "1/2" "1/2"]
 21.3884      using assms(2)[rule_format,OF y] assms(2)[rule_format,OF z]
 21.3885 -    by (auto simp add:field_simps)
 21.3886 +    by (auto simp:field_simps)
 21.3887  next
 21.3888    case False
 21.3889    fix y
 21.3890 @@ -7121,12 +6664,7 @@
 21.3891        by (simp add: dist_norm abs_le_iff algebra_simps)
 21.3892      show "cball x d \<subseteq> convex hull c"
 21.3893        unfolding 2
 21.3894 -      apply clarsimp
 21.3895 -      apply (simp only: dist_norm)
 21.3896 -      apply (subst inner_diff_left [symmetric])
 21.3897 -      apply simp
 21.3898 -      apply (erule (1) order_trans [OF Basis_le_norm])
 21.3899 -      done
 21.3900 +      by (clarsimp simp: dist_norm) (metis inner_commute inner_diff_right norm_bound_Basis_le)
 21.3901      have e': "e = (\<Sum>(i::'a)\<in>Basis. d)"
 21.3902        by (simp add: d_def DIM_positive)
 21.3903      show "convex hull c \<subseteq> cball x e"
 21.3904 @@ -7136,51 +6674,31 @@
 21.3905        apply (rule order_trans [OF L2_set_le_sum])
 21.3906        apply (rule zero_le_dist)
 21.3907        unfolding e'
 21.3908 -      apply (rule sum_mono)
 21.3909 -      apply simp
 21.3910 +      apply (rule sum_mono, simp)
 21.3911        done
 21.3912    qed
 21.3913    define k where "k = Max (f ` c)"
 21.3914    have "convex_on (convex hull c) f"
 21.3915      apply(rule convex_on_subset[OF assms(2)])
 21.3916 -    apply(rule subset_trans[OF _ e(1)])
 21.3917 -    apply(rule c1)
 21.3918 +    apply(rule subset_trans[OF c1 e(1)])
 21.3919      done
 21.3920    then have k: "\<forall>y\<in>convex hull c. f y \<le> k"
 21.3921 -    apply (rule_tac convex_on_convex_hull_bound)
 21.3922 -    apply assumption
 21.3923 -    unfolding k_def
 21.3924 -    apply (rule, rule Max_ge)
 21.3925 -    using c(1)
 21.3926 -    apply auto
 21.3927 -    done
 21.3928 -  have "d \<le> e"
 21.3929 -    unfolding d_def
 21.3930 -    apply (rule mult_imp_div_pos_le)
 21.3931 -    using \<open>e > 0\<close>
 21.3932 -    unfolding mult_le_cancel_left1
 21.3933 -    apply (auto simp: real_of_nat_ge_one_iff Suc_le_eq DIM_positive)
 21.3934 -    done
 21.3935 +    apply (rule_tac convex_on_convex_hull_bound, assumption)
 21.3936 +    by (simp add: k_def c)
 21.3937 +  have "e \<le> e * real DIM('a)"
 21.3938 +    using e(2) real_of_nat_ge_one_iff by auto
 21.3939 +  then have "d \<le> e"
 21.3940 +    by (simp add: d_def divide_simps)
 21.3941    then have dsube: "cball x d \<subseteq> cball x e"
 21.3942      by (rule subset_cball)
 21.3943    have conv: "convex_on (cball x d) f"
 21.3944 -    apply (rule convex_on_subset)
 21.3945 -    apply (rule convex_on_subset[OF assms(2)])
 21.3946 -    apply (rule e(1))
 21.3947 -    apply (rule dsube)
 21.3948 -    done
 21.3949 +    using \<open>convex_on (convex hull c) f\<close> c2 convex_on_subset by blast
 21.3950    then have "\<forall>y\<in>cball x d. \<bar>f y\<bar> \<le> k + 2 * \<bar>f x\<bar>"
 21.3951 -    apply (rule convex_bounds_lemma)
 21.3952 -    apply (rule ballI)
 21.3953 -    apply (rule k [rule_format])
 21.3954 -    apply (erule rev_subsetD)
 21.3955 -    apply (rule c2)
 21.3956 -    done
 21.3957 +    by (rule convex_bounds_lemma) (use c2 k in blast)
 21.3958    then have "continuous_on (ball x d) f"
 21.3959      apply (rule_tac convex_on_bounded_continuous)
 21.3960      apply (rule open_ball, rule convex_on_subset[OF conv])
 21.3961 -    apply (rule ball_subset_cball)
 21.3962 -    apply force
 21.3963 +    apply (rule ball_subset_cball, force)
 21.3964      done
 21.3965    then show "continuous (at x) f"
 21.3966      unfolding continuous_on_eq_continuous_at[OF open_ball]
    22.1 --- a/src/HOL/Analysis/Derivative.thy	Wed May 02 13:49:38 2018 +0200
    22.2 +++ b/src/HOL/Analysis/Derivative.thy	Thu May 03 15:07:14 2018 +0200
    22.3 @@ -373,77 +373,76 @@
    22.4  
    22.5  lemma frechet_derivative_unique_within:
    22.6    fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
    22.7 -  assumes "(f has_derivative f') (at x within s)"
    22.8 -    and "(f has_derivative f'') (at x within s)"
    22.9 -    and "\<forall>i\<in>Basis. \<forall>e>0. \<exists>d. 0 < \<bar>d\<bar> \<and> \<bar>d\<bar> < e \<and> (x + d *\<^sub>R i) \<in> s"
   22.10 +  assumes "(f has_derivative f') (at x within S)"
   22.11 +    and "(f has_derivative f'') (at x within S)"
   22.12 +    and "\<forall>i\<in>Basis. \<forall>e>0. \<exists>d. 0 < \<bar>d\<bar> \<and> \<bar>d\<bar> < e \<and> (x + d *\<^sub>R i) \<in> S"
   22.13    shows "f' = f''"
   22.14  proof -
   22.15    note as = assms(1,2)[unfolded has_derivative_def]
   22.16    then interpret f': bounded_linear f' by auto
   22.17    from as interpret f'': bounded_linear f'' by auto
   22.18 -  have "x islimpt s" unfolding islimpt_approachable
   22.19 +  have "x islimpt S" unfolding islimpt_approachable
   22.20    proof (rule, rule)
   22.21      fix e :: real
   22.22      assume "e > 0"
   22.23 -    obtain d where "0 < \<bar>d\<bar>" and "\<bar>d\<bar> < e" and "x + d *\<^sub>R (SOME i. i \<in> Basis) \<in> s"
   22.24 +    obtain d where "0 < \<bar>d\<bar>" and "\<bar>d\<bar> < e" and "x + d *\<^sub>R (SOME i. i \<in> Basis) \<in> S"
   22.25        using assms(3) SOME_Basis \<open>e>0\<close> by blast
   22.26 -    then show "\<exists>x'\<in>s. x' \<noteq> x \<and> dist x' x < e"
   22.27 +    then show "\<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e"
   22.28        apply (rule_tac x="x + d *\<^sub>R (SOME i. i \<in> Basis)" in bexI)
   22.29        unfolding dist_norm
   22.30        apply (auto simp: SOME_Basis nonzero_Basis)
   22.31        done
   22.32    qed
   22.33 -  then have *: "netlimit (at x within s) = x"
   22.34 +  then have *: "netlimit (at x within S) = x"
   22.35      apply (auto intro!: netlimit_within)
   22.36      by (metis trivial_limit_within)
   22.37    show ?thesis
   22.38 -    apply (rule linear_eq_stdbasis)
   22.39 -    unfolding linear_conv_bounded_linear
   22.40 -    apply (rule as(1,2)[THEN conjunct1])+
   22.41 -  proof (rule ccontr)
   22.42 +  proof (rule linear_eq_stdbasis)
   22.43 +    show "linear f'" "linear f''"
   22.44 +      unfolding linear_conv_bounded_linear using as by auto
   22.45 +  next
   22.46      fix i :: 'a
   22.47      assume i: "i \<in> Basis"
   22.48      define e where "e = norm (f' i - f'' i)"
   22.49 -    assume "f' i \<noteq> f'' i"
   22.50 -    then have "e > 0"
   22.51 -      unfolding e_def by auto
   22.52 -    obtain d where d:
   22.53 -      "0 < d"
   22.54 -      "(\<And>xa. xa\<in>s \<longrightarrow> 0 < dist xa x \<and> dist xa x < d \<longrightarrow>
   22.55 -          dist ((f xa - f x - f' (xa - x)) /\<^sub>R norm (xa - x) -
   22.56 -              (f xa - f x - f'' (xa - x)) /\<^sub>R norm (xa - x)) (0 - 0) < e)"
   22.57 -      using tendsto_diff [OF as(1,2)[THEN conjunct2]]
   22.58 -      unfolding * Lim_within
   22.59 -      using \<open>e>0\<close> by blast
   22.60 -    obtain c where c: "0 < \<bar>c\<bar>" "\<bar>c\<bar> < d \<and> x + c *\<^sub>R i \<in> s"
   22.61 -      using assms(3) i d(1) by blast
   22.62 -    have *: "norm (- ((1 / \<bar>c\<bar>) *\<^sub>R f' (c *\<^sub>R i)) + (1 / \<bar>c\<bar>) *\<^sub>R f'' (c *\<^sub>R i)) =
   22.63 +    show "f' i = f'' i"
   22.64 +    proof (rule ccontr)
   22.65 +      assume "f' i \<noteq> f'' i"
   22.66 +      then have "e > 0"
   22.67 +        unfolding e_def by auto
   22.68 +      obtain d where d:
   22.69 +        "0 < d"
   22.70 +        "(\<And>y. y\<in>S \<longrightarrow> 0 < dist y x \<and> dist y x < d \<longrightarrow>
   22.71 +          dist ((f y - f x - f' (y - x)) /\<^sub>R norm (y - x) -
   22.72 +              (f y - f x - f'' (y - x)) /\<^sub>R norm (y - x)) (0 - 0) < e)"
   22.73 +        using tendsto_diff [OF as(1,2)[THEN conjunct2]]
   22.74 +        unfolding * Lim_within
   22.75 +        using \<open>e>0\<close> by blast
   22.76 +      obtain c where c: "0 < \<bar>c\<bar>" "\<bar>c\<bar> < d \<and> x + c *\<^sub>R i \<in> S"
   22.77 +        using assms(3) i d(1) by blast
   22.78 +      have *: "norm (- ((1 / \<bar>c\<bar>) *\<^sub>R f' (c *\<^sub>R i)) + (1 / \<bar>c\<bar>) *\<^sub>R f'' (c *\<^sub>R i)) =
   22.79          norm ((1 / \<bar>c\<bar>) *\<^sub>R (- (f' (c *\<^sub>R i)) + f'' (c *\<^sub>R i)))"
   22.80 -      unfolding scaleR_right_distrib by auto
   22.81 -    also have "\<dots> = norm ((1 / \<bar>c\<bar>) *\<^sub>R (c *\<^sub>R (- (f' i) + f'' i)))"
   22.82 -      unfolding f'.scaleR f''.scaleR
   22.83 -      unfolding scaleR_right_distrib scaleR_minus_right
   22.84 -      by auto
   22.85 -    also have "\<dots> = e"
   22.86 -      unfolding e_def
   22.87 -      using c(1)
   22.88 -      using norm_minus_cancel[of "f' i - f'' i"]
   22.89 -      by auto
   22.90 -    finally show False
   22.91 -      using c
   22.92 -      using d(2)[of "x + c *\<^sub>R i"]
   22.93 -      unfolding dist_norm
   22.94 -      unfolding f'.scaleR f''.scaleR f'.add f''.add f'.diff f''.diff
   22.95 -        scaleR_scaleR scaleR_right_diff_distrib scaleR_right_distrib
   22.96 -      using i
   22.97 -      by (auto simp: inverse_eq_divide)
   22.98 +        unfolding scaleR_right_distrib by auto
   22.99 +      also have "\<dots> = norm ((1 / \<bar>c\<bar>) *\<^sub>R (c *\<^sub>R (- (f' i) + f'' i)))"
  22.100 +        unfolding f'.scaleR f''.scaleR
  22.101 +        unfolding scaleR_right_distrib scaleR_minus_right
  22.102 +        by auto
  22.103 +      also have "\<dots> = e"
  22.104 +        unfolding e_def
  22.105 +        using c(1)
  22.106 +        using norm_minus_cancel[of "f' i - f'' i"]
  22.107 +        by auto
  22.108 +      finally show False
  22.109 +        using c
  22.110 +        using d(2)[of "x + c *\<^sub>R i"]
  22.111 +        unfolding dist_norm
  22.112 +        unfolding f'.scaleR f''.scaleR f'.add f''.add f'.diff f''.diff
  22.113 +          scaleR_scaleR scaleR_right_diff_distrib scaleR_right_distrib
  22.114 +        using i
  22.115 +        by (auto simp: inverse_eq_divide)
  22.116 +    qed
  22.117    qed
  22.118  qed
  22.119  
  22.120 -lemma frechet_derivative_unique_at:
  22.121 -  "(f has_derivative f') (at x) \<Longrightarrow> (f has_derivative f'') (at x) \<Longrightarrow> f' = f''"
  22.122 -  by (rule has_derivative_unique)
  22.123 -
  22.124  lemma frechet_derivative_unique_within_closed_interval:
  22.125    fixes f::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
  22.126    assumes "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"
  22.127 @@ -506,12 +505,12 @@
  22.128    from assms(1) have *: "at x within box a b = at x"
  22.129      by (metis at_within_interior interior_open open_box)
  22.130    from assms(2,3) [unfolded *] show "f' = f''"
  22.131 -    by (rule frechet_derivative_unique_at)
  22.132 +    by (rule has_derivative_unique)
  22.133  qed
  22.134  
  22.135  lemma frechet_derivative_at:
  22.136    "(f has_derivative f') (at x) \<Longrightarrow> f' = frechet_derivative f (at x)"
  22.137 -  apply (rule frechet_derivative_unique_at[of f])
  22.138 +  apply (rule has_derivative_unique[of f])
  22.139    apply assumption
  22.140    unfolding frechet_derivative_works[symmetric]
  22.141    using differentiable_def
  22.142 @@ -1197,13 +1196,13 @@
  22.143  
  22.144  lemma has_derivative_inverse_basic:
  22.145    fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
  22.146 -  assumes "(f has_derivative f') (at (g y))"
  22.147 -    and "bounded_linear g'"
  22.148 +  assumes derf: "(f has_derivative f') (at (g y))"
  22.149 +    and ling': "bounded_linear g'"
  22.150      and "g' \<circ> f' = id"
  22.151 -    and "continuous (at y) g"
  22.152 -    and "open t"
  22.153 -    and "y \<in> t"
  22.154 -    and "\<forall>z\<in>t. f (g z) = z"
  22.155 +    and contg: "continuous (at y) g"
  22.156 +    and "open T"
  22.157 +    and "y \<in> T"
  22.158 +    and fg: "\<And>z. z \<in> T \<Longrightarrow> f (g z) = z"
  22.159    shows "(g has_derivative g') (at y)"
  22.160  proof -
  22.161    interpret f': bounded_linear f'
  22.162 @@ -1214,70 +1213,48 @@
  22.163      using bounded_linear.pos_bounded[OF assms(2)] by blast
  22.164    have lem1: "\<forall>e>0. \<exists>d>0. \<forall>z.
  22.165      norm (z - y) < d \<longrightarrow> norm (g z - g y - g'(z - y)) \<le> e * norm (g z - g y)"
  22.166 -  proof (rule, rule)
  22.167 +  proof (intro allI impI)
  22.168      fix e :: real
  22.169      assume "e > 0"
  22.170      with C(1) have *: "e / C > 0" by auto
  22.171 -    obtain d0 where d0:
  22.172 -        "0 < d0"