# HG changeset patch # User noschinl # Date 1378457847 -7200 # Node ID d2a7b6fe953e99f7398e8d75e1b93100ce5d2343 # Parent d92578436d470d186151fb80376334af24c3d2e3# Parent f5b1f555b73badcc58c4ded2950809c5f845ecaf merged diff -r d92578436d47 -r d2a7b6fe953e Admin/Release/CHECKLIST --- a/Admin/Release/CHECKLIST Fri Sep 06 10:56:40 2013 +0200 +++ b/Admin/Release/CHECKLIST Fri Sep 06 10:57:27 2013 +0200 @@ -7,8 +7,6 @@ - test polyml-5.4.1, polyml-5.4.0, polyml-5.3.0, smlnj; -- test scala-2.9.2; - - test Proof General 4.1, 3.7.1.1; - test 'display_drafts' command; @@ -27,8 +25,7 @@ - update https://isabelle.in.tum.de/repos/website; -- maintain Docs: - doc/Contents +- maintain doc/Contents; - maintain Logics: ROOTS diff -r d92578436d47 -r d2a7b6fe953e Admin/Windows/Installer/sfx.txt --- a/Admin/Windows/Installer/sfx.txt Fri Sep 06 10:56:40 2013 +0200 +++ b/Admin/Windows/Installer/sfx.txt Fri Sep 06 10:57:27 2013 +0200 @@ -5,5 +5,5 @@ ExtractPathText="Target directory" ExtractTitle="Unpacking {ISABELLE_NAME} ..." Shortcut="Du,{%%T\{ISABELLE_NAME}\{ISABELLE_NAME}.exe},{},{},{},{{ISABELLE_NAME}},{%%T\{ISABELLE_NAME}}" -RunProgram="\"%%T\{ISABELLE_NAME}\{ISABELLE_NAME}.exe\" -i" +RunProgram="\"%%T\{ISABELLE_NAME}\{ISABELLE_NAME}.exe\"" ;!@InstallEnd@! diff -r d92578436d47 -r d2a7b6fe953e Admin/Windows/launch4j/isabelle.xml --- a/Admin/Windows/launch4j/isabelle.xml Fri Sep 06 10:56:40 2013 +0200 +++ b/Admin/Windows/launch4j/isabelle.xml Fri Sep 06 10:57:27 2013 +0200 @@ -20,11 +20,11 @@ %EXEDIR%\lib\classes\ext\scala-swing.jar - %EXEDIR%\contrib\jdk-7u21\x86-cygwin\jdk1.7.0_21 + %EXEDIR%\contrib\jdk\x86-cygwin jdkOnly - -Disabelle.home="%EXEDIR%" -Dcygwin.root="%EXEDIR%\\contrib\\cygwin" + -Disabelle.home="%EXEDIR%" isabelle.bmp diff -r d92578436d47 -r d2a7b6fe953e Admin/components/bundled-windows --- a/Admin/components/bundled-windows Fri Sep 06 10:56:40 2013 +0200 +++ b/Admin/components/bundled-windows Fri Sep 06 10:57:27 2013 +0200 @@ -1,3 +1,3 @@ #additional components to be bundled for release cygwin-20130117 -windows_app-20130716 +windows_app-20130905 diff -r d92578436d47 -r d2a7b6fe953e Admin/components/components.sha1 --- a/Admin/components/components.sha1 Fri Sep 06 10:56:40 2013 +0200 +++ b/Admin/components/components.sha1 Fri Sep 06 10:57:27 2013 +0200 @@ -18,6 +18,7 @@ 38d2d2a91c66714c18430e136e7e5191af3996e6 jdk-7u11.tar.gz d765bc4ad2f34d494429b2a8c1563c49db224944 jdk-7u13.tar.gz 13a265e4b706ece26fdfa6fc9f4a3dd1366016d2 jdk-7u21.tar.gz +5080274f8721a18111a7f614793afe6c88726739 jdk-7u25.tar.gz ec740ee9ffd43551ddf1e5b91641405116af6291 jdk-7u6.tar.gz 7d5b152ac70f720bb9e783fa45ecadcf95069584 jdk-7u9.tar.gz 44775a22f42a9d665696bfb49e53c79371c394b0 jedit_build-20111217.tar.gz @@ -31,6 +32,7 @@ 8fa0c67f59beba369ab836562eed4e56382f672a jedit_build-20121201.tar.gz 06e9be2627ebb95c45a9bcfa025d2eeef086b408 jedit_build-20130104.tar.gz c85c0829b8170f25aa65ec6852f505ce2a50639b jedit_build-20130628.tar.gz +5de3e399be2507f684b49dfd13da45228214bbe4 jedit_build-20130905.tar.gz 8122526f1fc362ddae1a328bdbc2152853186fee jfreechart-1.0.14.tar.gz 6c737137cc597fc920943783382e928ea79e3feb kodkodi-1.2.16.tar.gz 5f95c96bb99927f3a026050f85bd056f37a9189e kodkodi-1.5.2.tar.gz @@ -52,6 +54,7 @@ 1f4a2053cc1f34fa36c4d9d2ac906ad4ebc863fd sumatra_pdf-2.1.1.tar.gz 869ea6d8ea35c8ba68d7fcb028f16b2b7064c5fd vampire-1.0.tar.gz 81d21dfd0ea5c58f375301f5166be9dbf8921a7a windows_app-20130716.tar.gz +fe15e1079cf5ad86f3cbab4553722a0d20002d11 windows_app-20130905.tar.gz 2ae13aa17d0dc95ce254a52f1dba10929763a10d xz-java-1.2.tar.gz 4530a1aa6f4498ee3d78d6000fa71a3f63bd077f yices-1.0.28.tar.gz 12ae71acde43bd7bed1e005c43034b208c0cba4c z3-3.2.tar.gz diff -r d92578436d47 -r d2a7b6fe953e Admin/components/main --- a/Admin/components/main Fri Sep 06 10:56:40 2013 +0200 +++ b/Admin/components/main Fri Sep 06 10:57:27 2013 +0200 @@ -3,8 +3,8 @@ e-1.8 exec_process-1.0.3 Haskabelle-2013 -jdk-7u21 -jedit_build-20130628 +jdk-7u25 +jedit_build-20130905 jfreechart-1.0.14 kodkodi-1.5.2 polyml-5.5.0-3 diff -r d92578436d47 -r d2a7b6fe953e Admin/java/build --- a/Admin/java/build Fri Sep 06 10:56:40 2013 +0200 +++ b/Admin/java/build Fri Sep 06 10:57:27 2013 +0200 @@ -11,8 +11,8 @@ ## parameters -VERSION="7u21" -FULL_VERSION="1.7.0_21" +VERSION="7u25" +FULL_VERSION="1.7.0_25" ARCHIVE_LINUX32="jdk-${VERSION}-linux-i586.tar.gz" ARCHIVE_LINUX64="jdk-${VERSION}-linux-x64.tar.gz" @@ -37,8 +37,6 @@ Linux, Mac OS X, Windows work uniformly, depending on certain platform-specific subdirectories. - -Note that Java 1.7 on Mac OS X requires 64bit hardware! EOF @@ -53,10 +51,10 @@ echo "### Java 1.7 unavailable on 32bit Macintosh!" >&2 ;; x86_64-darwin) - ISABELLE_JDK_HOME="\$COMPONENT/\$ISABELLE_PLATFORM64/jdk${FULL_VERSION}.jdk/Contents/Home" + ISABELLE_JDK_HOME="\$COMPONENT/\$ISABELLE_PLATFORM64/Contents/Home" ;; *) - ISABELLE_JDK_HOME="\$COMPONENT/\${ISABELLE_PLATFORM64:-\$ISABELLE_PLATFORM32}/jdk${FULL_VERSION}" + ISABELLE_JDK_HOME="\$COMPONENT/\${ISABELLE_PLATFORM64:-\$ISABELLE_PLATFORM32}" ;; esac @@ -82,6 +80,18 @@ tar -C "$DIR/x86_64-darwin" -xf "$ARCHIVE_DARWIN" tar -C "$DIR/x86-cygwin" -xf "$ARCHIVE_WINDOWS" +( + cd "$DIR" + for PLATFORM in x86-linux x86_64-linux x86-cygwin + do + mv "$PLATFORM/jdk${FULL_VERSION}"/* "$PLATFORM"/. + rmdir "$PLATFORM/jdk${FULL_VERSION}" + done + PLATFORM=x86_64-darwin + mv "$PLATFORM/jdk${FULL_VERSION}.jdk"/* "$PLATFORM"/. + rmdir "$PLATFORM/jdk${FULL_VERSION}.jdk" +) + chgrp -R isabelle "$DIR" chmod -R a+r "$DIR" chmod -R a+X "$DIR" @@ -90,13 +100,13 @@ echo "Sharing ..." ( - cd "$DIR/x86-linux/jdk${FULL_VERSION}" + cd "$DIR/x86-linux" for FILE in $(find . -type f) do for OTHER in \ - "../../x86_64-linux/jdk${FULL_VERSION}/$FILE" \ - "../../x86_64-darwin/jdk${FULL_VERSION}.jdk/Contents/Home/$FILE" \ - "../../x86-cygwin/jdk${FULL_VERSION}/$FILE" + "../../x86_64-linux/$FILE" \ + "../../x86_64-darwin/Contents/Home/$FILE" \ + "../../x86-cygwin/$FILE" do if cmp -s "$FILE" "$OTHER" then diff -r d92578436d47 -r d2a7b6fe953e Admin/lib/Tools/makedist_bundle --- a/Admin/lib/Tools/makedist_bundle Fri Sep 06 10:56:40 2013 +0200 +++ b/Admin/lib/Tools/makedist_bundle Fri Sep 06 10:57:27 2013 +0200 @@ -48,7 +48,7 @@ ISABELLE_TARGET="$TMP/$ISABELLE_NAME" -tar -C "$TMP" -x -z -f "$ARCHIVE" +tar -C "$TMP" -x -z -f "$ARCHIVE" || exit 2 # bundled components @@ -83,10 +83,18 @@ perl -e "exit((stat('${CONTRIB}'))[7] == 0 ? 0 : 1);" && exit 2 fi - tar -C "$ISABELLE_TARGET/contrib" -x -z -f "$CONTRIB" + tar -C "$ISABELLE_TARGET/contrib" -x -z -f "$CONTRIB" || exit 2 if [ -f "$COMPONENT_DIR/etc/settings" -o -f "$COMPONENT_DIR/etc/components" ] then - echo "contrib/$COMPONENT" >> "$ISABELLE_TARGET/etc/components" + case "$COMPONENT" in + jdk-*) + mv "$ISABELLE_TARGET/contrib/$COMPONENT" "$ISABELLE_TARGET/contrib/jdk" + echo "contrib/jdk" >> "$ISABELLE_TARGET/etc/components" + ;; + *) + echo "contrib/$COMPONENT" >> "$ISABELLE_TARGET/etc/components" + ;; + esac fi ;; esac @@ -154,6 +162,8 @@ find . -type l -exec echo "{}" ";" -exec readlink "{}" ";" \ > "contrib/cygwin/isabelle/symlinks" + + touch "contrib/cygwin/isabelle/uninitialized" ) perl -pi -e "s,/bin/rebaseall.*,/isabelle/rebaseall,g;" \ @@ -202,7 +212,7 @@ cp -R "$APP_TEMPLATE/Resources/." "$APP/Contents/Resources/." cp "$APP_TEMPLATE/../isabelle.icns" "$APP/Contents/Resources/." - ln -sf "../Resources/${ISABELLE_NAME}/contrib/jdk-7u21/x86_64-darwin/jdk1.7.0_21.jdk" \ + ln -sf "../Resources/${ISABELLE_NAME}/contrib/jdk/x86_64-darwin" \ "$APP/Contents/PlugIns/jdk" cp macos_app/JavaAppLauncher "$APP/Contents/MacOS/." && \ diff -r d92578436d47 -r d2a7b6fe953e Admin/lib/Tools/update_keywords --- a/Admin/lib/Tools/update_keywords Fri Sep 06 10:56:40 2013 +0200 +++ b/Admin/lib/Tools/update_keywords Fri Sep 06 10:57:27 2013 +0200 @@ -3,6 +3,7 @@ # Author: Makarius # # DESCRIPTION: update standard keyword files for Emacs Proof General +# (Proof General legacy) isabelle_admin_build jars || exit $? diff -r d92578436d47 -r d2a7b6fe953e CONTRIBUTORS --- a/CONTRIBUTORS Fri Sep 06 10:56:40 2013 +0200 +++ b/CONTRIBUTORS Fri Sep 06 10:57:27 2013 +0200 @@ -6,7 +6,11 @@ Contributions to this Isabelle version -------------------------------------- -* Spring and Summer 2013: Lorenz Panny, Dmitriy Traytel, and Jasmin Blanchette, TUM +* September 2013: Nik Sultana, University of Cambridge + Improvements to HOL/TPTP parser and import facilities. + +* Spring and Summer 2013: Lorenz Panny, Dmitriy Traytel, and + Jasmin Blanchette, TUM Various improvements to BNF-based (co)datatype package, including a "primrec_new" command and a compatibility layer. diff -r d92578436d47 -r d2a7b6fe953e NEWS --- a/NEWS Fri Sep 06 10:56:40 2013 +0200 +++ b/NEWS Fri Sep 06 10:57:27 2013 +0200 @@ -101,7 +101,7 @@ - Light-weight popup, which avoids explicit window (more reactive and more robust). Interpreted key events include TAB, ESCAPE, UP, - DOWN, PAGE_UP, PAGE_DOWN. Uninterpreted key events are passed to + DOWN, PAGE_UP, PAGE_DOWN. All other key events are passed to the jEdit text area. - Explicit completion via standard jEdit shortcut C+b, which has diff -r d92578436d47 -r d2a7b6fe953e src/HOL/BNF/Tools/bnf_fp_rec_sugar.ML --- a/src/HOL/BNF/Tools/bnf_fp_rec_sugar.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/HOL/BNF/Tools/bnf_fp_rec_sugar.ML Fri Sep 06 10:57:27 2013 +0200 @@ -36,8 +36,7 @@ fun permute_args n t = list_comb (t, map Bound (0 :: (n downto 1))) |> fold (K (fn u => Abs (Name.uu, dummyT, u))) (0 upto n); -fun abs_tuple t = if t = undef_const then t else - strip_abs t |>> HOLogic.mk_tuple o map Free |-> HOLogic.tupled_lambda; +val abs_tuple = HOLogic.tupled_lambda o HOLogic.mk_tuple; val simp_attrs = @{attributes [simp]}; @@ -107,7 +106,7 @@ user_eqn = eqn'} end; -fun rewrite_map_arg fun_name_ctr_pos_list rec_type res_type = +fun rewrite_map_arg get_ctr_pos rec_type res_type = let val pT = HOLogic.mk_prodT (rec_type, res_type); @@ -117,11 +116,9 @@ | subst d t = let val (u, vs) = strip_comb t; - val maybe_fun_name_ctr_pos = - find_first (equal (free_name u) o SOME o fst) fun_name_ctr_pos_list; - val (fun_name, ctr_pos) = the_default ("", ~1) maybe_fun_name_ctr_pos; + val ctr_pos = try (get_ctr_pos o the) (free_name u) |> the_default ~1; in - if is_some maybe_fun_name_ctr_pos then + if ctr_pos >= 0 then if d = SOME ~1 andalso length vs = ctr_pos then list_comb (permute_args ctr_pos (snd_const pT), vs) else if length vs > ctr_pos andalso is_some d @@ -138,7 +135,7 @@ subst (SOME ~1) end; -fun subst_rec_calls lthy fun_name_ctr_pos_list has_call ctr_args direct_calls indirect_calls t = +fun subst_rec_calls lthy get_ctr_pos has_call ctr_args direct_calls indirect_calls t = let fun subst bound_Ts (Abs (v, T, b)) = Abs (v, T, subst (T :: bound_Ts) b) | subst bound_Ts (t as g' $ y) = @@ -146,19 +143,18 @@ val maybe_direct_y' = AList.lookup (op =) direct_calls y; val maybe_indirect_y' = AList.lookup (op =) indirect_calls y; val (g, g_args) = strip_comb g'; - val maybe_ctr_pos = - try (snd o the o find_first (equal (free_name g) o SOME o fst)) fun_name_ctr_pos_list; - val _ = is_none maybe_ctr_pos orelse length g_args >= the maybe_ctr_pos orelse + val ctr_pos = try (get_ctr_pos o the) (free_name g) |> the_default ~1; + val _ = ctr_pos < 0 orelse length g_args >= ctr_pos orelse primrec_error_eqn "too few arguments in recursive call" t; in if not (member (op =) ctr_args y) then pairself (subst bound_Ts) (g', y) |> (op $) - else if is_some maybe_ctr_pos then + else if ctr_pos >= 0 then list_comb (the maybe_direct_y', g_args) else if is_some maybe_indirect_y' then (if has_call g' then t else y) |> massage_indirect_rec_call lthy has_call - (rewrite_map_arg fun_name_ctr_pos_list) bound_Ts y (the maybe_indirect_y') + (rewrite_map_arg get_ctr_pos) bound_Ts y (the maybe_indirect_y') |> (if has_call g' then I else curry (op $) g') else t @@ -211,16 +207,17 @@ nth_map arg_idx (K (nth ctr_args ctr_arg_idx |> map_types make_indirect_type))) indirect_calls'; + val fun_name_ctr_pos_list = + map (fn (x :: _) => (#fun_name x, length (#left_args x))) funs_data; + val get_ctr_pos = try (the o AList.lookup (op =) fun_name_ctr_pos_list) #> the_default ~1; val direct_calls = map (apfst (nth ctr_args) o apsnd (nth args)) direct_calls'; val indirect_calls = map (apfst (nth ctr_args) o apsnd (nth args)) indirect_calls'; - val abstractions = map dest_Free (args @ #left_args eqn_data @ #right_args eqn_data); - val fun_name_ctr_pos_list = - map (fn (x :: _) => (#fun_name x, length (#left_args x))) funs_data; + val abstractions = args @ #left_args eqn_data @ #right_args eqn_data; in t - |> subst_rec_calls lthy fun_name_ctr_pos_list has_call ctr_args direct_calls indirect_calls - |> fold_rev absfree abstractions + |> subst_rec_calls lthy get_ctr_pos has_call ctr_args direct_calls indirect_calls + |> fold_rev lambda abstractions end; fun build_defs lthy bs mxs funs_data rec_specs has_call = @@ -372,15 +369,16 @@ type co_eqn_data_disc = { fun_name: string, + fun_args: term list, ctr_no: int, (*###*) cond: term, user_eqn: term }; type co_eqn_data_sel = { fun_name: string, + fun_args: term list, ctr: term, sel: term, - fun_args: term list, rhs_term: term, user_eqn: term }; @@ -388,11 +386,10 @@ Disc of co_eqn_data_disc | Sel of co_eqn_data_sel; -fun co_dissect_eqn_disc sequential fun_name_corec_spec_list eqn' imp_lhs' imp_rhs matched_conds_ps = +fun co_dissect_eqn_disc sequential fun_name_corec_spec_list eqn' imp_lhs' imp_rhs matched_conds = let fun find_subterm p = let (* FIXME \? *) - fun f (t as u $ v) = - fold_rev (curry merge_options) [if p t then SOME t else NONE, f u, f v] NONE + fun f (t as u $ v) = if p t then SOME t else merge_options (f u, f v) | f t = if p t then SOME t else NONE in f end; @@ -406,9 +403,8 @@ val discs = #ctr_specs corec_spec |> map #disc; val ctrs = #ctr_specs corec_spec |> map #ctr; - val n_ctrs = length ctrs; val not_disc = head_of imp_rhs = @{term Not}; - val _ = not_disc andalso n_ctrs <> 2 andalso + val _ = not_disc andalso length ctrs <> 2 andalso primrec_error_eqn "\ed discriminator for a type with \ 2 constructors" imp_rhs; val disc = find_subterm (member (op =) discs o head_of) imp_rhs; val eq_ctr0 = imp_rhs |> perhaps (try (HOLogic.dest_not)) |> try (HOLogic.dest_eq #> snd) @@ -428,32 +424,28 @@ val mk_conjs = try (foldr1 HOLogic.mk_conj) #> the_default @{const True}; val mk_disjs = try (foldr1 HOLogic.mk_disj) #> the_default @{const False}; val catch_all = try (fst o dest_Free o the_single) imp_lhs' = SOME Name.uu_; - val matched_conds = filter (equal fun_name o fst) matched_conds_ps |> map snd; - val imp_lhs = mk_conjs imp_lhs'; + val matched_cond = filter (equal fun_name o fst) matched_conds |> map snd |> mk_disjs; + val imp_lhs = mk_conjs imp_lhs' + |> incr_boundvars (length fun_args) + |> subst_atomic (fun_args ~~ map Bound (length fun_args - 1 downto 0)) val cond = if catch_all then - if null matched_conds then fold_rev absfree (map dest_Free fun_args) @{const True} else - (strip_abs_vars (hd matched_conds), - mk_disjs (map strip_abs_body matched_conds) |> HOLogic.mk_not) - |-> fold_rev (fn (v, T) => fn u => Abs (v, T, u)) + matched_cond |> HOLogic.mk_not else if sequential then - HOLogic.mk_conj (HOLogic.mk_not (mk_disjs (map strip_abs_body matched_conds)), imp_lhs) - |> fold_rev absfree (map dest_Free fun_args) + HOLogic.mk_conj (HOLogic.mk_not matched_cond, imp_lhs) else - imp_lhs |> fold_rev absfree (map dest_Free fun_args); - val matched_cond = - if sequential then fold_rev absfree (map dest_Free fun_args) imp_lhs else cond; + imp_lhs; - val matched_conds_ps' = if catch_all - then (fun_name, cond) :: filter (not_equal fun_name o fst) matched_conds_ps - else (fun_name, matched_cond) :: matched_conds_ps; + val matched_conds' = + (fun_name, if catch_all orelse not sequential then cond else imp_lhs) :: matched_conds; in (Disc { fun_name = fun_name, + fun_args = fun_args, ctr_no = ctr_no, cond = cond, user_eqn = eqn' - }, matched_conds_ps') + }, matched_conds') end; fun co_dissect_eqn_sel fun_name_corec_spec_list eqn' eqn = @@ -473,15 +465,15 @@ in Sel { fun_name = fun_name, + fun_args = fun_args, ctr = #ctr ctr_spec, sel = sel, - fun_args = fun_args, rhs_term = rhs, user_eqn = eqn' } end; -fun co_dissect_eqn_ctr sequential fun_name_corec_spec_list eqn' imp_lhs' imp_rhs matched_conds_ps = +fun co_dissect_eqn_ctr sequential fun_name_corec_spec_list eqn' imp_lhs' imp_rhs matched_conds = let val (lhs, rhs) = HOLogic.dest_eq imp_rhs; val fun_name = head_of lhs |> fst o dest_Free; @@ -491,10 +483,10 @@ handle Option.Option => primrec_error_eqn "not a constructor" ctr; val disc_imp_rhs = betapply (#disc ctr_spec, lhs); - val (maybe_eqn_data_disc, matched_conds_ps') = if length (#ctr_specs corec_spec) = 1 - then (NONE, matched_conds_ps) + val (maybe_eqn_data_disc, matched_conds') = if length (#ctr_specs corec_spec) = 1 + then (NONE, matched_conds) else apfst SOME (co_dissect_eqn_disc - sequential fun_name_corec_spec_list eqn' imp_lhs' disc_imp_rhs matched_conds_ps); + sequential fun_name_corec_spec_list eqn' imp_lhs' disc_imp_rhs matched_conds); val sel_imp_rhss = (#sels ctr_spec ~~ ctr_args) |> map (fn (sel, ctr_arg) => HOLogic.mk_eq (betapply (sel, lhs), ctr_arg)); @@ -506,10 +498,10 @@ val eqns_data_sel = map (co_dissect_eqn_sel fun_name_corec_spec_list eqn') sel_imp_rhss; in - (map_filter I [maybe_eqn_data_disc] @ eqns_data_sel, matched_conds_ps') + (map_filter I [maybe_eqn_data_disc] @ eqns_data_sel, matched_conds') end; -fun co_dissect_eqn sequential fun_name_corec_spec_list eqn' matched_conds_ps = +fun co_dissect_eqn sequential fun_name_corec_spec_list eqn' matched_conds = let val eqn = subst_bounds (strip_qnt_vars @{const_name all} eqn' |> map Free |> rev, strip_qnt_body @{const_name all} eqn') @@ -531,79 +523,112 @@ if member (op =) discs head orelse is_some maybe_rhs andalso member (op =) (filter (null o binder_types o fastype_of) ctrs) (the maybe_rhs) then - co_dissect_eqn_disc sequential fun_name_corec_spec_list eqn' imp_lhs' imp_rhs matched_conds_ps + co_dissect_eqn_disc sequential fun_name_corec_spec_list eqn' imp_lhs' imp_rhs matched_conds |>> single else if member (op =) sels head then - ([co_dissect_eqn_sel fun_name_corec_spec_list eqn' imp_rhs], matched_conds_ps) + ([co_dissect_eqn_sel fun_name_corec_spec_list eqn' imp_rhs], matched_conds) else if is_Free head andalso member (op =) fun_names (fst (dest_Free head)) then - co_dissect_eqn_ctr sequential fun_name_corec_spec_list eqn' imp_lhs' imp_rhs matched_conds_ps + co_dissect_eqn_ctr sequential fun_name_corec_spec_list eqn' imp_lhs' imp_rhs matched_conds else primrec_error_eqn "malformed function equation" eqn end; fun build_corec_args_discs disc_eqns ctr_specs = - let - val conds = map #cond disc_eqns; - val args' = - if length ctr_specs = 1 then [] - else if length disc_eqns = length ctr_specs then - fst (split_last conds) - else if length disc_eqns = length ctr_specs - 1 then - let val n = 0 upto length ctr_specs - 1 - |> the o find_first (fn idx => not (exists (equal idx o #ctr_no) disc_eqns)) (*###*) in - if n = length ctr_specs - 1 then - conds - else - split_last conds - ||> (fn t => fold_rev absfree (strip_abs_vars t) (strip_abs_body t |> HOLogic.mk_not)) - |>> chop n - |> (fn ((l, r), x) => l @ (x :: r)) - end - else - 0 upto length ctr_specs - 1 - |> map (fn idx => find_first (equal idx o #ctr_no) disc_eqns - |> Option.map #cond - |> the_default undef_const) - |> fst o split_last; - in - (* FIXME: deal with #preds above *) - fold2 (fn idx => nth_map idx o K o abs_tuple) (map_filter #pred ctr_specs) args' - end; + if null disc_eqns then I else + let +(*val _ = tracing ("d/p:\ " ^ space_implode "\n \ " (map ((op ^) o + apfst (Syntax.string_of_term @{context}) o apsnd (curry (op ^) " / " o @{make_string})) + (ctr_specs |> map_filter (fn {disc, pred = SOME pred, ...} => SOME (disc, pred) | _ => NONE))));*) + val conds = map #cond disc_eqns; + val fun_args = #fun_args (hd disc_eqns); + val args = + if length ctr_specs = 1 then [] + else if length disc_eqns = length ctr_specs then + fst (split_last conds) + else if length disc_eqns = length ctr_specs - 1 then + let val n = 0 upto length ctr_specs - 1 + |> the(*###*) o find_first (fn idx => not (exists (equal idx o #ctr_no) disc_eqns)) in + if n = length ctr_specs - 1 then + conds + else + split_last conds + ||> HOLogic.mk_not + |> `(uncurry (fold (curry HOLogic.mk_conj o HOLogic.mk_not))) + ||> chop n o fst + |> (fn (x, (l, r)) => l @ (x :: r)) + end + else + 0 upto length ctr_specs - 1 + |> map (fn idx => find_first (equal idx o #ctr_no) disc_eqns + |> Option.map #cond + |> the_default undef_const) + |> fst o split_last; + in + (* FIXME deal with #preds above *) + (map_filter #pred ctr_specs, args) + |-> fold2 (fn idx => fn t => nth_map idx + (K (subst_bounds (List.rev fun_args, t) + |> HOLogic.tupled_lambda (HOLogic.mk_tuple fun_args)))) + end; fun build_corec_arg_no_call sel_eqns sel = find_first (equal sel o #sel) sel_eqns - |> try (fn SOME sel_eqn => (#fun_args sel_eqn |> map dest_Free, #rhs_term sel_eqn)) + |> try (fn SOME sel_eqn => (#fun_args sel_eqn, #rhs_term sel_eqn)) |> the_default ([], undef_const) - |-> abs_tuple oo fold_rev absfree; + |-> abs_tuple + |> K; fun build_corec_arg_direct_call lthy has_call sel_eqns sel = let - val maybe_sel_eqn = find_first (equal sel o #sel) sel_eqns - - fun rewrite U T t = + val maybe_sel_eqn = find_first (equal sel o #sel) sel_eqns; + fun rewrite is_end U T t = if U = @{typ bool} then @{term True} |> has_call t ? K @{term False} (* stop? *) - else if T = U = has_call t then undef_const - else if T = U then t (* end *) + else if is_end = has_call t then undef_const + else if is_end then t (* end *) else HOLogic.mk_tuple (snd (strip_comb t)); (* continue *) - fun massage rhs_term t = - massage_direct_corec_call lthy has_call rewrite [] (body_type (fastype_of t)) rhs_term; - val abstract = abs_tuple oo fold_rev absfree o map dest_Free; + fun massage rhs_term is_end t = massage_direct_corec_call + lthy has_call (rewrite is_end) [] (range_type (fastype_of t)) rhs_term; + in + if is_none maybe_sel_eqn then K I else + abs_tuple (#fun_args (the maybe_sel_eqn)) oo massage (#rhs_term (the maybe_sel_eqn)) + end; + +fun build_corec_arg_indirect_call lthy has_call sel_eqns sel = + let + val maybe_sel_eqn = find_first (equal sel o #sel) sel_eqns; + fun rewrite _ _ = + let + fun subst (Abs (v, T, b)) = Abs (v, T, subst b) + | subst (t as _ $ _) = + let val (u, vs) = strip_comb t in + if is_Free u andalso has_call u then + Const (@{const_name Inr}, dummyT) $ (*HOLogic.mk_tuple vs*) + (try (foldr1 (fn (x, y) => Const (@{const_name Pair}, dummyT) $ x $ y)) vs + |> the_default (hd vs)) + else if try (fst o dest_Const) u = SOME @{const_name prod_case} then + list_comb (u |> map_types (K dummyT), map subst vs) + else + list_comb (subst u, map subst vs) + end + | subst t = t; + in + subst + end; + fun massage rhs_term t = massage_indirect_corec_call + lthy has_call rewrite [] (fastype_of t |> range_type) rhs_term; in if is_none maybe_sel_eqn then I else - massage (#rhs_term (the maybe_sel_eqn)) #> abstract (#fun_args (the maybe_sel_eqn)) + abs_tuple (#fun_args (the maybe_sel_eqn)) o massage (#rhs_term (the maybe_sel_eqn)) end; -fun build_corec_arg_indirect_call sel_eqns sel = - primrec_error "indirect corecursion not implemented yet"; - fun build_corec_args_sel lthy has_call all_sel_eqns ctr_spec = let val sel_eqns = filter (equal (#ctr ctr_spec) o #ctr) all_sel_eqns in if null sel_eqns then I else let val sel_call_list = #sels ctr_spec ~~ #calls ctr_spec; -val _ = tracing ("sels / calls:\n \ " ^ space_implode "\n \ " (map ((op ^) o - apfst (Syntax.string_of_term @{context}) o apsnd (curry (op ^) " / " o @{make_string})) - (sel_call_list))); +(*val _ = tracing ("s/c:\ " ^ space_implode "\n \ " (map ((op ^) o + apfst (Syntax.string_of_term lthy) o apsnd (curry (op ^) " / " o @{make_string})) + sel_call_list));*) val no_calls' = map_filter (try (apsnd (fn No_Corec n => n))) sel_call_list; val direct_calls' = map_filter (try (apsnd (fn Direct_Corec n => n))) sel_call_list; @@ -611,12 +636,12 @@ in I #> fold (fn (sel, n) => nth_map n - (build_corec_arg_no_call sel_eqns sel |> K)) no_calls' + (build_corec_arg_no_call sel_eqns sel)) no_calls' #> fold (fn (sel, (q, g, h)) => let val f = build_corec_arg_direct_call lthy has_call sel_eqns sel in - nth_map h f o nth_map g f o nth_map q f end) direct_calls' + nth_map h (f false) o nth_map g (f true) o nth_map q (f true) end) direct_calls' #> fold (fn (sel, n) => nth_map n - (build_corec_arg_indirect_call sel_eqns sel |> K)) indirect_calls' + (build_corec_arg_indirect_call lthy has_call sel_eqns sel)) indirect_calls' end end; @@ -651,24 +676,26 @@ |> fold2 build_corec_args_discs disc_eqnss ctr_specss |> fold2 (fold o build_corec_args_sel lthy has_call) sel_eqnss ctr_specss; + fun currys Ts t = if length Ts <= 1 then t else + t $ foldr1 (fn (u, v) => HOLogic.pair_const dummyT dummyT $ u $ v) + (length Ts - 1 downto 0 |> map Bound) + |> fold_rev (fn T => fn u => Abs (Name.uu, T, u)) Ts; + val _ = tracing ("corecursor arguments:\n \ " ^ - space_implode "\n \ " (map (Syntax.string_of_term @{context}) corec_args)); + space_implode "\n \ " (map (Syntax.string_of_term lthy) corec_args)); fun uneq_pairs_rev xs = xs (* FIXME \? *) |> these o try (split_last #> (fn (ys, y) => uneq_pairs_rev ys @ map (pair y) ys)); val proof_obligations = if sequential then [] else - maps (uneq_pairs_rev o map #cond) disc_eqnss - |> map (fn (x, y) => ((strip_abs_body x, strip_abs_body y), strip_abs_vars x)) - |> map (apfst (apsnd HOLogic.mk_not #> pairself HOLogic.mk_Trueprop - #> apfst (curry (op $) @{const ==>}) #> (op $))) - |> map (fn (t, abs_vars) => fold_rev (fn (v, T) => fn u => - Const (@{const_name all}, (T --> @{typ prop}) --> @{typ prop}) $ - Abs (v, T, u)) abs_vars t); + disc_eqnss + |> maps (uneq_pairs_rev o map (fn {fun_args, cond, ...} => (fun_args, cond))) + |> map (fn ((fun_args, x), (_, y)) => [x, HOLogic.mk_not y] + |> map (HOLogic.mk_Trueprop o curry subst_bounds (List.rev fun_args)) + |> curry list_comb @{const ==>}); - fun currys Ts t = if length Ts <= 1 then t else - t $ foldr1 (fn (u, v) => HOLogic.pair_const dummyT dummyT $ u $ v) - (length Ts - 1 downto 0 |> map Bound) - |> fold_rev (fn T => fn u => Abs (Name.uu, T, u)) Ts; +val _ = tracing ("proof obligations:\n \ " ^ + space_implode "\n \ " (map (Syntax.string_of_term lthy) proof_obligations)); + in map (list_comb o rpair corec_args) corecs |> map2 (fn Ts => fn t => if length Ts = 0 then t $ HOLogic.unit else t) arg_Tss diff -r d92578436d47 -r d2a7b6fe953e src/HOL/BNF/Tools/bnf_fp_rec_sugar_util.ML --- a/src/HOL/BNF/Tools/bnf_fp_rec_sugar_util.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/HOL/BNF/Tools/bnf_fp_rec_sugar_util.ML Fri Sep 06 10:57:27 2013 +0200 @@ -198,11 +198,11 @@ fun massage_indirect_corec_call ctxt has_call massage_direct_call bound_Ts res_U t = let val typof = curry fastype_of1 bound_Ts; - val build_map_Inl = build_map ctxt (uncurry Inl_const o dest_sumT o fst); + val build_map_Inl = build_map ctxt (uncurry Inl_const o dest_sumT o snd) fun check_and_massage_direct_call U T t = if has_call t then factor_out_types ctxt massage_direct_call dest_sumT U T t - else build_map_Inl (U, T) $ t; + else build_map_Inl (T, U) $ t; fun check_and_massage_unapplied_direct_call U T t = let val var = Var ((Name.uu, Term.maxidx_of_term t + 1), domain_type (typof t)) in @@ -241,11 +241,11 @@ | NONE => (case t of t1 $ t2 => - if has_call t2 then + (if has_call t2 then check_and_massage_direct_call U T t else massage_map U T t1 $ t2 - handle AINT_NO_MAP _ => check_and_massage_direct_call U T t + handle AINT_NO_MAP _ => check_and_massage_direct_call U T t) | _ => check_and_massage_direct_call U T t)) | _ => ill_formed_corec_call ctxt t)) U T diff -r d92578436d47 -r d2a7b6fe953e src/HOL/List.thy --- a/src/HOL/List.thy Fri Sep 06 10:56:40 2013 +0200 +++ b/src/HOL/List.thy Fri Sep 06 10:57:27 2013 +0200 @@ -548,9 +548,9 @@ fun check (i, case_t) s = (case strip_abs_body case_t of (Const (@{const_name List.Nil}, _)) => s - | _ => (case s of NONE => SOME i | SOME _ => NONE)) + | _ => (case s of SOME NONE => SOME (SOME i) | _ => NONE)) in - fold_index check cases NONE + fold_index check cases (SOME NONE) |> the_default NONE end (* returns (case_expr type index chosen_case) option *) fun dest_case case_term = diff -r d92578436d47 -r d2a7b6fe953e src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy --- a/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Fri Sep 06 10:56:40 2013 +0200 +++ b/src/HOL/Multivariate_Analysis/Convex_Euclidean_Space.thy Fri Sep 06 10:57:27 2013 +0200 @@ -34,8 +34,8 @@ using assms convex_def[of S] by auto lemma mem_convex_alt: - assumes "convex S" "x : S" "y : S" "u>=0" "v>=0" "u+v>0" - shows "((u/(u+v)) *\<^sub>R x + (v/(u+v)) *\<^sub>R y) : S" + assumes "convex S" "x \ S" "y \ S" "u \ 0" "v \ 0" "u + v > 0" + shows "((u/(u+v)) *\<^sub>R x + (v/(u+v)) *\<^sub>R y) \ S" apply (subst mem_convex_2) using assms apply (auto simp add: algebra_simps zero_le_divide_iff) @@ -74,20 +74,20 @@ fixes f :: "'n::euclidean_space \ 'm::euclidean_space" assumes lf: "linear f" and fi: "inj_on f (span S)" - shows "dim (f ` S) = dim (S:: 'n::euclidean_space set)" -proof - - obtain B where B_def: "B \ S \ independent B \ S \ span B \ card B = dim S" + shows "dim (f ` S) = dim (S::'n::euclidean_space set)" +proof - + obtain B where B: "B \ S" "independent B" "S \ span B" "card B = dim S" using basis_exists[of S] by auto then have "span S = span B" using span_mono[of B S] span_mono[of S "span B"] span_span[of B] by auto then have "independent (f ` B)" - using independent_injective_on_span_image[of B f] B_def assms by auto + using independent_injective_on_span_image[of B f] B assms by auto moreover have "card (f ` B) = card B" - using assms card_image[of f B] subset_inj_on[of f "span S" B] B_def span_inc by auto + using assms card_image[of f B] subset_inj_on[of f "span S" B] B span_inc by auto moreover have "(f ` B) \ (f ` S)" - using B_def by auto + using B by auto ultimately have "dim (f ` S) \ dim S" - using independent_card_le_dim[of "f ` B" "f ` S"] B_def by auto + using independent_card_le_dim[of "f ` B" "f ` S"] B by auto then show ?thesis using dim_image_le[of f S] assms by auto qed @@ -220,8 +220,6 @@ and C: "C \ T" "independent C" "T \ span C" "card C = dim T" shows "\f. linear f \ f ` B = C \ f ` S = T \ inj_on f S" proof - -(* Proof is a modified copy of the proof of similar lemma subspace_isomorphism -*) from B independent_bound have fB: "finite B" by blast from C independent_bound have fC: "finite C" @@ -293,9 +291,6 @@ then show ?thesis using closure_linear_image[of f S] assms by auto qed -lemma closure_direct_sum: "closure (S \ T) = closure S \ closure T" - by (rule closure_Times) - lemma closure_scaleR: fixes S :: "'a::real_normed_vector set" shows "(op *\<^sub>R c) ` (closure S) = closure ((op *\<^sub>R c) ` S)" @@ -367,7 +362,7 @@ by (auto simp add:norm_minus_commute) qed -lemma norm_minus_eqI:"x = - y \ norm x = norm y" by auto +lemma norm_minus_eqI: "x = - y \ norm x = norm y" by auto lemma Min_grI: assumes "finite A" "A \ {}" "\a\A. x < a" @@ -8668,7 +8663,7 @@ have "(closure S) + (closure T) = (\(x,y). x + y) ` (closure S \ closure T)" by (simp add: set_plus_image) also have "... = (\(x,y). x + y) ` closure (S \ T)" - using closure_direct_sum by auto + using closure_Times by auto also have "... \ closure (S + T)" using fst_snd_linear closure_linear_image[of "(\(x,y). x + y)" "S \ T"] by (auto simp: set_plus_image) diff -r d92578436d47 -r d2a7b6fe953e src/HOL/Multivariate_Analysis/Integration.thy --- a/src/HOL/Multivariate_Analysis/Integration.thy Fri Sep 06 10:56:40 2013 +0200 +++ b/src/HOL/Multivariate_Analysis/Integration.thy Fri Sep 06 10:57:27 2013 +0200 @@ -1,6 +1,8 @@ +(* Author: John Harrison + Author: Robert Himmelmann, TU Muenchen (Translation from HOL light) +*) + header {* Kurzweil-Henstock Gauge Integration in many dimensions. *} -(* Author: John Harrison - Translation from HOL light: Robert Himmelmann, TU Muenchen *) theory Integration imports @@ -11,62 +13,76 @@ lemma cSup_abs_le: (* TODO: is this really needed? *) fixes S :: "real set" shows "S \ {} \ (\x\S. \x\ \ a) \ \Sup S\ \ a" -by (auto simp add: abs_le_interval_iff intro: cSup_least) (metis cSup_upper2) + by (auto simp add: abs_le_interval_iff intro: cSup_least) (metis cSup_upper2) lemma cInf_abs_ge: (* TODO: is this really needed? *) fixes S :: "real set" shows "S \ {} \ (\x\S. \x\ \ a) \ \Inf S\ \ a" -by (simp add: Inf_real_def) (rule cSup_abs_le, auto) + by (simp add: Inf_real_def) (rule cSup_abs_le, auto) lemma cSup_asclose: (* TODO: is this really needed? *) fixes S :: "real set" - assumes S:"S \ {}" and b: "\x\S. \x - l\ \ e" shows "\Sup S - l\ \ e" -proof- - have th: "\(x::real) l e. \x - l\ \ e \ l - e \ x \ x \ l + e" by arith - thus ?thesis using S b cSup_bounds[of S "l - e" "l+e"] unfolding th - by (auto simp add: setge_def setle_def) + assumes S: "S \ {}" + and b: "\x\S. \x - l\ \ e" + shows "\Sup S - l\ \ e" +proof - + have th: "\(x::real) l e. \x - l\ \ e \ l - e \ x \ x \ l + e" + by arith + then show ?thesis + using S b cSup_bounds[of S "l - e" "l+e"] + unfolding th + by (auto simp add: setge_def setle_def) qed lemma cInf_asclose: (* TODO: is this really needed? *) fixes S :: "real set" - assumes S:"S \ {}" and b: "\x\S. \x - l\ \ e" shows "\Inf S - l\ \ e" + assumes S: "S \ {}" + and b: "\x\S. \x - l\ \ e" + shows "\Inf S - l\ \ e" proof - have "\- Sup (uminus ` S) - l\ = \Sup (uminus ` S) - (-l)\" by auto - also have "... \ e" - apply (rule cSup_asclose) + also have "\ \ e" + apply (rule cSup_asclose) apply (auto simp add: S) apply (metis abs_minus_add_cancel b add_commute diff_minus) done finally have "\- Sup (uminus ` S) - l\ \ e" . - thus ?thesis + then show ?thesis by (simp add: Inf_real_def) qed -lemma cSup_finite_ge_iff: - fixes S :: "real set" shows "finite S \ S \ {} \ a \ Sup S \ (\x\S. a \ x)" +lemma cSup_finite_ge_iff: + fixes S :: "real set" + shows "finite S \ S \ {} \ a \ Sup S \ (\x\S. a \ x)" by (metis cSup_eq_Max Max_ge_iff) -lemma cSup_finite_le_iff: - fixes S :: "real set" shows "finite S \ S \ {} \ a \ Sup S \ (\x\S. a \ x)" +lemma cSup_finite_le_iff: + fixes S :: "real set" + shows "finite S \ S \ {} \ a \ Sup S \ (\x\S. a \ x)" by (metis cSup_eq_Max Max_le_iff) -lemma cInf_finite_ge_iff: - fixes S :: "real set" shows "finite S \ S \ {} \ a \ Inf S \ (\x\S. a \ x)" +lemma cInf_finite_ge_iff: + fixes S :: "real set" + shows "finite S \ S \ {} \ a \ Inf S \ (\x\S. a \ x)" by (metis cInf_eq_Min Min_ge_iff) -lemma cInf_finite_le_iff: - fixes S :: "real set" shows "finite S \ S \ {} \ a \ Inf S \ (\x\S. a \ x)" +lemma cInf_finite_le_iff: + fixes S :: "real set" + shows "finite S \ S \ {} \ a \ Inf S \ (\x\S. a \ x)" by (metis cInf_eq_Min Min_le_iff) lemma Inf: (* rename *) fixes S :: "real set" - shows "S \ {} ==> (\b. b <=* S) ==> isGlb UNIV S (Inf S)" -by (auto simp add: isLb_def setle_def setge_def isGlb_def greatestP_def intro: cInf_lower cInf_greatest) - + shows "S \ {} \ (\b. b <=* S) \ isGlb UNIV S (Inf S)" + by (auto simp add: isLb_def setle_def setge_def isGlb_def greatestP_def + intro: cInf_lower cInf_greatest) + lemma real_le_inf_subset: - assumes "t \ {}" "t \ s" "\b. b <=* s" - shows "Inf s <= Inf (t::real set)" + assumes "t \ {}" + and "t \ s" + and "\b. b <=* s" + shows "Inf s \ Inf (t::real set)" apply (rule isGlb_le_isLb) apply (rule Inf[OF assms(1)]) apply (insert assms) @@ -76,8 +92,11 @@ done lemma real_ge_sup_subset: - assumes "t \ {}" "t \ s" "\b. s *<= b" - shows "Sup s >= Sup (t::real set)" + fixes t :: "real set" + assumes "t \ {}" + and "t \ s" + and "\b. s *<= b" + shows "Sup s \ Sup t" apply (rule isLub_le_isUb) apply (rule isLub_cSup[OF assms(1)]) apply (insert assms) @@ -104,9 +123,10 @@ lemma conjunctD4: assumes "a \ b \ c \ d" shows a b c d using assms by auto lemma conjunctD5: assumes "a \ b \ c \ d \ e" shows a b c d e using assms by auto -declare norm_triangle_ineq4[intro] - -lemma simple_image: "{f x |x . x \ s} = f ` s" by blast +declare norm_triangle_ineq4[intro] + +lemma simple_image: "{f x |x . x \ s} = f ` s" + by blast lemma linear_simps: assumes "bounded_linear f" @@ -123,24 +143,30 @@ lemma bounded_linearI: assumes "\x y. f (x + y) = f x + f y" - and "\r x. f (r *\<^sub>R x) = r *\<^sub>R f x" "\x. norm (f x) \ norm x * K" + and "\r x. f (r *\<^sub>R x) = r *\<^sub>R f x" + and "\x. norm (f x) \ norm x * K" shows "bounded_linear f" - unfolding bounded_linear_def additive_def bounded_linear_axioms_def using assms by auto + unfolding bounded_linear_def additive_def bounded_linear_axioms_def + using assms by auto lemma bounded_linear_component [intro]: "bounded_linear (\x::'a::euclidean_space. x \ k)" by (rule bounded_linear_inner_left) lemma transitive_stepwise_lt_eq: assumes "(\x y z::nat. R x y \ R y z \ R x z)" - shows "((\m. \n>m. R m n) \ (\n. R n (Suc n)))" (is "?l = ?r") -proof (safe) + shows "((\m. \n>m. R m n) \ (\n. R n (Suc n)))" + (is "?l = ?r") +proof safe assume ?r fix n m :: nat assume "m < n" then show "R m n" proof (induct n arbitrary: m) + case 0 + then show ?case by auto + next case (Suc n) - show ?case + show ?case proof (cases "m < n") case True show ?thesis @@ -150,14 +176,16 @@ done next case False - then have "m = n" using Suc(2) by auto - then show ?thesis using `?r` by auto + then have "m = n" + using Suc(2) by auto + then show ?thesis + using `?r` by auto qed - qed auto + qed qed auto lemma transitive_stepwise_gt: - assumes "\x y z. R x y \ R y z \ R x z" "\n. R n (Suc n) " + assumes "\x y z. R x y \ R y z \ R x z" "\n. R n (Suc n)" shows "\n>m. R m n" proof - have "\m. \n>m. R m n" @@ -172,12 +200,13 @@ lemma transitive_stepwise_le_eq: assumes "\x. R x x" "\x y z. R x y \ R y z \ R x z" - shows "(\m. \n\m. R m n) \ (\n. R n (Suc n))" (is "?l = ?r") + shows "(\m. \n\m. R m n) \ (\n. R n (Suc n))" + (is "?l = ?r") proof safe assume ?r fix m n :: nat assume "m \ n" - thus "R m n" + then show "R m n" proof (induct n arbitrary: m) case 0 with assms show ?case by auto @@ -193,21 +222,25 @@ done next case False - hence "m = Suc n" using Suc(2) by auto - thus ?thesis using assms(1) by auto + then have "m = Suc n" + using Suc(2) by auto + then show ?thesis + using assms(1) by auto qed qed qed auto lemma transitive_stepwise_le: - assumes "\x. R x x" "\x y z. R x y \ R y z \ R x z" "\n. R n (Suc n) " + assumes "\x. R x x" "\x y z. R x y \ R y z \ R x z" + and "\n. R n (Suc n)" shows "\n\m. R m n" proof - have "\m. \n\m. R m n" apply (subst transitive_stepwise_le_eq) apply (rule assms) apply (rule assms,assumption,assumption) - using assms(3) apply auto + using assms(3) + apply auto done then show ?thesis by auto qed @@ -215,14 +248,18 @@ subsection {* Some useful lemmas about intervals. *} -abbreviation One where "One \ ((\Basis)::_::euclidean_space)" +abbreviation One :: "'a::euclidean_space" + where "One \ \Basis" lemma empty_as_interval: "{} = {One..(0::'a::ordered_euclidean_space)}" by (auto simp: set_eq_iff eucl_le[where 'a='a] intro!: bexI[OF _ SOME_Basis]) -lemma interior_subset_union_intervals: - assumes "i = {a..b::'a::ordered_euclidean_space}" "j = {c..d}" - "interior j \ {}" "i \ j \ s" "interior(i) \ interior(j) = {}" +lemma interior_subset_union_intervals: + assumes "i = {a..b::'a::ordered_euclidean_space}" + and "j = {c..d}" + and "interior j \ {}" + and "i \ j \ s" + and "interior i \ interior j = {}" shows "interior i \ interior s" proof - have "{a<.. {c..d} = {}" @@ -247,9 +284,12 @@ lemma inter_interior_unions_intervals: fixes f::"('a::ordered_euclidean_space) set set" - assumes "finite f" "open s" "\t\f. \a b. t = {a..b}" "\t\f. s \ (interior t) = {}" - shows "s \ interior(\f) = {}" -proof (rule ccontr, unfold ex_in_conv[THEN sym]) + assumes "finite f" + and "open s" + and "\t\f. \a b. t = {a..b}" + and "\t\f. s \ (interior t) = {}" + shows "s \ interior (\f) = {}" +proof (rule ccontr, unfold ex_in_conv[symmetric]) case goal1 have lem1: "\x e s U. ball x e \ s \ interior U \ ball x e \ s \ U" apply rule @@ -260,42 +300,53 @@ apply auto done have lem2: "\x s P. \x\s. P x \ \x\insert x s. P x" by auto - have "\f. finite f \ (\t\f. \a b. t = {a..b}) \ - (\x. x \ s \ interior (\f)) \ (\t\f. \x. \e>0. ball x e \ s \ t)" + have "\f. finite f \ \t\f. \a b. t = {a..b} \ + \x. x \ s \ interior (\f) \ \t\f. \x. \e>0. ball x e \ s \ t" proof - case goal1 then show ?case proof (induct rule: finite_induct) - case empty from this(2) guess x .. - hence False unfolding Union_empty interior_empty by auto - thus ?case by auto + case empty + obtain x where "x \ s \ interior (\{})" + using empty(2) .. + then have False + unfolding Union_empty interior_empty by auto + then show ?case by auto next - case (insert i f) guess x using insert(5) .. note x = this - then guess e unfolding open_contains_ball_eq[OF open_Int[OF assms(2) open_interior],rule_format] .. note e=this - guess a using insert(4)[rule_format,OF insertI1] .. - then guess b .. note ab = this + case (insert i f) + obtain x where x: "x \ s \ interior (\insert i f)" + using insert(5) .. + then obtain e where e: "0 < e \ ball x e \ s \ interior (\insert i f)" + unfolding open_contains_ball_eq[OF open_Int[OF assms(2) open_interior], rule_format] .. + obtain a where "\b. i = {a..b}" + using insert(4)[rule_format,OF insertI1] .. + then obtain b where ab: "i = {a..b}" .. show ?case - proof (cases "x\i") + proof (cases "x \ i") case False - hence "x \ UNIV - {a..b}" unfolding ab by auto - then guess d unfolding open_contains_ball_eq[OF open_Diff[OF open_UNIV closed_interval],rule_format] .. - hence "0 < d" "ball x (min d e) \ UNIV - i" unfolding ab ball_min_Int by auto - hence "ball x (min d e) \ s \ interior (\f)" + then have "x \ UNIV - {a..b}" + unfolding ab by auto + then obtain d where "0 < d \ ball x d \ UNIV - {a..b}" + unfolding open_contains_ball_eq[OF open_Diff[OF open_UNIV closed_interval],rule_format] .. + then have "0 < d" "ball x (min d e) \ UNIV - i" + unfolding ab ball_min_Int by auto + then have "ball x (min d e) \ s \ interior (\f)" using e unfolding lem1 unfolding ball_min_Int by auto - hence "x \ s \ interior (\f)" using `d>0` e by auto - hence "\t\f. \x e. 0 < e \ ball x e \ s \ t" + then have "x \ s \ interior (\f)" using `d>0` e by auto + then have "\t\f. \x e. 0 < e \ ball x e \ s \ t" apply - apply (rule insert(3)) using insert(4) apply auto done - thus ?thesis by auto + then show ?thesis by auto next case True show ?thesis proof (cases "x\{a<.. ball x d \ {a<..k \ a\k \ x\k \ b\k" and k:"k\Basis" + then obtain k where "x\k \ a\k \ x\k \ b\k" and k: "k \ Basis" unfolding mem_interval by (auto simp add: not_less) - hence "x\k = a\k \ x\k = b\k" + then have "x\k = a\k \ x\k = b\k" using True unfolding ab and mem_interval apply (erule_tac x = k in ballE) apply auto done - hence "\x. ball x (e/2) \ s \ (\f)" - proof (erule_tac disjE) + then have "\x. ball x (e/2) \ s \ (\f)" + proof (rule disjE) let ?z = "x - (e/2) *\<^sub>R k" assume as: "x\k = a\k" have "ball ?z (e / 2) \ i = {}" apply (rule ccontr) - unfolding ex_in_conv[THEN sym] - proof (erule exE) + unfolding ex_in_conv[symmetric] + apply (erule exE) + proof - fix y assume "y \ ball ?z (e / 2) \ i" - hence "dist ?z y < e/2" and yi:"y\i" by auto - hence "\(?z - y) \ k\ < e/2" + then have "dist ?z y < e/2" and yi:"y\i" by auto + then have "\(?z - y) \ k\ < e/2" using Basis_le_norm[OF k, of "?z - y"] unfolding dist_norm by auto - hence "y\k < a\k" - using e[THEN conjunct1] k by (auto simp add: field_simps as inner_Basis inner_simps) - hence "y \ i" + then have "y\k < a\k" + using e[THEN conjunct1] k + by (auto simp add: field_simps as inner_Basis inner_simps) + then have "y \ i" unfolding ab mem_interval by (auto intro!: bexI[OF _ k]) - thus False using yi by auto + then show False using yi by auto qed moreover have "ball ?z (e/2) \ s \ (\insert i f)" - apply(rule order_trans[OF _ e[THEN conjunct2, unfolded lem1]]) + apply (rule order_trans[OF _ e[THEN conjunct2, unfolded lem1]]) proof fix y - assume as: "y\ ball ?z (e/2)" + assume as: "y \ ball ?z (e/2)" have "norm (x - y) \ \e\ / 2 + norm (x - y - (e / 2) *\<^sub>R k)" apply - apply (rule order_trans,rule norm_triangle_sub[of "x - y" "(e/2) *\<^sub>R k"]) @@ -348,7 +401,7 @@ using e apply (auto simp add: field_simps) done - finally show "y\ball x e" + finally show "y \ ball x e" unfolding mem_ball dist_norm using e by (auto simp add:field_simps) qed ultimately show ?thesis @@ -361,18 +414,22 @@ assume as: "x\k = b\k" have "ball ?z (e / 2) \ i = {}" apply (rule ccontr) - unfolding ex_in_conv[THEN sym] - proof(erule exE) + unfolding ex_in_conv[symmetric] + apply (erule exE) + proof - fix y assume "y \ ball ?z (e / 2) \ i" - hence "dist ?z y < e/2" and yi:"y\i" by auto - hence "\(?z - y) \ k\ < e/2" - using Basis_le_norm[OF k, of "?z - y"] unfolding dist_norm by auto - hence "y\k > b\k" - using e[THEN conjunct1] k by(auto simp add:field_simps inner_simps inner_Basis as) - hence "y \ i" + then have "dist ?z y < e/2" and yi: "y \ i" + by auto + then have "\(?z - y) \ k\ < e/2" + using Basis_le_norm[OF k, of "?z - y"] + unfolding dist_norm by auto + then have "y\k > b\k" + using e[THEN conjunct1] k + by (auto simp add:field_simps inner_simps inner_Basis as) + then have "y \ i" unfolding ab mem_interval by (auto intro!: bexI[OF _ k]) - thus False using yi by auto + then show False using yi by auto qed moreover have "ball ?z (e/2) \ s \ (\insert i f)" @@ -382,7 +439,7 @@ assume as: "y\ ball ?z (e/2)" have "norm (x - y) \ \e\ / 2 + norm (x - y + (e / 2) *\<^sub>R k)" apply - - apply(rule order_trans,rule norm_triangle_sub[of "x - y" "- (e/2) *\<^sub>R k"]) + apply (rule order_trans,rule norm_triangle_sub[of "x - y" "- (e/2) *\<^sub>R k"]) unfolding norm_scaleR apply (auto simp: k) done @@ -391,79 +448,81 @@ using as unfolding mem_ball dist_norm using e apply (auto simp add: field_simps) done - finally show "y\ball x e" - unfolding mem_ball dist_norm using e by(auto simp add:field_simps) + finally show "y \ ball x e" + unfolding mem_ball dist_norm using e by (auto simp add:field_simps) qed ultimately show ?thesis apply (rule_tac x="?z" in exI) unfolding Union_insert apply auto done - qed - then guess x .. - hence "x \ s \ interior (\f)" - unfolding lem1[where U="\f",THEN sym] + qed + then obtain x where "ball x (e / 2) \ s \ \f" .. + then have "x \ s \ interior (\f)" + unfolding lem1[where U="\f", symmetric] using centre_in_ball e[THEN conjunct1] by auto - thus ?thesis + then show ?thesis apply - apply (rule lem2, rule insert(3)) - using insert(4) apply auto + using insert(4) + apply auto done qed qed qed qed - note * = this - guess t using *[OF assms(1,3) goal1] .. - from this(2) guess x .. - then guess e .. - hence "x \ s" "x\interior t" - defer - using open_subset_interior[OF open_ball, of x e t] apply auto - done - thus False using `t\f` assms(4) by auto + from this[OF assms(1,3) goal1] + obtain t x e where "t \ f" "0 < e" "ball x e \ s \ t" + by blast + then have "x \ s" "x \ interior t" + using open_subset_interior[OF open_ball, of x e t] + by auto + then show False + using `t \ f` assms(4) by auto qed subsection {* Bounds on intervals where they exist. *} -definition interval_upperbound :: "('a::ordered_euclidean_space) set \ 'a" where - "interval_upperbound s = (\i\Basis. Sup {a. \x\s. x\i = a} *\<^sub>R i)" - -definition interval_lowerbound :: "('a::ordered_euclidean_space) set \ 'a" where - "interval_lowerbound s = (\i\Basis. Inf {a. \x\s. x\i = a} *\<^sub>R i)" +definition interval_upperbound :: "('a::ordered_euclidean_space) set \ 'a" + where "interval_upperbound s = (\i\Basis. Sup {a. \x\s. x\i = a} *\<^sub>R i)" + +definition interval_lowerbound :: "('a::ordered_euclidean_space) set \ 'a" + where "interval_lowerbound s = (\i\Basis. Inf {a. \x\s. x\i = a} *\<^sub>R i)" lemma interval_upperbound[simp]: "\i\Basis. a\i \ b\i \ interval_upperbound {a..b} = (b::'a::ordered_euclidean_space)" unfolding interval_upperbound_def euclidean_representation_setsum by (auto simp del: ex_simps simp add: Bex_def ex_simps[symmetric] eucl_le[where 'a='a] setle_def - intro!: cSup_unique) + intro!: cSup_unique) lemma interval_lowerbound[simp]: "\i\Basis. a\i \ b\i \ interval_lowerbound {a..b} = (a::'a::ordered_euclidean_space)" unfolding interval_lowerbound_def euclidean_representation_setsum by (auto simp del: ex_simps simp add: Bex_def ex_simps[symmetric] eucl_le[where 'a='a] setge_def - intro!: cInf_unique) + intro!: cInf_unique) lemmas interval_bounds = interval_upperbound interval_lowerbound lemma interval_bounds'[simp]: - assumes "{a..b}\{}" - shows "interval_upperbound {a..b} = b" "interval_lowerbound {a..b} = a" + assumes "{a..b} \ {}" + shows "interval_upperbound {a..b} = b" + and "interval_lowerbound {a..b} = a" using assms unfolding interval_ne_empty by auto + subsection {* Content (length, area, volume...) of an interval. *} definition "content (s::('a::ordered_euclidean_space) set) = (if s = {} then 0 else (\i\Basis. (interval_upperbound s)\i - (interval_lowerbound s)\i))" -lemma interval_not_empty:"\i\Basis. a\i \ b\i \ {a..b::'a::ordered_euclidean_space} \ {}" +lemma interval_not_empty: "\i\Basis. a\i \ b\i \ {a..b::'a::ordered_euclidean_space} \ {}" unfolding interval_eq_empty unfolding not_ex not_less by auto lemma content_closed_interval: - fixes a::"'a::ordered_euclidean_space" + fixes a :: "'a::ordered_euclidean_space" assumes "\i\Basis. a\i \ b\i" shows "content {a..b} = (\i\Basis. b\i - a\i)" using interval_not_empty[OF assms] @@ -471,8 +530,8 @@ by auto lemma content_closed_interval': - fixes a::"'a::ordered_euclidean_space" - assumes "{a..b}\{}" + fixes a :: "'a::ordered_euclidean_space" + assumes "{a..b} \ {}" shows "content {a..b} = (\i\Basis. b\i - a\i)" apply (rule content_closed_interval) using assms @@ -480,13 +539,8 @@ apply assumption done -lemma content_real: - assumes "a\b" - shows "content {a..b} = b-a" -proof - - have *: "{.. b \ content {a..b} = b - a" + unfolding content_def by auto lemma content_singleton[simp]: "content {a} = 0" proof - @@ -497,9 +551,12 @@ lemma content_unit[intro]: "content{0..One::'a::ordered_euclidean_space} = 1" proof - - have *: "\i\Basis. (0::'a)\i \ (One::'a)\i" by auto - have "0 \ {0..One::'a}" unfolding mem_interval by auto - thus ?thesis unfolding content_def interval_bounds[OF *] using setprod_1 by auto + have *: "\i\Basis. (0::'a)\i \ (One::'a)\i" + by auto + have "0 \ {0..One::'a}" + unfolding mem_interval by auto + then show ?thesis + unfolding content_def interval_bounds[OF *] using setprod_1 by auto qed lemma content_pos_le[intro]: @@ -507,7 +564,8 @@ shows "0 \ content {a..b}" proof (cases "{a..b} = {}") case False - hence *: "\i\Basis. a \ i \ b \ i" unfolding interval_ne_empty . + then have *: "\i\Basis. a \ i \ b \ i" + unfolding interval_ne_empty . have "(\i\Basis. interval_upperbound {a..b} \ i - interval_lowerbound {a..b} \ i) \ 0" apply (rule setprod_nonneg) unfolding interval_bounds[OF *] @@ -515,29 +573,38 @@ apply (erule_tac x=x in ballE) apply auto done - thus ?thesis unfolding content_def by (auto simp del:interval_bounds') -qed (unfold content_def, auto) + then show ?thesis + unfolding content_def by (auto simp del:interval_bounds') +next + case True + then show ?thesis + unfolding content_def by auto +qed lemma content_pos_lt: - fixes a::"'a::ordered_euclidean_space" + fixes a :: "'a::ordered_euclidean_space" assumes "\i\Basis. a\i < b\i" shows "0 < content {a..b}" proof - have help_lemma1: "\i\Basis. a\i < b\i \ \i\Basis. a\i \ ((b\i)::real)" - apply (rule, erule_tac x=i in ballE) + apply rule + apply (erule_tac x=i in ballE) apply auto done - show ?thesis unfolding content_closed_interval[OF help_lemma1[OF assms]] - apply(rule setprod_pos) - using assms apply (erule_tac x=x in ballE) + show ?thesis + unfolding content_closed_interval[OF help_lemma1[OF assms]] + apply (rule setprod_pos) + using assms + apply (erule_tac x=x in ballE) apply auto done qed -lemma content_eq_0: "content{a..b::'a::ordered_euclidean_space} = 0 \ (\i\Basis. b\i \ a\i)" +lemma content_eq_0: + "content{a..b::'a::ordered_euclidean_space} = 0 \ (\i\Basis. b\i \ a\i)" proof (cases "{a..b} = {}") case True - thus ?thesis + then show ?thesis unfolding content_def if_P[OF True] unfolding interval_eq_empty apply - @@ -547,15 +614,16 @@ done next case False - from this[unfolded interval_eq_empty not_ex not_less] - have as: "\i\Basis. b \ i \ a \ i" by fastforce - show ?thesis + then have "\i\Basis. b \ i \ a \ i" + unfolding interval_eq_empty not_ex not_less + by fastforce + then show ?thesis unfolding content_def if_not_P[OF False] setprod_zero_iff[OF finite_Basis] - using as by (auto intro!: bexI) qed -lemma cond_cases:"(P \ Q x) \ (\ P \ Q y) \ Q (if P then x else y)" by auto +lemma cond_cases: "(P \ Q x) \ (\ P \ Q y) \ Q (if P then x else y)" + by auto lemma content_closed_interval_cases: "content {a..b::'a::ordered_euclidean_space} = @@ -563,42 +631,51 @@ by (auto simp: not_le content_eq_0 intro: less_imp_le content_closed_interval) lemma content_eq_0_interior: "content {a..b} = 0 \ interior({a..b}) = {}" - unfolding content_eq_0 interior_closed_interval interval_eq_empty by auto - -lemma content_pos_lt_eq: "0 < content {a..b::'a::ordered_euclidean_space} \ (\i\Basis. a\i < b\i)" + unfolding content_eq_0 interior_closed_interval interval_eq_empty + by auto + +lemma content_pos_lt_eq: + "0 < content {a..b::'a::ordered_euclidean_space} \ (\i\Basis. a\i < b\i)" apply rule defer apply (rule content_pos_lt, assumption) proof - assume "0 < content {a..b}" - hence "content {a..b} \ 0" by auto - thus "\i\Basis. a\i < b\i" + then have "content {a..b} \ 0" by auto + then show "\i\Basis. a\i < b\i" unfolding content_eq_0 not_ex not_le by fastforce qed -lemma content_empty [simp]: "content {} = 0" unfolding content_def by auto +lemma content_empty [simp]: "content {} = 0" + unfolding content_def by auto lemma content_subset: assumes "{a..b} \ {c..d}" shows "content {a..b::'a::ordered_euclidean_space} \ content {c..d}" proof (cases "{a..b} = {}") case True - thus ?thesis using content_pos_le[of c d] by auto + then show ?thesis + using content_pos_le[of c d] by auto next case False - hence ab_ne:"\i\Basis. a \ i \ b \ i" unfolding interval_ne_empty by auto - hence ab_ab:"a\{a..b}" "b\{a..b}" unfolding mem_interval by auto + then have ab_ne: "\i\Basis. a \ i \ b \ i" + unfolding interval_ne_empty by auto + then have ab_ab: "a\{a..b}" "b\{a..b}" + unfolding mem_interval by auto have "{c..d} \ {}" using assms False by auto - hence cd_ne:"\i\Basis. c \ i \ d \ i" using assms unfolding interval_ne_empty by auto + then have cd_ne: "\i\Basis. c \ i \ d \ i" + using assms unfolding interval_ne_empty by auto show ?thesis unfolding content_def unfolding interval_bounds[OF ab_ne] interval_bounds[OF cd_ne] unfolding if_not_P[OF False] if_not_P[OF `{c..d} \ {}`] - apply (rule setprod_mono, rule) + apply (rule setprod_mono) + apply rule proof fix i :: 'a - assume i: "i\Basis" - show "0 \ b \ i - a \ i" using ab_ne[THEN bspec, OF i] i by auto + assume i: "i \ Basis" + show "0 \ b \ i - a \ i" + using ab_ne[THEN bspec, OF i] i by auto show "b \ i - a \ i \ d \ i - c \ i" using assms[unfolded subset_eq mem_interval,rule_format,OF ab_ab(2),of i] using assms[unfolded subset_eq mem_interval,rule_format,OF ab_ab(1),of i] @@ -612,58 +689,78 @@ subsection {* The notion of a gauge --- simply an open set containing the point. *} -definition gauge where "gauge d \ (\x. x\(d x) \ open(d x))" - -lemma gaugeI: assumes "\x. x\g x" "\x. open (g x)" shows "gauge g" +definition "gauge d \ (\x. x \ d x \ open (d x))" + +lemma gaugeI: + assumes "\x. x \ g x" + and "\x. open (g x)" + shows "gauge g" using assms unfolding gauge_def by auto -lemma gaugeD[dest]: assumes "gauge d" shows "x\d x" "open (d x)" +lemma gaugeD[dest]: + assumes "gauge d" + shows "x \ d x" + and "open (d x)" using assms unfolding gauge_def by auto lemma gauge_ball_dependent: "\x. 0 < e x \ gauge (\x. ball x (e x))" - unfolding gauge_def by auto - -lemma gauge_ball[intro]: "0 < e \ gauge (\x. ball x e)" unfolding gauge_def by auto + unfolding gauge_def by auto + +lemma gauge_ball[intro]: "0 < e \ gauge (\x. ball x e)" + unfolding gauge_def by auto lemma gauge_trivial[intro]: "gauge (\x. ball x 1)" by (rule gauge_ball) auto -lemma gauge_inter[intro]: "gauge d1 \ gauge d2 \ gauge (\x. (d1 x) \ (d2 x))" - unfolding gauge_def by auto +lemma gauge_inter[intro]: "gauge d1 \ gauge d2 \ gauge (\x. d1 x \ d2 x)" + unfolding gauge_def by auto lemma gauge_inters: - assumes "finite s" "\d\s. gauge (f d)" - shows "gauge(\x. \ {f d x | d. d \ s})" + assumes "finite s" + and "\d\s. gauge (f d)" + shows "gauge (\x. \ {f d x | d. d \ s})" proof - - have *:"\x. {f d x |d. d \ s} = (\d. f d x) ` s" by auto + have *: "\x. {f d x |d. d \ s} = (\d. f d x) ` s" + by auto show ?thesis - unfolding gauge_def unfolding * + unfolding gauge_def unfolding * using assms unfolding Ball_def Inter_iff mem_Collect_eq gauge_def by auto qed -lemma gauge_existence_lemma: "(\x. \d::real. p x \ 0 < d \ q d x) \ (\x. \d>0. p x \ q d x)" - by(meson zero_less_one) +lemma gauge_existence_lemma: + "(\x. \d :: real. p x \ 0 < d \ q d x) \ (\x. \d>0. p x \ q d x)" + by (metis zero_less_one) subsection {* Divisions. *} -definition division_of (infixl "division'_of" 40) where - "s division_of i \ - finite s \ - (\k\s. k \ i \ k \ {} \ (\a b. k = {a..b})) \ - (\k1\s. \k2\s. k1 \ k2 \ interior(k1) \ interior(k2) = {}) \ - (\s = i)" +definition division_of (infixl "division'_of" 40) +where + "s division_of i \ + finite s \ + (\k\s. k \ i \ k \ {} \ (\a b. k = {a..b})) \ + (\k1\s. \k2\s. k1 \ k2 \ interior(k1) \ interior(k2) = {}) \ + (\s = i)" lemma division_ofD[dest]: assumes "s division_of i" - shows "finite s" "\k. k\s \ k \ i" "\k. k\s \ k \ {}" "\k. k\s \ (\a b. k = {a..b})" - "\k1 k2. \k1\s; k2\s; k1 \ k2\ \ interior(k1) \ interior(k2) = {}" "\s = i" + shows "finite s" + and "\k. k \ s \ k \ i" + and "\k. k \ s \ k \ {}" + and "\k. k \ s \ \a b. k = {a..b}" + and "\k1 k2. k1 \ s \ k2 \ s \ k1 \ k2 \ interior(k1) \ interior(k2) = {}" + and "\s = i" using assms unfolding division_of_def by auto lemma division_ofI: - assumes "finite s" "\k. k\s \ k \ i" "\k. k\s \ k \ {}" "\k. k\s \ (\a b. k = {a..b})" - "\k1 k2. \k1\s; k2\s; k1 \ k2\ \ interior(k1) \ interior(k2) = {}" "\s = i" - shows "s division_of i" using assms unfolding division_of_def by auto + assumes "finite s" + and "\k. k \ s \ k \ i" + and "\k. k \ s \ k \ {}" + and "\k. k \ s \ \a b. k = {a..b}" + and "\k1 k2. k1 \ s \ k2 \ s \ k1 \ k2 \ interior k1 \ interior k2 = {}" + and "\s = i" + shows "s division_of i" + using assms unfolding division_of_def by auto lemma division_of_finite: "s division_of i \ finite s" unfolding division_of_def by auto @@ -671,28 +768,38 @@ lemma division_of_self[intro]: "{a..b} \ {} \ {{a..b}} division_of {a..b}" unfolding division_of_def by auto -lemma division_of_trivial[simp]: "s division_of {} \ s = {}" unfolding division_of_def by auto +lemma division_of_trivial[simp]: "s division_of {} \ s = {}" + unfolding division_of_def by auto lemma division_of_sing[simp]: - "s division_of {a..a::'a::ordered_euclidean_space} \ s = {{a..a}}" (is "?l = ?r") + "s division_of {a..a::'a::ordered_euclidean_space} \ s = {{a..a}}" + (is "?l = ?r") proof assume ?r - moreover { + moreover + { assume "s = {{a}}" - moreover fix k assume "k\s" + moreover fix k assume "k\s" ultimately have"\x y. k = {x..y}" apply (rule_tac x=a in exI)+ unfolding interval_sing apply auto done } - ultimately show ?l unfolding division_of_def interval_sing by auto + ultimately show ?l + unfolding division_of_def interval_sing by auto next assume ?l - note as=conjunctD4[OF this[unfolded division_of_def interval_sing]] - { fix x assume x:"x\s" have "x={a}" using as(2)[rule_format,OF x] by auto } - moreover have "s \ {}" using as(4) by auto - ultimately show ?r unfolding interval_sing by auto + note * = conjunctD4[OF this[unfolded division_of_def interval_sing]] + { + fix x + assume x: "x \ s" have "x = {a}" + using *(2)[rule_format,OF x] by auto + } + moreover have "s \ {}" + using *(4) by auto + ultimately show ?r + unfolding interval_sing by auto qed lemma elementary_empty: obtains p where "p division_of {}" @@ -705,27 +812,38 @@ unfolding division_of_def by auto lemma forall_in_division: - "d division_of i \ ((\x\d. P x) \ (\a b. {a..b} \ d \ P {a..b}))" + "d division_of i \ (\x\d. P x) \ (\a b. {a..b} \ d \ P {a..b})" unfolding division_of_def by fastforce -lemma division_of_subset: assumes "p division_of (\p)" "q \ p" shows "q division_of (\q)" - apply (rule division_ofI) -proof - - note as=division_ofD[OF assms(1)] +lemma division_of_subset: + assumes "p division_of (\p)" + and "q \ p" + shows "q division_of (\q)" +proof (rule division_ofI) + note * = division_ofD[OF assms(1)] show "finite q" apply (rule finite_subset) - using as(1) assms(2) apply auto + using *(1) assms(2) + apply auto done - { fix k + { + fix k assume "k \ q" - hence kp:"k\p" using assms(2) by auto - show "k\\q" using `k \ q` by auto - show "\a b. k = {a..b}" using as(4)[OF kp] - by auto show "k \ {}" using as(3)[OF kp] by auto } + then have kp: "k \ p" + using assms(2) by auto + show "k \ \q" + using `k \ q` by auto + show "\a b. k = {a..b}" + using *(4)[OF kp] by auto + show "k \ {}" + using *(3)[OF kp] by auto + } fix k1 k2 assume "k1 \ q" "k2 \ q" "k1 \ k2" - hence *: "k1\p" "k2\p" "k1\k2" using assms(2) by auto - show "interior k1 \ interior k2 = {}" using as(5)[OF *] by auto + then have **: "k1 \ p" "k2 \ p" "k1 \ k2" + using assms(2) by auto + show "interior k1 \ interior k2 = {}" + using *(5)[OF **] by auto qed auto lemma division_of_union_self[intro]: "p division_of s \ p division_of (\p)" @@ -740,52 +858,65 @@ apply (drule content_subset) unfolding assms(1) proof - case goal1 - thus ?case using content_pos_le[of a b] by auto + then show ?case using content_pos_le[of a b] by auto qed lemma division_inter: - assumes "p1 division_of s1" "p2 division_of (s2::('a::ordered_euclidean_space) set)" + fixes s1 s2 :: "'a::ordered_euclidean_space set" + assumes "p1 division_of s1" + and "p2 division_of s2" shows "{k1 \ k2 | k1 k2 .k1 \ p1 \ k2 \ p2 \ k1 \ k2 \ {}} division_of (s1 \ s2)" (is "?A' division_of _") proof - let ?A = "{s. s \ (\(k1,k2). k1 \ k2) ` (p1 \ p2) \ s \ {}}" - have *:"?A' = ?A" by auto - show ?thesis unfolding * + have *: "?A' = ?A" by auto + show ?thesis + unfolding * proof (rule division_ofI) - have "?A \ (\(x, y). x \ y) ` (p1 \ p2)" by auto - moreover have "finite (p1 \ p2)" using assms unfolding division_of_def by auto + have "?A \ (\(x, y). x \ y) ` (p1 \ p2)" + by auto + moreover have "finite (p1 \ p2)" + using assms unfolding division_of_def by auto ultimately show "finite ?A" by auto - have *:"\s. \{x\s. x \ {}} = \s" by auto + have *: "\s. \{x\s. x \ {}} = \s" + by auto show "\?A = s1 \ s2" apply (rule set_eqI) unfolding * and Union_image_eq UN_iff using division_ofD(6)[OF assms(1)] and division_ofD(6)[OF assms(2)] apply auto done - { fix k - assume "k\?A" - then obtain k1 k2 where k: "k = k1 \ k2" "k1\p1" "k2\p2" "k\{}" by auto - thus "k \ {}" by auto + { + fix k + assume "k \ ?A" + then obtain k1 k2 where k: "k = k1 \ k2" "k1 \ p1" "k2 \ p2" "k \ {}" + by auto + then show "k \ {}" + by auto show "k \ s1 \ s2" using division_ofD(2)[OF assms(1) k(2)] and division_ofD(2)[OF assms(2) k(3)] unfolding k by auto - guess a1 using division_ofD(4)[OF assms(1) k(2)] .. - then guess b1 .. note ab1=this - guess a2 using division_ofD(4)[OF assms(2) k(3)] .. - then guess b2 .. note ab2=this + obtain a1 b1 where k1: "k1 = {a1..b1}" + using division_ofD(4)[OF assms(1) k(2)] by blast + obtain a2 b2 where k2: "k2 = {a2..b2}" + using division_ofD(4)[OF assms(2) k(3)] by blast show "\a b. k = {a..b}" - unfolding k ab1 ab2 unfolding inter_interval by auto } + unfolding k k1 k2 unfolding inter_interval by auto + } fix k1 k2 - assume "k1\?A" - then obtain x1 y1 where k1:"k1 = x1 \ y1" "x1\p1" "y1\p2" "k1\{}" by auto - assume "k2\?A" - then obtain x2 y2 where k2:"k2 = x2 \ y2" "x2\p1" "y2\p2" "k2\{}" by auto + assume "k1 \ ?A" + then obtain x1 y1 where k1: "k1 = x1 \ y1" "x1 \ p1" "y1 \ p2" "k1 \ {}" + by auto + assume "k2 \ ?A" + then obtain x2 y2 where k2: "k2 = x2 \ y2" "x2 \ p1" "y2 \ p2" "k2 \ {}" + by auto assume "k1 \ k2" - hence th:"x1\x2 \ y1\y2" unfolding k1 k2 by auto - have *:"(interior x1 \ interior x2 = {} \ interior y1 \ interior y2 = {}) \ - interior(x1 \ y1) \ interior(x1) \ interior(x1 \ y1) \ interior(y1) \ - interior(x2 \ y2) \ interior(x2) \ interior(x2 \ y2) \ interior(y2) - \ interior(x1 \ y1) \ interior(x2 \ y2) = {}" by auto + then have th: "x1 \ x2 \ y1 \ y2" + unfolding k1 k2 by auto + have *: "interior x1 \ interior x2 = {} \ interior y1 \ interior y2 = {} \ + interior (x1 \ y1) \ interior x1 \ interior (x1 \ y1) \ interior y1 \ + interior (x2 \ y2) \ interior x2 \ interior (x2 \ y2) \ interior y2 \ + interior (x1 \ y1) \ interior (x2 \ y2) = {}" by auto show "interior k1 \ interior k2 = {}" unfolding k1 k2 apply (rule *) @@ -793,31 +924,41 @@ apply (rule_tac[1-4] interior_mono) using division_ofD(5)[OF assms(1) k1(2) k2(2)] using division_ofD(5)[OF assms(2) k1(3) k2(3)] - using th apply auto done + using th + apply auto + done qed qed lemma division_inter_1: - assumes "d division_of i" "{a..b::'a::ordered_euclidean_space} \ i" - shows "{ {a..b} \ k |k. k \ d \ {a..b} \ k \ {} } division_of {a..b}" + assumes "d division_of i" + and "{a..b::'a::ordered_euclidean_space} \ i" + shows "{{a..b} \ k | k. k \ d \ {a..b} \ k \ {}} division_of {a..b}" proof (cases "{a..b} = {}") case True - show ?thesis unfolding True and division_of_trivial by auto + show ?thesis + unfolding True and division_of_trivial by auto next case False have *: "{a..b} \ i = {a..b}" using assms(2) by auto - show ?thesis using division_inter[OF division_of_self[OF False] assms(1)] unfolding * by auto + show ?thesis + using division_inter[OF division_of_self[OF False] assms(1)] + unfolding * by auto qed lemma elementary_inter: - assumes "p1 division_of s" "p2 division_of (t::('a::ordered_euclidean_space) set)" + fixes s t :: "'a::ordered_euclidean_space set" + assumes "p1 division_of s" + and "p2 division_of t" shows "\p. p division_of (s \ t)" apply rule apply (rule division_inter[OF assms]) done lemma elementary_inters: - assumes "finite f" "f\{}" "\s\f. \p. p division_of (s::('a::ordered_euclidean_space) set)" + assumes "finite f" + and "f \ {}" + and "\s\f. \p. p division_of (s::('a::ordered_euclidean_space) set)" shows "\p. p division_of (\ f)" using assms proof (induct f rule: finite_induct) @@ -825,14 +966,18 @@ show ?case proof (cases "f = {}") case True - thus ?thesis unfolding True using insert by auto + then show ?thesis + unfolding True using insert by auto next case False - guess p using insert(3)[OF False insert(5)[unfolded ball_simps,THEN conjunct2]] .. - moreover guess px using insert(5)[rule_format,OF insertI1] .. + obtain p where "p division_of \f" + using insert(3)[OF False insert(5)[unfolded ball_simps,THEN conjunct2]] .. + moreover obtain px where "px division_of x" + using insert(5)[rule_format,OF insertI1] .. ultimately show ?thesis + apply - unfolding Inter_insert - apply (rule_tac elementary_inter) + apply (rule elementary_inter) apply assumption apply assumption done @@ -840,12 +985,17 @@ qed auto lemma division_disjoint_union: - assumes "p1 division_of s1" "p2 division_of s2" "interior s1 \ interior s2 = {}" + assumes "p1 division_of s1" + and "p2 division_of s2" + and "interior s1 \ interior s2 = {}" shows "(p1 \ p2) division_of (s1 \ s2)" proof (rule division_ofI) - note d1 = division_ofD[OF assms(1)] and d2 = division_ofD[OF assms(2)] - show "finite (p1 \ p2)" using d1(1) d2(1) by auto - show "\(p1 \ p2) = s1 \ s2" using d1(6) d2(6) by auto + note d1 = division_ofD[OF assms(1)] + note d2 = division_ofD[OF assms(2)] + show "finite (p1 \ p2)" + using d1(1) d2(1) by auto + show "\(p1 \ p2) = s1 \ s2" + using d1(6) d2(6) by auto { fix k1 k2 assume as: "k1 \ p1 \ p2" "k2 \ p1 \ p2" "k1 \ k2" @@ -864,28 +1014,33 @@ using interior_mono[OF d1(2)[OF as(2)]] interior_mono[OF d2(2)[OF as(1)]] using assms(3) by blast } - ultimately show ?g using d1(5)[OF _ _ as(3)] and d2(5)[OF _ _ as(3)] by auto + ultimately show ?g + using d1(5)[OF _ _ as(3)] and d2(5)[OF _ _ as(3)] by auto } fix k assume k: "k \ p1 \ p2" - show "k \ s1 \ s2" using k d1(2) d2(2) by auto - show "k \ {}" using k d1(3) d2(3) by auto - show "\a b. k = {a..b}" using k d1(4) d2(4) by auto + show "k \ s1 \ s2" + using k d1(2) d2(2) by auto + show "k \ {}" + using k d1(3) d2(3) by auto + show "\a b. k = {a..b}" + using k d1(4) d2(4) by auto qed lemma partial_division_extend_1: - assumes incl: "{c..d} \ {a..b::'a::ordered_euclidean_space}" + fixes a b c d :: "'a::ordered_euclidean_space" + assumes incl: "{c..d} \ {a..b}" and nonempty: "{c..d} \ {}" obtains p where "p division_of {a..b}" "{c..d} \ p" proof - let ?B = "\f::'a\'a \ 'a. {(\i\Basis. (fst (f i) \ i) *\<^sub>R i) .. (\i\Basis. (snd (f i) \ i) *\<^sub>R i)}" + let ?B = "\f::'a\'a \ 'a. + {(\i\Basis. (fst (f i) \ i) *\<^sub>R i) .. (\i\Basis. (snd (f i) \ i) *\<^sub>R i)}" def p \ "?B ` (Basis \\<^sub>E {(a, c), (c, d), (d, b)})" show "{c .. d} \ p" unfolding p_def by (auto simp add: interval_eq_empty eucl_le[where 'a='a] - intro!: image_eqI[where x="\(i::'a)\Basis. (c, d)"]) - + intro!: image_eqI[where x="\(i::'a)\Basis. (c, d)"]) { fix i :: 'a assume "i \ Basis" @@ -896,13 +1051,15 @@ show "p division_of {a..b}" proof (rule division_ofI) - show "finite p" unfolding p_def by (auto intro!: finite_PiE) + show "finite p" + unfolding p_def by (auto intro!: finite_PiE) { fix k assume "k \ p" then obtain f where f: "f \ Basis \\<^sub>E {(a, c), (c, d), (d, b)}" and k: "k = ?B f" by (auto simp: p_def) - then show "\a b. k = {a..b}" by auto + then show "\a b. k = {a..b}" + by auto have "k \ {a..b} \ k \ {}" proof (simp add: k interval_eq_empty subset_interval not_less, safe) fix i :: 'a @@ -913,50 +1070,55 @@ show "a \ i \ fst (f i) \ i" "snd (f i) \ i \ b \ i" "fst (f i) \ i \ snd (f i) \ i" by (auto simp: subset_iff eucl_le[where 'a='a]) qed - then show "k \ {}" "k \ {a .. b}" by auto + then show "k \ {}" "k \ {a .. b}" + by auto { - fix l assume "l \ p" + fix l + assume "l \ p" then obtain g where g: "g \ Basis \\<^sub>E {(a, c), (c, d), (d, b)}" and l: "l = ?B g" by (auto simp: p_def) assume "l \ k" have "\i\Basis. f i \ g i" proof (rule ccontr) - assume "\ (\i\Basis. f i \ g i)" + assume "\ ?thesis" with f g have "f = g" by (auto simp: PiE_iff extensional_def intro!: ext) with `l \ k` show False by (simp add: l k) qed - then guess i .. note * = this - moreover from * have "f i = (a, c) \ f i = (c, d) \ f i = (d, b)" + then obtain i where *: "i \ Basis" "f i \ g i" .. + then have "f i = (a, c) \ f i = (c, d) \ f i = (d, b)" "g i = (a, c) \ g i = (c, d) \ g i = (d, b)" using f g by (auto simp: PiE_iff) - moreover note ord[of i] - ultimately show "interior l \ interior k = {}" + with * ord[of i] show "interior l \ interior k = {}" by (auto simp add: l k interior_closed_interval disjoint_interval intro!: bexI[of _ i]) } - note `k \ { a.. b}` + note `k \ {a.. b}` } moreover { fix x assume x: "x \ {a .. b}" have "\i\Basis. \l. x \ i \ {fst l \ i .. snd l \ i} \ l \ {(a, c), (c, d), (d, b)}" proof - fix i :: 'a assume "i \ Basis" - with x ord[of i] + fix i :: 'a + assume "i \ Basis" + with x ord[of i] have "(a \ i \ x \ i \ x \ i \ c \ i) \ (c \ i \ x \ i \ x \ i \ d \ i) \ (d \ i \ x \ i \ x \ i \ b \ i)" by (auto simp: eucl_le[where 'a='a]) then show "\l. x \ i \ {fst l \ i .. snd l \ i} \ l \ {(a, c), (c, d), (d, b)}" by auto qed - then guess f unfolding bchoice_iff .. note f = this + then obtain f where + f: "\i\Basis. x \ i \ {fst (f i) \ i..snd (f i) \ i} \ f i \ {(a, c), (c, d), (d, b)}" + unfolding bchoice_iff .. moreover from f have "restrict f Basis \ Basis \\<^sub>E {(a, c), (c, d), (d, b)}" by auto moreover from f have "x \ ?B (restrict f Basis)" by (auto simp: mem_interval eucl_le[where 'a='a]) ultimately have "\k\p. x \ k" - unfolding p_def by blast } + unfolding p_def by blast + } ultimately show "\p = {a..b}" by auto qed @@ -967,8 +1129,9 @@ obtains q where "p \ q" "q division_of {a..b::'a::ordered_euclidean_space}" proof (cases "p = {}") case True - guess q apply (rule elementary_interval[of a b]) . - thus ?thesis + obtain q where "q division_of {a..b}" + by (rule elementary_interval) + then show ?thesis apply - apply (rule that[of q]) unfolding True @@ -977,31 +1140,36 @@ next case False note p = division_ofD[OF assms(1)] - have *: "\k\p. \q. q division_of {a..b} \ k\q" + have *: "\k\p. \q. q division_of {a..b} \ k \ q" proof case goal1 - guess c using p(4)[OF goal1] .. - then guess d .. note "cd" = this + obtain c d where k: "k = {c..d}" + using p(4)[OF goal1] by blast have *: "{c..d} \ {a..b}" "{c..d} \ {}" - using p(2,3)[OF goal1, unfolded "cd"] using assms(2) by auto - guess q apply(rule partial_division_extend_1[OF *]) . - thus ?case unfolding "cd" by auto + using p(2,3)[OF goal1, unfolded k] using assms(2) by auto + obtain q where "q division_of {a..b}" "{c..d} \ q" + by (rule partial_division_extend_1[OF *]) + then show ?case + unfolding k by auto qed - guess q using bchoice[OF *] .. note q = conjunctD2[OF this[rule_format]] - have "\x. x\p \ \d. d division_of \(q x - {x})" - apply (rule, rule_tac p="q x" in division_of_subset) + obtain q where q: "\x. x \ p \ q x division_of {a..b}" "\x. x \ p \ x \ q x" + using bchoice[OF *] by blast + have "\x. x \ p \ \d. d division_of \(q x - {x})" + apply rule + apply (rule_tac p="q x" in division_of_subset) proof - fix x - assume x: "x\p" + assume x: "x \ p" show "q x division_of \q x" apply - apply (rule division_ofI) using division_ofD[OF q(1)[OF x]] apply auto done - show "q x - {x} \ q x" by auto + show "q x - {x} \ q x" + by auto qed - hence "\d. d division_of \ ((\i. \(q i - {i})) ` p)" + then have "\d. d division_of \ ((\i. \(q i - {i})) ` p)" apply - apply (rule elementary_inters) apply (rule finite_imageI[OF p(1)]) @@ -1009,16 +1177,16 @@ apply (rule False) apply auto done - then guess d .. note d = this + then obtain d where d: "d division_of \((\i. \(q i - {i})) ` p)" .. show ?thesis apply (rule that[of "d \ p"]) proof - - have *: "\s f t. s \ {} \ (\i\s. f i \ i = t) \ t = \ (f ` s) \ (\s)" by auto - have *: "{a..b} = \ ((\i. \(q i - {i})) ` p) \ \p" + have *: "\s f t. s \ {} \ \i\s. f i \ i = t \ t = \(f ` s) \ \s" by auto + have *: "{a..b} = \((\i. \(q i - {i})) ` p) \ \p" apply (rule *[OF False]) proof fix i - assume i: "i\p" + assume i: "i \ p" show "\(q i - {i}) \ i = {a..b}" using division_ofD(6)[OF q(1)[OF i]] using q(2)[OF i] by auto qed @@ -1027,10 +1195,12 @@ apply (rule division_disjoint_union[OF d assms(1)]) apply (rule inter_interior_unions_intervals) apply (rule p open_interior ballI)+ - proof (assumption, rule) + apply assumption + proof fix k - assume k: "k\p" - have *: "\u t s. u \ s \ s \ t = {} \ u \ t = {}" by auto + assume k: "k \ p" + have *: "\u t s. u \ s \ s \ t = {} \ u \ t = {}" + by auto show "interior (\ ((\i. \(q i - {i})) ` p)) \ interior k = {}" apply (rule *[of _ "interior (\(q k - {k}))"]) defer @@ -1038,27 +1208,34 @@ apply (rule inter_interior_unions_intervals) proof - note qk=division_ofD[OF q(1)[OF k]] - show "finite (q k - {k})" "open (interior k)" - "\t\q k - {k}. \a b. t = {a..b}" using qk by auto + show "finite (q k - {k})" "open (interior k)" "\t\q k - {k}. \a b. t = {a..b}" + using qk by auto show "\t\q k - {k}. interior k \ interior t = {}" using qk(5) using q(2)[OF k] by auto - have *: "\x s. x \ s \ \s \ x" by auto + have *: "\x s. x \ s \ \s \ x" + by auto show "interior (\ ((\i. \(q i - {i})) ` p)) \ interior (\(q k - {k}))" apply (rule interior_mono *)+ - using k by auto + using k + apply auto + done qed qed qed auto qed -lemma elementary_bounded[dest]: "p division_of s \ bounded (s::('a::ordered_euclidean_space) set)" - unfolding division_of_def by(metis bounded_Union bounded_interval) - -lemma elementary_subset_interval: "p division_of s \ \a b. s \ {a..b::'a::ordered_euclidean_space}" +lemma elementary_bounded[dest]: + fixes s :: "'a::ordered_euclidean_space set" + shows "p division_of s \ bounded s" + unfolding division_of_def by (metis bounded_Union bounded_interval) + +lemma elementary_subset_interval: + "p division_of s \ \a b. s \ {a..b::'a::ordered_euclidean_space}" by (meson elementary_bounded bounded_subset_closed_interval) lemma division_union_intervals_exists: - assumes "{a..b::'a::ordered_euclidean_space} \ {}" + fixes a b :: "'a::ordered_euclidean_space" + assumes "{a..b} \ {}" obtains p where "(insert {a..b} p) division_of ({a..b} \ {c..d})" proof (cases "{c..d} = {}") case True @@ -1070,16 +1247,15 @@ done next case False - note false=this show ?thesis proof (cases "{a..b} \ {c..d} = {}") case True - have *:"\a b. {a,b} = {a} \ {b}" by auto + have *: "\a b. {a, b} = {a} \ {b}" by auto show ?thesis apply (rule that[of "{{c..d}}"]) unfolding * apply (rule division_disjoint_union) - using false True assms + using `{c..d} \ {}` True assms using interior_subset apply auto done @@ -1088,10 +1264,11 @@ obtain u v where uv: "{a..b} \ {c..d} = {u..v}" unfolding inter_interval by auto have *: "{u..v} \ {c..d}" using uv by auto - guess p apply (rule partial_division_extend_1[OF * False[unfolded uv]]) . - note p=this division_ofD[OF this(1)] + obtain p where "p division_of {c..d}" "{u..v} \ p" + by (rule partial_division_extend_1[OF * False[unfolded uv]]) + note p = this division_ofD[OF this(1)] have *: "{a..b} \ {c..d} = {a..b} \ \(p - {{u..v}})" "\x s. insert x s = {x} \ s" - using p(8) unfolding uv[THEN sym] by auto + using p(8) unfolding uv[symmetric] by auto show ?thesis apply (rule that[of "p - {{u..v}}"]) unfolding *(1) @@ -1101,10 +1278,10 @@ apply (rule division_of_subset[of p]) apply (rule division_of_union_self[OF p(1)]) defer - unfolding interior_inter[THEN sym] + unfolding interior_inter[symmetric] proof - have *: "\cd p uv ab. p \ cd \ ab \ cd = uv \ ab \ p = uv \ p" by auto - have "interior ({a..b} \ \(p - {{u..v}})) = interior({u..v} \ \(p - {{u..v}}))" + have "interior ({a..b} \ \(p - {{u..v}})) = interior({u..v} \ \(p - {{u..v}}))" apply (rule arg_cong[of _ _ interior]) apply (rule *[OF _ uv]) using p(8) @@ -1121,270 +1298,611 @@ qed qed -lemma division_of_unions: assumes "finite f" "\p. p\f \ p division_of (\p)" - "\k1 k2. \k1 \ \f; k2 \ \f; k1 \ k2\ \ interior k1 \ interior k2 = {}" - shows "\f division_of \\f" apply(rule division_ofI) prefer 5 apply(rule assms(3)|assumption)+ - apply(rule finite_Union assms(1))+ prefer 3 apply(erule UnionE) apply(rule_tac s=X in division_ofD(3)[OF assms(2)]) - using division_ofD[OF assms(2)] by auto - -lemma elementary_union_interval: assumes "p division_of \p" - obtains q where "q division_of ({a..b::'a::ordered_euclidean_space} \ \p)" proof- - note assm=division_ofD[OF assms] - have lem1:"\f s. \\ (f ` s) = \((\x.\(f x)) ` s)" by auto - have lem2:"\f s. f \ {} \ \{s \ t |t. t \ f} = s \ \f" by auto -{ presume "p={} \ thesis" "{a..b} = {} \ thesis" "{a..b} \ {} \ interior {a..b} = {} \ thesis" - "p\{} \ interior {a..b}\{} \ {a..b} \ {} \ thesis" - thus thesis by auto -next assume as:"p={}" guess p apply(rule elementary_interval[of a b]) . - thus thesis apply(rule_tac that[of p]) unfolding as by auto -next assume as:"{a..b}={}" show thesis apply(rule that) unfolding as using assms by auto -next assume as:"interior {a..b} = {}" "{a..b} \ {}" - show thesis apply(rule that[of "insert {a..b} p"],rule division_ofI) - unfolding finite_insert apply(rule assm(1)) unfolding Union_insert - using assm(2-4) as apply- by(fastforce dest: assm(5))+ -next assume as:"p \ {}" "interior {a..b} \ {}" "{a..b}\{}" - have "\k\p. \q. (insert {a..b} q) division_of ({a..b} \ k)" proof case goal1 - from assm(4)[OF this] guess c .. then guess d .. - thus ?case apply-apply(rule division_union_intervals_exists[OF as(3),of c d]) by auto - qed from bchoice[OF this] guess q .. note q=division_ofD[OF this[rule_format]] - let ?D = "\{insert {a..b} (q k) | k. k \ p}" - show thesis apply(rule that[of "?D"]) proof(rule division_ofI) - have *:"{insert {a..b} (q k) |k. k \ p} = (\k. insert {a..b} (q k)) ` p" by auto - show "finite ?D" apply(rule finite_Union) unfolding * apply(rule finite_imageI) using assm(1) q(1) by auto - show "\?D = {a..b} \ \p" unfolding * lem1 unfolding lem2[OF as(1), of "{a..b}",THEN sym] - using q(6) by auto - fix k assume k:"k\?D" thus " k \ {a..b} \ \p" using q(2) by auto - show "k \ {}" using q(3) k by auto show "\a b. k = {a..b}" using q(4) k by auto - fix k' assume k':"k'\?D" "k\k'" - obtain x where x: "k \insert {a..b} (q x)" "x\p" using k by auto - obtain x' where x':"k'\insert {a..b} (q x')" "x'\p" using k' by auto - show "interior k \ interior k' = {}" proof(cases "x=x'") - case True show ?thesis apply(rule q(5)) using x x' k' unfolding True by auto - next case False - { presume "k = {a..b} \ ?thesis" "k' = {a..b} \ ?thesis" - "k \ {a..b} \ k' \ {a..b} \ ?thesis" - thus ?thesis by auto } - { assume as':"k = {a..b}" show ?thesis apply(rule q(5)) using x' k'(2) unfolding as' by auto } - { assume as':"k' = {a..b}" show ?thesis apply(rule q(5)) using x k'(2) unfolding as' by auto } - assume as':"k \ {a..b}" "k' \ {a..b}" - guess c using q(4)[OF x(2,1)] .. then guess d .. note c_d=this - have "interior k \ interior {a..b} = {}" apply(rule q(5)) using x k'(2) using as' by auto - hence "interior k \ interior x" apply- - apply(rule interior_subset_union_intervals[OF c_d _ as(2) q(2)[OF x(2,1)]]) by auto moreover - guess c using q(4)[OF x'(2,1)] .. then guess d .. note c_d=this - have "interior k' \ interior {a..b} = {}" apply(rule q(5)) using x' k'(2) using as' by auto - hence "interior k' \ interior x'" apply- - apply(rule interior_subset_union_intervals[OF c_d _ as(2) q(2)[OF x'(2,1)]]) by auto - ultimately show ?thesis using assm(5)[OF x(2) x'(2) False] by auto - qed qed } qed +lemma division_of_unions: + assumes "finite f" + and "\p. p \ f \ p division_of (\p)" + and "\k1 k2. k1 \ \f \ k2 \ \f \ k1 \ k2 \ interior k1 \ interior k2 = {}" + shows "\f division_of \\f" + apply (rule division_ofI) + prefer 5 + apply (rule assms(3)|assumption)+ + apply (rule finite_Union assms(1))+ + prefer 3 + apply (erule UnionE) + apply (rule_tac s=X in division_ofD(3)[OF assms(2)]) + using division_ofD[OF assms(2)] + apply auto + done + +lemma elementary_union_interval: + fixes a b :: "'a::ordered_euclidean_space" + assumes "p division_of \p" + obtains q where "q division_of ({a..b} \ \p)" +proof - + note assm = division_ofD[OF assms] + have lem1: "\f s. \\(f ` s) = \((\x. \(f x)) ` s)" + by auto + have lem2: "\f s. f \ {} \ \{s \ t |t. t \ f} = s \ \f" + by auto + { + presume "p = {} \ thesis" + "{a..b} = {} \ thesis" + "{a..b} \ {} \ interior {a..b} = {} \ thesis" + "p \ {} \ interior {a..b}\{} \ {a..b} \ {} \ thesis" + then show thesis by auto + next + assume as: "p = {}" + obtain p where "p division_of {a..b}" + by (rule elementary_interval) + then show thesis + apply - + apply (rule that[of p]) + unfolding as + apply auto + done + next + assume as: "{a..b} = {}" + show thesis + apply (rule that) + unfolding as + using assms + apply auto + done + next + assume as: "interior {a..b} = {}" "{a..b} \ {}" + show thesis + apply (rule that[of "insert {a..b} p"],rule division_ofI) + unfolding finite_insert + apply (rule assm(1)) unfolding Union_insert + using assm(2-4) as + apply - + apply (fastforce dest: assm(5))+ + done + next + assume as: "p \ {}" "interior {a..b} \ {}" "{a..b} \ {}" + have "\k\p. \q. (insert {a..b} q) division_of ({a..b} \ k)" + proof + case goal1 + from assm(4)[OF this] obtain c d where "k = {c..d}" by blast + then show ?case + apply - + apply (rule division_union_intervals_exists[OF as(3), of c d]) + apply auto + done + qed + from bchoice[OF this] obtain q where "\x\p. insert {a..b} (q x) division_of {a..b} \ x" .. + note q = division_ofD[OF this[rule_format]] + let ?D = "\{insert {a..b} (q k) | k. k \ p}" + show thesis + apply (rule that[of "?D"]) + apply (rule division_ofI) + proof - + have *: "{insert {a..b} (q k) |k. k \ p} = (\k. insert {a..b} (q k)) ` p" + by auto + show "finite ?D" + apply (rule finite_Union) + unfolding * + apply (rule finite_imageI) + using assm(1) q(1) + apply auto + done + show "\?D = {a..b} \ \p" + unfolding * lem1 + unfolding lem2[OF as(1), of "{a..b}", symmetric] + using q(6) + by auto + fix k + assume k: "k \ ?D" + then show "k \ {a..b} \ \p" + using q(2) by auto + show "k \ {}" + using q(3) k by auto + show "\a b. k = {a..b}" + using q(4) k by auto + fix k' + assume k': "k' \ ?D" "k \ k'" + obtain x where x: "k \ insert {a..b} (q x)" "x\p" + using k by auto + obtain x' where x': "k'\insert {a..b} (q x')" "x'\p" + using k' by auto + show "interior k \ interior k' = {}" + proof (cases "x = x'") + case True + show ?thesis + apply(rule q(5)) + using x x' k' + unfolding True + apply auto + done + next + case False + { + presume "k = {a..b} \ ?thesis" + and "k' = {a..b} \ ?thesis" + and "k \ {a..b} \ k' \ {a..b} \ ?thesis" + then show ?thesis by auto + next + assume as': "k = {a..b}" + show ?thesis + apply (rule q(5)) + using x' k'(2) + unfolding as' + apply auto + done + next + assume as': "k' = {a..b}" + show ?thesis + apply (rule q(5)) + using x k'(2) + unfolding as' + apply auto + done + } + assume as': "k \ {a..b}" "k' \ {a..b}" + obtain c d where k: "k = {c..d}" + using q(4)[OF x(2,1)] by blast + have "interior k \ interior {a..b} = {}" + apply (rule q(5)) + using x k'(2) + using as' + apply auto + done + then have "interior k \ interior x" + apply - + apply (rule interior_subset_union_intervals[OF k _ as(2) q(2)[OF x(2,1)]]) + apply auto + done + moreover + obtain c d where c_d: "k' = {c..d}" + using q(4)[OF x'(2,1)] by blast + have "interior k' \ interior {a..b} = {}" + apply (rule q(5)) + using x' k'(2) + using as' + apply auto + done + then have "interior k' \ interior x'" + apply - + apply (rule interior_subset_union_intervals[OF c_d _ as(2) q(2)[OF x'(2,1)]]) + apply auto + done + ultimately show ?thesis + using assm(5)[OF x(2) x'(2) False] by auto + qed + qed + } +qed lemma elementary_unions_intervals: - assumes "finite f" "\s. s \ f \ \a b. s = {a..b::'a::ordered_euclidean_space}" - obtains p where "p division_of (\f)" proof- - have "\p. p division_of (\f)" proof(induct_tac f rule:finite_subset_induct) + assumes fin: "finite f" + and "\s. s \ f \ \a b. s = {a..b::'a::ordered_euclidean_space}" + obtains p where "p division_of (\f)" +proof - + have "\p. p division_of (\f)" + proof (induct_tac f rule:finite_subset_induct) show "\p. p division_of \{}" using elementary_empty by auto - fix x F assume as:"finite F" "x \ F" "\p. p division_of \F" "x\f" - from this(3) guess p .. note p=this - from assms(2)[OF as(4)] guess a .. then guess b .. note ab=this - have *:"\F = \p" using division_ofD[OF p] by auto - show "\p. p division_of \insert x F" using elementary_union_interval[OF p[unfolded *], of a b] - unfolding Union_insert ab * by auto - qed(insert assms,auto) thus ?thesis apply-apply(erule exE,rule that) by auto qed - -lemma elementary_union: assumes "ps division_of s" "pt division_of (t::('a::ordered_euclidean_space) set)" + next + fix x F + assume as: "finite F" "x \ F" "\p. p division_of \F" "x\f" + from this(3) obtain p where p: "p division_of \F" .. + from assms(2)[OF as(4)] obtain a b where x: "x = {a..b}" by blast + have *: "\F = \p" + using division_ofD[OF p] by auto + show "\p. p division_of \insert x F" + using elementary_union_interval[OF p[unfolded *], of a b] + unfolding Union_insert x * by auto + qed (insert assms, auto) + then show ?thesis + apply - + apply (erule exE) + apply (rule that) + apply auto + done +qed + +lemma elementary_union: + fixes s t :: "'a::ordered_euclidean_space set" + assumes "ps division_of s" + and "pt division_of t" obtains p where "p division_of (s \ t)" -proof- have "s \ t = \ps \ \pt" using assms unfolding division_of_def by auto - hence *:"\(ps \ pt) = s \ t" by auto - show ?thesis apply-apply(rule elementary_unions_intervals[of "ps\pt"]) - unfolding * prefer 3 apply(rule_tac p=p in that) - using assms[unfolded division_of_def] by auto qed - -lemma partial_division_extend: fixes t::"('a::ordered_euclidean_space) set" - assumes "p division_of s" "q division_of t" "s \ t" - obtains r where "p \ r" "r division_of t" proof- +proof - + have "s \ t = \ps \ \pt" + using assms unfolding division_of_def by auto + then have *: "\(ps \ pt) = s \ t" by auto + show ?thesis + apply - + apply (rule elementary_unions_intervals[of "ps \ pt"]) + unfolding * + prefer 3 + apply (rule_tac p=p in that) + using assms[unfolded division_of_def] + apply auto + done +qed + +lemma partial_division_extend: + fixes t :: "'a::ordered_euclidean_space set" + assumes "p division_of s" + and "q division_of t" + and "s \ t" + obtains r where "p \ r" and "r division_of t" +proof - note divp = division_ofD[OF assms(1)] and divq = division_ofD[OF assms(2)] - obtain a b where ab:"t\{a..b}" using elementary_subset_interval[OF assms(2)] by auto - guess r1 apply(rule partial_division_extend_interval) apply(rule assms(1)[unfolded divp(6)[THEN sym]]) - apply(rule subset_trans) by(rule ab assms[unfolded divp(6)[THEN sym]])+ note r1 = this division_ofD[OF this(2)] - guess p' apply(rule elementary_unions_intervals[of "r1 - p"]) using r1(3,6) by auto - then obtain r2 where r2:"r2 division_of (\(r1 - p)) \ (\q)" - apply- apply(drule elementary_inter[OF _ assms(2)[unfolded divq(6)[THEN sym]]]) by auto - { fix x assume x:"x\t" "x\s" - hence "x\\r1" unfolding r1 using ab by auto - then guess r unfolding Union_iff .. note r=this moreover - have "r \ p" proof assume "r\p" hence "x\s" using divp(2) r by auto - thus False using x by auto qed - ultimately have "x\\(r1 - p)" by auto } - hence *:"t = \p \ (\(r1 - p) \ \q)" unfolding divp divq using assms(3) by auto - show ?thesis apply(rule that[of "p \ r2"]) unfolding * defer apply(rule division_disjoint_union) - unfolding divp(6) apply(rule assms r2)+ - proof- have "interior s \ interior (\(r1-p)) = {}" - proof(rule inter_interior_unions_intervals) - show "finite (r1 - p)" "open (interior s)" "\t\r1-p. \a b. t = {a..b}" using r1 by auto - have *:"\s. (\x. x \ s \ False) \ s = {}" by auto - show "\t\r1-p. interior s \ interior t = {}" proof(rule) - fix m x assume as:"m\r1-p" - have "interior m \ interior (\p) = {}" proof(rule inter_interior_unions_intervals) - show "finite p" "open (interior m)" "\t\p. \a b. t = {a..b}" using divp by auto - show "\t\p. interior m \ interior t = {}" apply(rule, rule r1(7)) using as using r1 by auto - qed thus "interior s \ interior m = {}" unfolding divp by auto - qed qed - thus "interior s \ interior (\(r1-p) \ (\q)) = {}" using interior_subset by auto - qed auto qed + obtain a b where ab: "t \ {a..b}" + using elementary_subset_interval[OF assms(2)] by auto + obtain r1 where "p \ r1" "r1 division_of {a..b}" + apply (rule partial_division_extend_interval) + apply (rule assms(1)[unfolded divp(6)[symmetric]]) + apply (rule subset_trans) + apply (rule ab assms[unfolded divp(6)[symmetric]])+ + apply assumption + done + note r1 = this division_ofD[OF this(2)] + obtain p' where "p' division_of \(r1 - p)" + apply (rule elementary_unions_intervals[of "r1 - p"]) + using r1(3,6) + apply auto + done + then obtain r2 where r2: "r2 division_of (\(r1 - p)) \ (\q)" + apply - + apply (drule elementary_inter[OF _ assms(2)[unfolded divq(6)[symmetric]]]) + apply auto + done + { + fix x + assume x: "x \ t" "x \ s" + then have "x\\r1" + unfolding r1 using ab by auto + then obtain r where r: "r \ r1" "x \ r" + unfolding Union_iff .. + moreover + have "r \ p" + proof + assume "r \ p" + then have "x \ s" using divp(2) r by auto + then show False using x by auto + qed + ultimately have "x\\(r1 - p)" by auto + } + then have *: "t = \p \ (\(r1 - p) \ \q)" + unfolding divp divq using assms(3) by auto + show ?thesis + apply (rule that[of "p \ r2"]) + unfolding * + defer + apply (rule division_disjoint_union) + unfolding divp(6) + apply(rule assms r2)+ + proof - + have "interior s \ interior (\(r1-p)) = {}" + proof (rule inter_interior_unions_intervals) + show "finite (r1 - p)" and "open (interior s)" and "\t\r1-p. \a b. t = {a..b}" + using r1 by auto + have *: "\s. (\x. x \ s \ False) \ s = {}" + by auto + show "\t\r1-p. interior s \ interior t = {}" + proof + fix m x + assume as: "m \ r1 - p" + have "interior m \ interior (\p) = {}" + proof (rule inter_interior_unions_intervals) + show "finite p" and "open (interior m)" and "\t\p. \a b. t = {a..b}" + using divp by auto + show "\t\p. interior m \ interior t = {}" + apply (rule, rule r1(7)) + using as + using r1 + apply auto + done + qed + then show "interior s \ interior m = {}" + unfolding divp by auto + qed + qed + then show "interior s \ interior (\(r1-p) \ (\q)) = {}" + using interior_subset by auto + qed auto +qed + subsection {* Tagged (partial) divisions. *} -definition tagged_partial_division_of (infixr "tagged'_partial'_division'_of" 40) where - "(s tagged_partial_division_of i) \ - finite s \ - (\x k. (x,k) \ s \ x \ k \ k \ i \ (\a b. k = {a..b})) \ - (\x1 k1 x2 k2. (x1,k1) \ s \ (x2,k2) \ s \ ((x1,k1) \ (x2,k2)) - \ (interior(k1) \ interior(k2) = {}))" - -lemma tagged_partial_division_ofD[dest]: assumes "s tagged_partial_division_of i" - shows "finite s" "\x k. (x,k) \ s \ x \ k" "\x k. (x,k) \ s \ k \ i" - "\x k. (x,k) \ s \ \a b. k = {a..b}" - "\x1 k1 x2 k2. (x1,k1) \ s \ (x2,k2) \ s \ (x1,k1) \ (x2,k2) \ interior(k1) \ interior(k2) = {}" - using assms unfolding tagged_partial_division_of_def apply- by blast+ - -definition tagged_division_of (infixr "tagged'_division'_of" 40) where - "(s tagged_division_of i) \ - (s tagged_partial_division_of i) \ (\{k. \x. (x,k) \ s} = i)" +definition tagged_partial_division_of (infixr "tagged'_partial'_division'_of" 40) + where "s tagged_partial_division_of i \ + finite s \ + (\x k. (x, k) \ s \ x \ k \ k \ i \ (\a b. k = {a..b})) \ + (\x1 k1 x2 k2. (x1, k1) \ s \ (x2, k2) \ s \ (x1, k1) \ (x2, k2) \ + interior k1 \ interior k2 = {})" + +lemma tagged_partial_division_ofD[dest]: + assumes "s tagged_partial_division_of i" + shows "finite s" + and "\x k. (x,k) \ s \ x \ k" + and "\x k. (x,k) \ s \ k \ i" + and "\x k. (x,k) \ s \ \a b. k = {a..b}" + and "\x1 k1 x2 k2. (x1,k1) \ s \ + (x2, k2) \ s \ (x1, k1) \ (x2, k2) \ interior k1 \ interior k2 = {}" + using assms unfolding tagged_partial_division_of_def by blast+ + +definition tagged_division_of (infixr "tagged'_division'_of" 40) + where "s tagged_division_of i \ s tagged_partial_division_of i \ (\{k. \x. (x,k) \ s} = i)" lemma tagged_division_of_finite: "s tagged_division_of i \ finite s" unfolding tagged_division_of_def tagged_partial_division_of_def by auto lemma tagged_division_of: - "(s tagged_division_of i) \ - finite s \ - (\x k. (x,k) \ s - \ x \ k \ k \ i \ (\a b. k = {a..b})) \ - (\x1 k1 x2 k2. (x1,k1) \ s \ (x2,k2) \ s \ ~((x1,k1) = (x2,k2)) - \ (interior(k1) \ interior(k2) = {})) \ - (\{k. \x. (x,k) \ s} = i)" + "s tagged_division_of i \ + finite s \ + (\x k. (x, k) \ s \ x \ k \ k \ i \ (\a b. k = {a..b})) \ + (\x1 k1 x2 k2. (x1, k1) \ s \ (x2, k2) \ s \ (x1, k1) \ (x2, k2) \ + interior k1 \ interior k2 = {}) \ + (\{k. \x. (x,k) \ s} = i)" unfolding tagged_division_of_def tagged_partial_division_of_def by auto -lemma tagged_division_ofI: assumes - "finite s" "\x k. (x,k) \ s \ x \ k" "\x k. (x,k) \ s \ k \ i" "\x k. (x,k) \ s \ \a b. k = {a..b}" - "\x1 k1 x2 k2. (x1,k1) \ s \ (x2,k2) \ s \ ~((x1,k1) = (x2,k2)) \ (interior(k1) \ interior(k2) = {})" - "(\{k. \x. (x,k) \ s} = i)" +lemma tagged_division_ofI: + assumes "finite s" + and "\x k. (x,k) \ s \ x \ k" + and "\x k. (x,k) \ s \ k \ i" + and "\x k. (x,k) \ s \ \a b. k = {a..b}" + and "\x1 k1 x2 k2. (x1,k1) \ s \ (x2, k2) \ s \ (x1, k1) \ (x2, k2) \ + interior k1 \ interior k2 = {}" + and "(\{k. \x. (x,k) \ s} = i)" shows "s tagged_division_of i" - unfolding tagged_division_of apply(rule) defer apply rule - apply(rule allI impI conjI assms)+ apply assumption - apply(rule, rule assms, assumption) apply(rule assms, assumption) - using assms(1,5-) apply- by blast+ - -lemma tagged_division_ofD[dest]: assumes "s tagged_division_of i" - shows "finite s" "\x k. (x,k) \ s \ x \ k" "\x k. (x,k) \ s \ k \ i" "\x k. (x,k) \ s \ \a b. k = {a..b}" - "\x1 k1 x2 k2. (x1,k1) \ s \ (x2,k2) \ s \ ~((x1,k1) = (x2,k2)) \ (interior(k1) \ interior(k2) = {})" - "(\{k. \x. (x,k) \ s} = i)" using assms unfolding tagged_division_of apply- by blast+ - -lemma division_of_tagged_division: assumes"s tagged_division_of i" shows "(snd ` s) division_of i" -proof(rule division_ofI) note assm=tagged_division_ofD[OF assms] - show "\(snd ` s) = i" "finite (snd ` s)" using assm by auto - fix k assume k:"k \ snd ` s" then obtain xk where xk:"(xk, k) \ s" by auto - thus "k \ i" "k \ {}" "\a b. k = {a..b}" using assm apply- by fastforce+ - fix k' assume k':"k' \ snd ` s" "k \ k'" from this(1) obtain xk' where xk':"(xk', k') \ s" by auto - thus "interior k \ interior k' = {}" apply-apply(rule assm(5)) apply(rule xk xk')+ using k' by auto + unfolding tagged_division_of + apply rule + defer + apply rule + apply (rule allI impI conjI assms)+ + apply assumption + apply rule + apply (rule assms) + apply assumption + apply (rule assms) + apply assumption + using assms(1,5-) + apply blast+ + done + +lemma tagged_division_ofD[dest]: + assumes "s tagged_division_of i" + shows "finite s" + and "\x k. (x,k) \ s \ x \ k" + and "\x k. (x,k) \ s \ k \ i" + and "\x k. (x,k) \ s \ \a b. k = {a..b}" + and "\x1 k1 x2 k2. (x1, k1) \ s \ (x2, k2) \ s \ (x1, k1) \ (x2, k2) \ + interior k1 \ interior k2 = {}" + and "(\{k. \x. (x,k) \ s} = i)" + using assms unfolding tagged_division_of by blast+ + +lemma division_of_tagged_division: + assumes "s tagged_division_of i" + shows "(snd ` s) division_of i" +proof (rule division_ofI) + note assm = tagged_division_ofD[OF assms] + show "\(snd ` s) = i" "finite (snd ` s)" + using assm by auto + fix k + assume k: "k \ snd ` s" + then obtain xk where xk: "(xk, k) \ s" + by auto + then show "k \ i" "k \ {}" "\a b. k = {a..b}" + using assm by fastforce+ + fix k' + assume k': "k' \ snd ` s" "k \ k'" + from this(1) obtain xk' where xk': "(xk', k') \ s" + by auto + then show "interior k \ interior k' = {}" + apply - + apply (rule assm(5)) + apply (rule xk xk')+ + using k' + apply auto + done qed -lemma partial_division_of_tagged_division: assumes "s tagged_partial_division_of i" +lemma partial_division_of_tagged_division: + assumes "s tagged_partial_division_of i" shows "(snd ` s) division_of \(snd ` s)" -proof(rule division_ofI) note assm=tagged_partial_division_ofD[OF assms] - show "finite (snd ` s)" "\(snd ` s) = \(snd ` s)" using assm by auto - fix k assume k:"k \ snd ` s" then obtain xk where xk:"(xk, k) \ s" by auto - thus "k\{}" "\a b. k = {a..b}" "k \ \(snd ` s)" using assm by auto - fix k' assume k':"k' \ snd ` s" "k \ k'" from this(1) obtain xk' where xk':"(xk', k') \ s" by auto - thus "interior k \ interior k' = {}" apply-apply(rule assm(5)) apply(rule xk xk')+ using k' by auto +proof (rule division_ofI) + note assm = tagged_partial_division_ofD[OF assms] + show "finite (snd ` s)" "\(snd ` s) = \(snd ` s)" + using assm by auto + fix k + assume k: "k \ snd ` s" + then obtain xk where xk: "(xk, k) \ s" + by auto + then show "k \ {}" "\a b. k = {a..b}" "k \ \(snd ` s)" + using assm by auto + fix k' + assume k': "k' \ snd ` s" "k \ k'" + from this(1) obtain xk' where xk': "(xk', k') \ s" + by auto + then show "interior k \ interior k' = {}" + apply - + apply (rule assm(5)) + apply(rule xk xk')+ + using k' + apply auto + done qed -lemma tagged_partial_division_subset: assumes "s tagged_partial_division_of i" "t \ s" +lemma tagged_partial_division_subset: + assumes "s tagged_partial_division_of i" + and "t \ s" shows "t tagged_partial_division_of i" - using assms unfolding tagged_partial_division_of_def using finite_subset[OF assms(2)] by blast - -lemma setsum_over_tagged_division_lemma: fixes d::"('m::ordered_euclidean_space) set \ 'a::real_normed_vector" - assumes "p tagged_division_of i" "\u v. {u..v} \ {} \ content {u..v} = 0 \ d {u..v} = 0" + using assms + unfolding tagged_partial_division_of_def + using finite_subset[OF assms(2)] + by blast + +lemma setsum_over_tagged_division_lemma: + fixes d :: "'m::ordered_euclidean_space set \ 'a::real_normed_vector" + assumes "p tagged_division_of i" + and "\u v. {u..v} \ {} \ content {u..v} = 0 \ d {u..v} = 0" shows "setsum (\(x,k). d k) p = setsum d (snd ` p)" -proof- note assm=tagged_division_ofD[OF assms(1)] - have *:"(\(x,k). d k) = d \ snd" unfolding o_def apply(rule ext) by auto - show ?thesis unfolding * apply(subst eq_commute) proof(rule setsum_reindex_nonzero) - show "finite p" using assm by auto - fix x y assume as:"x\p" "y\p" "x\y" "snd x = snd y" - obtain a b where ab:"snd x = {a..b}" using assm(4)[of "fst x" "snd x"] as(1) by auto - have "(fst x, snd y) \ p" "(fst x, snd y) \ y" unfolding as(4)[THEN sym] using as(1-3) by auto - hence "interior (snd x) \ interior (snd y) = {}" apply-apply(rule assm(5)[of "fst x" _ "fst y"]) using as by auto - hence "content {a..b} = 0" unfolding as(4)[THEN sym] ab content_eq_0_interior by auto - hence "d {a..b} = 0" apply-apply(rule assms(2)) using assm(2)[of "fst x" "snd x"] as(1) unfolding ab[THEN sym] by auto - thus "d (snd x) = 0" unfolding ab by auto qed qed - -lemma tag_in_interval: "p tagged_division_of i \ (x,k) \ p \ x \ i" by auto +proof - + note assm = tagged_division_ofD[OF assms(1)] + have *: "(\(x,k). d k) = d \ snd" + unfolding o_def by (rule ext) auto + show ?thesis + unfolding * + apply (subst eq_commute) + proof (rule setsum_reindex_nonzero) + show "finite p" + using assm by auto + fix x y + assume as: "x\p" "y\p" "x\y" "snd x = snd y" + obtain a b where ab: "snd x = {a..b}" + using assm(4)[of "fst x" "snd x"] as(1) by auto + have "(fst x, snd y) \ p" "(fst x, snd y) \ y" + unfolding as(4)[symmetric] using as(1-3) by auto + then have "interior (snd x) \ interior (snd y) = {}" + apply - + apply (rule assm(5)[of "fst x" _ "fst y"]) + using as + apply auto + done + then have "content {a..b} = 0" + unfolding as(4)[symmetric] ab content_eq_0_interior by auto + then have "d {a..b} = 0" + apply - + apply (rule assms(2)) + using assm(2)[of "fst x" "snd x"] as(1) + unfolding ab[symmetric] + apply auto + done + then show "d (snd x) = 0" + unfolding ab by auto + qed +qed + +lemma tag_in_interval: "p tagged_division_of i \ (x, k) \ p \ x \ i" + by auto lemma tagged_division_of_empty: "{} tagged_division_of {}" unfolding tagged_division_of by auto -lemma tagged_partial_division_of_trivial[simp]: - "p tagged_partial_division_of {} \ p = {}" +lemma tagged_partial_division_of_trivial[simp]: "p tagged_partial_division_of {} \ p = {}" unfolding tagged_partial_division_of_def by auto -lemma tagged_division_of_trivial[simp]: - "p tagged_division_of {} \ p = {}" +lemma tagged_division_of_trivial[simp]: "p tagged_division_of {} \ p = {}" unfolding tagged_division_of by auto -lemma tagged_division_of_self: - "x \ {a..b} \ {(x,{a..b})} tagged_division_of {a..b}" - apply(rule tagged_division_ofI) by auto +lemma tagged_division_of_self: "x \ {a..b} \ {(x,{a..b})} tagged_division_of {a..b}" + by (rule tagged_division_ofI) auto lemma tagged_division_union: - assumes "p1 tagged_division_of s1" "p2 tagged_division_of s2" "interior s1 \ interior s2 = {}" + assumes "p1 tagged_division_of s1" + and "p2 tagged_division_of s2" + and "interior s1 \ interior s2 = {}" shows "(p1 \ p2) tagged_division_of (s1 \ s2)" -proof(rule tagged_division_ofI) note p1=tagged_division_ofD[OF assms(1)] and p2=tagged_division_ofD[OF assms(2)] - show "finite (p1 \ p2)" using p1(1) p2(1) by auto - show "\{k. \x. (x, k) \ p1 \ p2} = s1 \ s2" using p1(6) p2(6) by blast - fix x k assume xk:"(x,k)\p1\p2" show "x\k" "\a b. k = {a..b}" using xk p1(2,4) p2(2,4) by auto - show "k\s1\s2" using xk p1(3) p2(3) by blast - fix x' k' assume xk':"(x',k')\p1\p2" "(x,k) \ (x',k')" - have *:"\a b. a\ s1 \ b\ s2 \ interior a \ interior b = {}" using assms(3) interior_mono by blast - show "interior k \ interior k' = {}" apply(cases "(x,k)\p1", case_tac[!] "(x',k')\p1") - apply(rule p1(5)) prefer 4 apply(rule *) prefer 6 apply(subst Int_commute,rule *) prefer 8 apply(rule p2(5)) - using p1(3) p2(3) using xk xk' by auto qed +proof (rule tagged_division_ofI) + note p1 = tagged_division_ofD[OF assms(1)] + note p2 = tagged_division_ofD[OF assms(2)] + show "finite (p1 \ p2)" + using p1(1) p2(1) by auto + show "\{k. \x. (x, k) \ p1 \ p2} = s1 \ s2" + using p1(6) p2(6) by blast + fix x k + assume xk: "(x, k) \ p1 \ p2" + show "x \ k" "\a b. k = {a..b}" + using xk p1(2,4) p2(2,4) by auto + show "k \ s1 \ s2" + using xk p1(3) p2(3) by blast + fix x' k' + assume xk': "(x', k') \ p1 \ p2" "(x, k) \ (x', k')" + have *: "\a b. a \ s1 \ b \ s2 \ interior a \ interior b = {}" + using assms(3) interior_mono by blast + show "interior k \ interior k' = {}" + apply (cases "(x, k) \ p1") + apply (case_tac[!] "(x',k') \ p1") + apply (rule p1(5)) + prefer 4 + apply (rule *) + prefer 6 + apply (subst Int_commute) + apply (rule *) + prefer 8 + apply (rule p2(5)) + using p1(3) p2(3) + using xk xk' + apply auto + done +qed lemma tagged_division_unions: - assumes "finite iset" "\i\iset. (pfn(i) tagged_division_of i)" - "\i1 \ iset. \i2 \ iset. ~(i1 = i2) \ (interior(i1) \ interior(i2) = {})" + assumes "finite iset" + and "\i\iset. pfn i tagged_division_of i" + and "\i1\iset. \i2\iset. i1 \ i2 \ interior(i1) \ interior(i2) = {}" shows "\(pfn ` iset) tagged_division_of (\iset)" -proof(rule tagged_division_ofI) +proof (rule tagged_division_ofI) note assm = tagged_division_ofD[OF assms(2)[rule_format]] - show "finite (\(pfn ` iset))" apply(rule finite_Union) using assms by auto - have "\{k. \x. (x, k) \ \(pfn ` iset)} = \((\i. \{k. \x. (x, k) \ pfn i}) ` iset)" by blast - also have "\ = \iset" using assm(6) by auto - finally show "\{k. \x. (x, k) \ \(pfn ` iset)} = \iset" . - fix x k assume xk:"(x,k)\\(pfn ` iset)" then obtain i where i:"i \ iset" "(x, k) \ pfn i" by auto - show "x\k" "\a b. k = {a..b}" "k \ \iset" using assm(2-4)[OF i] using i(1) by auto - fix x' k' assume xk':"(x',k')\\(pfn ` iset)" "(x, k) \ (x', k')" then obtain i' where i':"i' \ iset" "(x', k') \ pfn i'" by auto - have *:"\a b. i\i' \ a\ i \ b\ i' \ interior a \ interior b = {}" using i(1) i'(1) - using assms(3)[rule_format] interior_mono by blast - show "interior k \ interior k' = {}" apply(cases "i=i'") - using assm(5)[OF i _ xk'(2)] i'(2) using assm(3)[OF i] assm(3)[OF i'] defer apply-apply(rule *) by auto + show "finite (\(pfn ` iset))" + apply (rule finite_Union) + using assms + apply auto + done + have "\{k. \x. (x, k) \ \(pfn ` iset)} = \((\i. \{k. \x. (x, k) \ pfn i}) ` iset)" + by blast + also have "\ = \iset" + using assm(6) by auto + finally show "\{k. \x. (x, k) \ \(pfn ` iset)} = \iset" . + fix x k + assume xk: "(x, k) \ \(pfn ` iset)" + then obtain i where i: "i \ iset" "(x, k) \ pfn i" + by auto + show "x \ k" "\a b. k = {a..b}" "k \ \iset" + using assm(2-4)[OF i] using i(1) by auto + fix x' k' + assume xk': "(x', k') \ \(pfn ` iset)" "(x, k) \ (x', k')" + then obtain i' where i': "i' \ iset" "(x', k') \ pfn i'" + by auto + have *: "\a b. i \ i' \ a \ i \ b \ i' \ interior a \ interior b = {}" + using i(1) i'(1) + using assms(3)[rule_format] interior_mono + by blast + show "interior k \ interior k' = {}" + apply (cases "i = i'") + using assm(5)[OF i _ xk'(2)] i'(2) + using assm(3)[OF i] assm(3)[OF i'] + defer + apply - + apply (rule *) + apply auto + done qed lemma tagged_partial_division_of_union_self: - assumes "p tagged_partial_division_of s" shows "p tagged_division_of (\(snd ` p))" - apply(rule tagged_division_ofI) using tagged_partial_division_ofD[OF assms] by auto - -lemma tagged_division_of_union_self: assumes "p tagged_division_of s" + assumes "p tagged_partial_division_of s" shows "p tagged_division_of (\(snd ` p))" - apply(rule tagged_division_ofI) using tagged_division_ofD[OF assms] by auto + apply (rule tagged_division_ofI) + using tagged_partial_division_ofD[OF assms] + apply auto + done + +lemma tagged_division_of_union_self: + assumes "p tagged_division_of s" + shows "p tagged_division_of (\(snd ` p))" + apply (rule tagged_division_ofI) + using tagged_division_ofD[OF assms] + apply auto + done + subsection {* Fine-ness of a partition w.r.t. a gauge. *} -definition fine (infixr "fine" 46) where - "d fine s \ (\(x,k) \ s. k \ d(x))" - -lemma fineI: assumes "\x k. (x,k) \ s \ k \ d x" - shows "d fine s" using assms unfolding fine_def by auto - -lemma fineD[dest]: assumes "d fine s" - shows "\x k. (x,k) \ s \ k \ d x" using assms unfolding fine_def by auto +definition fine (infixr "fine" 46) + where "d fine s \ (\(x,k) \ s. k \ d x)" + +lemma fineI: + assumes "\x k. (x, k) \ s \ k \ d x" + shows "d fine s" + using assms unfolding fine_def by auto + +lemma fineD[dest]: + assumes "d fine s" + shows "\x k. (x,k) \ s \ k \ d x" + using assms unfolding fine_def by auto lemma fine_inter: "(\x. d1 x \ d2 x) fine p \ d1 fine p \ d2 fine p" unfolding fine_def by auto @@ -1393,570 +1911,1222 @@ "(\x. \ {f d x | d. d \ s}) fine p \ (\d\s. (f d) fine p)" unfolding fine_def by blast -lemma fine_union: - "d fine p1 \ d fine p2 \ d fine (p1 \ p2)" +lemma fine_union: "d fine p1 \ d fine p2 \ d fine (p1 \ p2)" unfolding fine_def by blast -lemma fine_unions:"(\p. p \ ps \ d fine p) \ d fine (\ps)" +lemma fine_unions: "(\p. p \ ps \ d fine p) \ d fine (\ps)" unfolding fine_def by auto -lemma fine_subset: "p \ q \ d fine q \ d fine p" +lemma fine_subset: "p \ q \ d fine q \ d fine p" unfolding fine_def by blast + subsection {* Gauge integral. Define on compact intervals first, then use a limit. *} -definition has_integral_compact_interval (infixr "has'_integral'_compact'_interval" 46) where - "(f has_integral_compact_interval y) i \ - (\e>0. \d. gauge d \ - (\p. p tagged_division_of i \ d fine p - \ norm(setsum (\(x,k). content k *\<^sub>R f x) p - y) < e))" - -definition has_integral (infixr "has'_integral" 46) where -"((f::('n::ordered_euclidean_space \ 'b::real_normed_vector)) has_integral y) i \ - if (\a b. i = {a..b}) then (f has_integral_compact_interval y) i - else (\e>0. \B>0. \a b. ball 0 B \ {a..b} - \ (\z. ((\x. if x \ i then f x else 0) has_integral_compact_interval z) {a..b} \ - norm(z - y) < e))" +definition has_integral_compact_interval (infixr "has'_integral'_compact'_interval" 46) + where "(f has_integral_compact_interval y) i \ + (\e>0. \d. gauge d \ + (\p. p tagged_division_of i \ d fine p \ + norm (setsum (\(x,k). content k *\<^sub>R f x) p - y) < e))" + +definition has_integral :: + "('n::ordered_euclidean_space \ 'b::real_normed_vector) \ 'b \ 'n set \ bool" + (infixr "has'_integral" 46) + where "(f has_integral y) i \ + (if \a b. i = {a..b} + then (f has_integral_compact_interval y) i + else (\e>0. \B>0. \a b. ball 0 B \ {a..b} \ + (\z. ((\x. if x \ i then f x else 0) has_integral_compact_interval z) {a..b} \ + norm (z - y) < e)))" lemma has_integral: - "(f has_integral y) ({a..b}) \ - (\e>0. \d. gauge d \ (\p. p tagged_division_of {a..b} \ d fine p - \ norm(setsum (\(x,k). content(k) *\<^sub>R f x) p - y) < e))" - unfolding has_integral_def has_integral_compact_interval_def by auto - -lemma has_integralD[dest]: assumes - "(f has_integral y) ({a..b})" "e>0" - obtains d where "gauge d" "\p. p tagged_division_of {a..b} \ d fine p - \ norm(setsum (\(x,k). content(k) *\<^sub>R f(x)) p - y) < e" + "(f has_integral y) {a..b} \ + (\e>0. \d. gauge d \ + (\p. p tagged_division_of {a..b} \ d fine p \ + norm (setsum (\(x,k). content(k) *\<^sub>R f x) p - y) < e))" + unfolding has_integral_def has_integral_compact_interval_def + by auto + +lemma has_integralD[dest]: + assumes "(f has_integral y) ({a..b})" + and "e > 0" + obtains d where "gauge d" + and "\p. p tagged_division_of {a..b} \ d fine p \ + norm (setsum (\(x,k). content(k) *\<^sub>R f(x)) p - y) < e" using assms unfolding has_integral by auto lemma has_integral_alt: - "(f has_integral y) i \ - (if (\a b. i = {a..b}) then (f has_integral y) i - else (\e>0. \B>0. \a b. ball 0 B \ {a..b} - \ (\z. ((\x. if x \ i then f(x) else 0) - has_integral z) ({a..b}) \ - norm(z - y) < e)))" - unfolding has_integral unfolding has_integral_compact_interval_def has_integral_def by auto + "(f has_integral y) i \ + (if \a b. i = {a..b} + then (f has_integral y) i + else (\e>0. \B>0. \a b. ball 0 B \ {a..b} \ + (\z. ((\x. if x \ i then f(x) else 0) has_integral z) ({a..b}) \ norm (z - y) < e)))" + unfolding has_integral + unfolding has_integral_compact_interval_def has_integral_def + by auto lemma has_integral_altD: - assumes "(f has_integral y) i" "\ (\a b. i = {a..b})" "e>0" - obtains B where "B>0" "\a b. ball 0 B \ {a..b}\ (\z. ((\x. if x \ i then f(x) else 0) has_integral z) ({a..b}) \ norm(z - y) < e)" - using assms unfolding has_integral unfolding has_integral_compact_interval_def has_integral_def by auto - -definition integrable_on (infixr "integrable'_on" 46) where - "(f integrable_on i) \ \y. (f has_integral y) i" - -definition "integral i f \ SOME y. (f has_integral y) i" - -lemma integrable_integral[dest]: - "f integrable_on i \ (f has_integral (integral i f)) i" - unfolding integrable_on_def integral_def by(rule someI_ex) + assumes "(f has_integral y) i" + and "\ (\a b. i = {a..b})" + and "e>0" + obtains B where "B > 0" + and "\a b. ball 0 B \ {a..b} \ + (\z. ((\x. if x \ i then f(x) else 0) has_integral z) ({a..b}) \ norm(z - y) < e)" + using assms + unfolding has_integral + unfolding has_integral_compact_interval_def has_integral_def + by auto + +definition integrable_on (infixr "integrable'_on" 46) + where "f integrable_on i \ (\y. (f has_integral y) i)" + +definition "integral i f = (SOME y. (f has_integral y) i)" + +lemma integrable_integral[dest]: "f integrable_on i \ (f has_integral (integral i f)) i" + unfolding integrable_on_def integral_def by (rule someI_ex) lemma has_integral_integrable[intro]: "(f has_integral i) s \ f integrable_on s" unfolding integrable_on_def by auto -lemma has_integral_integral:"f integrable_on s \ (f has_integral (integral s f)) s" +lemma has_integral_integral: "f integrable_on s \ (f has_integral (integral s f)) s" by auto lemma setsum_content_null: - assumes "content({a..b}) = 0" "p tagged_division_of {a..b}" + assumes "content {a..b} = 0" + and "p tagged_division_of {a..b}" shows "setsum (\(x,k). content k *\<^sub>R f x) p = (0::'a::real_normed_vector)" -proof(rule setsum_0',rule) fix y assume y:"y\p" - obtain x k where xk:"y = (x,k)" using surj_pair[of y] by blast +proof (rule setsum_0', rule) + fix y + assume y: "y \ p" + obtain x k where xk: "y = (x, k)" + using surj_pair[of y] by blast note assm = tagged_division_ofD(3-4)[OF assms(2) y[unfolded xk]] - from this(2) guess c .. then guess d .. note c_d=this - have "(\(x, k). content k *\<^sub>R f x) y = content k *\<^sub>R f x" unfolding xk by auto - also have "\ = 0" using content_subset[OF assm(1)[unfolded c_d]] content_pos_le[of c d] - unfolding assms(1) c_d by auto + from this(2) obtain c d where k: "k = {c..d}" by blast + have "(\(x, k). content k *\<^sub>R f x) y = content k *\<^sub>R f x" + unfolding xk by auto + also have "\ = 0" + using content_subset[OF assm(1)[unfolded k]] content_pos_le[of c d] + unfolding assms(1) k + by auto finally show "(\(x, k). content k *\<^sub>R f x) y = 0" . qed + subsection {* Some basic combining lemmas. *} lemma tagged_division_unions_exists: - assumes "finite iset" "\i \ iset. \p. p tagged_division_of i \ d fine p" - "\i1\iset. \i2\iset. ~(i1 = i2) \ (interior(i1) \ interior(i2) = {})" "(\iset = i)" - obtains p where "p tagged_division_of i" "d fine p" -proof- guess pfn using bchoice[OF assms(2)] .. note pfn = conjunctD2[OF this[rule_format]] - show thesis apply(rule_tac p="\(pfn ` iset)" in that) unfolding assms(4)[THEN sym] - apply(rule tagged_division_unions[OF assms(1) _ assms(3)]) defer - apply(rule fine_unions) using pfn by auto + assumes "finite iset" + and "\i\iset. \p. p tagged_division_of i \ d fine p" + and "\i1\iset. \i2\iset. i1 \ i2 \ interior i1 \ interior i2 = {}" + and "\iset = i" + obtains p where "p tagged_division_of i" and "d fine p" +proof - + obtain pfn where pfn: + "\x. x \ iset \ pfn x tagged_division_of x" + "\x. x \ iset \ d fine pfn x" + using bchoice[OF assms(2)] by auto + show thesis + apply (rule_tac p="\(pfn ` iset)" in that) + unfolding assms(4)[symmetric] + apply (rule tagged_division_unions[OF assms(1) _ assms(3)]) + defer + apply (rule fine_unions) + using pfn + apply auto + done qed + subsection {* The set we're concerned with must be closed. *} -lemma division_of_closed: "s division_of i \ closed (i::('n::ordered_euclidean_space) set)" +lemma division_of_closed: + fixes i :: "'n::ordered_euclidean_space set" + shows "s division_of i \ closed i" unfolding division_of_def by fastforce subsection {* General bisection principle for intervals; might be useful elsewhere. *} -lemma interval_bisection_step: fixes type::"'a::ordered_euclidean_space" - assumes "P {}" "(\s t. P s \ P t \ interior(s) \ interior(t) = {} \ P(s \ t))" "~(P {a..b::'a})" - obtains c d where "~(P{c..d})" - "\i\Basis. a\i \ c\i \ c\i \ d\i \ d\i \ b\i \ 2 * (d\i - c\i) \ b\i - a\i" -proof- have "{a..b} \ {}" using assms(1,3) by auto - then have ab: "\i. i\Basis \ a \ i \ b \ i" by (auto simp: interval_eq_empty not_le) - { fix f have "finite f \ - (\s\f. P s) \ - (\s\f. \a b. s = {a..b}) \ - (\s\f.\t\f. ~(s = t) \ interior(s) \ interior(t) = {}) \ P(\f)" - proof(induct f rule:finite_induct) - case empty show ?case using assms(1) by auto - next case (insert x f) show ?case unfolding Union_insert apply(rule assms(2)[rule_format]) - apply rule defer apply rule defer apply(rule inter_interior_unions_intervals) - using insert by auto - qed } note * = this - let ?A = "{{c..d} | c d::'a. \i\Basis. (c\i = a\i) \ (d\i = (a\i + b\i) / 2) \ (c\i = (a\i + b\i) / 2) \ (d\i = b\i)}" +lemma interval_bisection_step: + fixes type :: "'a::ordered_euclidean_space" + assumes "P {}" + and "\s t. P s \ P t \ interior(s) \ interior(t) = {} \ P (s \ t)" + and "\ P {a..b::'a}" + obtains c d where "\ P{c..d}" + and "\i\Basis. a\i \ c\i \ c\i \ d\i \ d\i \ b\i \ 2 * (d\i - c\i) \ b\i - a\i" +proof - + have "{a..b} \ {}" + using assms(1,3) by auto + then have ab: "\i. i\Basis \ a \ i \ b \ i" + by (auto simp: interval_eq_empty not_le) + { + fix f + have "finite f \ + \s\f. P s \ + \s\f. \a b. s = {a..b} \ + \s\f.\t\f. s \ t \ interior s \ interior t = {} \ P (\f)" + proof (induct f rule: finite_induct) + case empty + show ?case + using assms(1) by auto + next + case (insert x f) + show ?case + unfolding Union_insert + apply (rule assms(2)[rule_format]) + apply rule + defer + apply rule + defer + apply (rule inter_interior_unions_intervals) + using insert + apply auto + done + qed + } note * = this + let ?A = "{{c..d} | c d::'a. \i\Basis. (c\i = a\i) \ (d\i = (a\i + b\i) / 2) \ + (c\i = (a\i + b\i) / 2) \ (d\i = b\i)}" let ?PP = "\c d. \i\Basis. a\i \ c\i \ c\i \ d\i \ d\i \ b\i \ 2 * (d\i - c\i) \ b\i - a\i" - { presume "\c d. ?PP c d \ P {c..d} \ False" - thus thesis unfolding atomize_not not_all apply-apply(erule exE)+ apply(rule_tac c=x and d=xa in that) by auto } - assume as:"\c d. ?PP c d \ P {c..d}" - have "P (\ ?A)" proof(rule *, rule_tac[2-] ballI, rule_tac[4] ballI, rule_tac[4] impI) + { + presume "\c d. ?PP c d \ P {c..d} \ False" + then show thesis + unfolding atomize_not not_all + apply - + apply (erule exE)+ + apply (rule_tac c=x and d=xa in that) + apply auto + done + } + assume as: "\c d. ?PP c d \ P {c..d}" + have "P (\ ?A)" + apply (rule *) + apply (rule_tac[2-] ballI) + apply (rule_tac[4] ballI) + apply (rule_tac[4] impI) + proof - let ?B = "(\s.{(\i\Basis. (if i \ s then a\i else (a\i + b\i) / 2) *\<^sub>R i)::'a .. (\i\Basis. (if i \ s then (a\i + b\i) / 2 else b\i) *\<^sub>R i)}) ` {s. s \ Basis}" - have "?A \ ?B" proof case goal1 - then guess c unfolding mem_Collect_eq .. then guess d apply- by(erule exE,(erule conjE)+) note c_d=this[rule_format] - have *:"\a b c d. a = c \ b = d \ {a..b} = {c..d}" by auto - show "x\?B" unfolding image_iff - apply(rule_tac x="{i. i\Basis \ c\i = a\i}" in bexI) - unfolding c_d - apply(rule *) + have "?A \ ?B" + proof + case goal1 + then obtain c d where x: "x = {c..d}" + "\i. i \ Basis \ + c \ i = a \ i \ d \ i = (a \ i + b \ i) / 2 \ + c \ i = (a \ i + b \ i) / 2 \ d \ i = b \ i" by blast + have *: "\a b c d. a = c \ b = d \ {a..b} = {c..d}" + by auto + show "x \ ?B" + unfolding image_iff + apply (rule_tac x="{i. i\Basis \ c\i = a\i}" in bexI) + unfolding x + apply (rule *) apply (simp_all only: euclidean_eq_iff[where 'a='a] inner_setsum_left_Basis mem_Collect_eq simp_thms - cong: ball_cong) + cong: ball_cong) apply safe - proof- - fix i :: 'a assume i: "i\Basis" - thus " c \ i = (if c \ i = a \ i then a \ i else (a \ i + b \ i) / 2)" - "d \ i = (if c \ i = a \ i then (a \ i + b \ i) / 2 else b \ i)" - using c_d(2)[of i] ab[OF i] by(auto simp add:field_simps) - qed qed - thus "finite ?A" apply(rule finite_subset) by auto - fix s assume "s\?A" then guess c unfolding mem_Collect_eq .. then guess d apply- by(erule exE,(erule conjE)+) - note c_d=this[rule_format] - show "P s" unfolding c_d apply(rule as[rule_format]) proof- case goal1 thus ?case - using c_d(2)[of i] using ab[OF `i \ Basis`] by auto qed - show "\a b. s = {a..b}" unfolding c_d by auto - fix t assume "t\?A" then guess e unfolding mem_Collect_eq .. then guess f apply- by(erule exE,(erule conjE)+) - note e_f=this[rule_format] - assume "s \ t" hence "\ (c = e \ d = f)" unfolding c_d e_f by auto - then obtain i where "c\i \ e\i \ d\i \ f\i" and i':"i\Basis" + proof - + fix i :: 'a + assume i: "i \ Basis" + then show "c \ i = (if c \ i = a \ i then a \ i else (a \ i + b \ i) / 2)" + and "d \ i = (if c \ i = a \ i then (a \ i + b \ i) / 2 else b \ i)" + using x(2)[of i] ab[OF i] by (auto simp add:field_simps) + qed + qed + then show "finite ?A" + by (rule finite_subset) auto + fix s + assume "s \ ?A" + then obtain c d where s: + "s = {c..d}" + "\i. i \ Basis \ + c \ i = a \ i \ d \ i = (a \ i + b \ i) / 2 \ + c \ i = (a \ i + b \ i) / 2 \ d \ i = b \ i" + by blast + show "P s" + unfolding s + apply (rule as[rule_format]) + proof - + case goal1 + then show ?case + using s(2)[of i] using ab[OF `i \ Basis`] by auto + qed + show "\a b. s = {a..b}" + unfolding s by auto + fix t + assume "t \ ?A" + then obtain e f where t: + "t = {e..f}" + "\i. i \ Basis \ + e \ i = a \ i \ f \ i = (a \ i + b \ i) / 2 \ + e \ i = (a \ i + b \ i) / 2 \ f \ i = b \ i" + by blast + assume "s \ t" + then have "\ (c = e \ d = f)" + unfolding s t by auto + then obtain i where "c\i \ e\i \ d\i \ f\i" and i': "i \ Basis" unfolding euclidean_eq_iff[where 'a='a] by auto - hence i:"c\i \ e\i" "d\i \ f\i" apply- apply(erule_tac[!] disjE) - proof- assume "c\i \ e\i" thus "d\i \ f\i" using c_d(2)[OF i'] e_f(2)[OF i'] by fastforce - next assume "d\i \ f\i" thus "c\i \ e\i" using c_d(2)[OF i'] e_f(2)[OF i'] by fastforce - qed have *:"\s t. (\a. a\s \ a\t \ False) \ s \ t = {}" by auto - show "interior s \ interior t = {}" unfolding e_f c_d interior_closed_interval proof(rule *) - fix x assume "x\{c<..{e<..i < d\i" "e\i < f\i" "c\i < f\i" "e\i < d\i" unfolding mem_interval using i' - apply-apply(erule_tac[!] x=i in ballE)+ by auto - show False using c_d(2)[OF i'] apply- apply(erule_tac disjE) - proof(erule_tac[!] conjE) assume as:"c \ i = a \ i" "d \ i = (a \ i + b \ i) / 2" - show False using e_f(2)[OF i'] and i x unfolding as by(fastforce simp add:field_simps) - next assume as:"c \ i = (a \ i + b \ i) / 2" "d \ i = b \ i" - show False using e_f(2)[OF i'] and i x unfolding as by(fastforce simp add:field_simps) - qed qed qed - also have "\ ?A = {a..b}" proof(rule set_eqI,rule) - fix x assume "x\\?A" then guess Y unfolding Union_iff .. - from this(1) guess c unfolding mem_Collect_eq .. then guess d .. - note c_d = this[THEN conjunct2,rule_format] `x\Y`[unfolded this[THEN conjunct1]] - show "x\{a..b}" unfolding mem_interval proof safe - fix i :: 'a assume i: "i\Basis" thus "a \ i \ x \ i" "x \ i \ b \ i" - using c_d(1)[OF i] c_d(2)[unfolded mem_interval,THEN bspec, OF i] by auto qed - next fix x assume x:"x\{a..b}" - have "\i\Basis. \c d. (c = a\i \ d = (a\i + b\i) / 2 \ c = (a\i + b\i) / 2 \ d = b\i) \ c\x\i \ x\i \ d" - (is "\i\Basis. \c d. ?P i c d") unfolding mem_interval + then have i: "c\i \ e\i" "d\i \ f\i" + apply - + apply(erule_tac[!] disjE) + proof - + assume "c\i \ e\i" + then show "d\i \ f\i" + using s(2)[OF i'] t(2)[OF i'] by fastforce + next + assume "d\i \ f\i" + then show "c\i \ e\i" + using s(2)[OF i'] t(2)[OF i'] by fastforce + qed + have *: "\s t. (\a. a \ s \ a \ t \ False) \ s \ t = {}" + by auto + show "interior s \ interior t = {}" + unfolding s t interior_closed_interval + proof (rule *) + fix x + assume "x \ {c<.. {e<..i < d\i" "e\i < f\i" "c\i < f\i" "e\i < d\i" + unfolding mem_interval using i' + apply - + apply (erule_tac[!] x=i in ballE)+ + apply auto + done + show False + using s(2)[OF i'] + apply - + apply (erule_tac disjE) + apply (erule_tac[!] conjE) + proof - + assume as: "c \ i = a \ i" "d \ i = (a \ i + b \ i) / 2" + show False + using t(2)[OF i'] and i x unfolding as by (fastforce simp add:field_simps) + next + assume as: "c \ i = (a \ i + b \ i) / 2" "d \ i = b \ i" + show False + using t(2)[OF i'] and i x unfolding as by(fastforce simp add:field_simps) + qed + qed + qed + also have "\ ?A = {a..b}" + proof (rule set_eqI,rule) + fix x + assume "x \ \?A" + then obtain c d where x: + "x \ {c..d}" + "\i. i \ Basis \ + c \ i = a \ i \ d \ i = (a \ i + b \ i) / 2 \ + c \ i = (a \ i + b \ i) / 2 \ d \ i = b \ i" by blast + show "x\{a..b}" + unfolding mem_interval + proof safe + fix i :: 'a + assume i: "i \ Basis" + then show "a \ i \ x \ i" "x \ i \ b \ i" + using x(2)[OF i] x(1)[unfolded mem_interval,THEN bspec, OF i] by auto + qed + next + fix x + assume x: "x \ {a..b}" + have "\i\Basis. + \c d. (c = a\i \ d = (a\i + b\i) / 2 \ c = (a\i + b\i) / 2 \ d = b\i) \ c\x\i \ x\i \ d" + (is "\i\Basis. \c d. ?P i c d") + unfolding mem_interval proof - fix i :: 'a assume i: "i \ Basis" + fix i :: 'a + assume i: "i \ Basis" have "?P i (a\i) ((a \ i + b \ i) / 2) \ ?P i ((a \ i + b \ i) / 2) (b\i)" - using x[unfolded mem_interval,THEN bspec, OF i] by auto thus "\c d. ?P i c d" by blast + using x[unfolded mem_interval,THEN bspec, OF i] by auto + then show "\c d. ?P i c d" + by blast qed - thus "x\\?A" + then show "x\\?A" unfolding Union_iff Bex_def mem_Collect_eq choice_Basis_iff - apply-apply(erule exE)+ apply(rule_tac x="{xa..xaa}" in exI) unfolding mem_interval by auto - qed finally show False using assms by auto qed - -lemma interval_bisection: fixes type::"'a::ordered_euclidean_space" - assumes "P {}" "(\s t. P s \ P t \ interior(s) \ interior(t) = {} \ P(s \ t))" "\ P {a..b::'a}" - obtains x where "x \ {a..b}" "\e>0. \c d. x \ {c..d} \ {c..d} \ ball x e \ {c..d} \ {a..b} \ ~P({c..d})" -proof- + apply - + apply (erule exE)+ + apply (rule_tac x="{xa..xaa}" in exI) + unfolding mem_interval + apply auto + done + qed + finally show False + using assms by auto +qed + +lemma interval_bisection: + fixes type :: "'a::ordered_euclidean_space" + assumes "P {}" + and "(\s t. P s \ P t \ interior(s) \ interior(t) = {} \ P(s \ t))" + and "\ P {a..b::'a}" + obtains x where "x \ {a..b}" + and "\e>0. \c d. x \ {c..d} \ {c..d} \ ball x e \ {c..d} \ {a..b} \ \ P {c..d}" +proof - have "\x. \y. \ P {fst x..snd x} \ (\ P {fst y..snd y} \ (\i\Basis. fst x\i \ fst y\i \ fst y\i \ snd y\i \ snd y\i \ snd x\i \ - 2 * (snd y\i - fst y\i) \ snd x\i - fst x\i))" proof case goal1 thus ?case proof- + 2 * (snd y\i - fst y\i) \ snd x\i - fst x\i))" + proof + case goal1 + then show ?case + proof - presume "\ P {fst x..snd x} \ ?thesis" - thus ?thesis apply(cases "P {fst x..snd x}") by auto - next assume as:"\ P {fst x..snd x}" from interval_bisection_step[of P, OF assms(1-2) as] guess c d . - thus ?thesis apply- apply(rule_tac x="(c,d)" in exI) by auto - qed qed then guess f apply-apply(drule choice) by(erule exE) note f=this - def AB \ "\n. (f ^^ n) (a,b)" def A \ "\n. fst(AB n)" and B \ "\n. snd(AB n)" note ab_def = this AB_def + then show ?thesis by (cases "P {fst x..snd x}") auto + next + assume as: "\ P {fst x..snd x}" + obtain c d where "\ P {c..d}" + "\i\Basis. + fst x \ i \ c \ i \ + c \ i \ d \ i \ + d \ i \ snd x \ i \ + 2 * (d \ i - c \ i) \ snd x \ i - fst x \ i" + by (rule interval_bisection_step[of P, OF assms(1-2) as]) + then show ?thesis + apply - + apply (rule_tac x="(c,d)" in exI) + apply auto + done + qed + qed + then guess f + apply - + apply (drule choice) + apply (erule exE) + done + note f = this + def AB \ "\n. (f ^^ n) (a,b)" + def A \ "\n. fst(AB n)" + def B \ "\n. snd(AB n)" + note ab_def = A_def B_def AB_def have "A 0 = a" "B 0 = b" "\n. \ P {A(Suc n)..B(Suc n)} \ - (\i\Basis. A(n)\i \ A(Suc n)\i \ A(Suc n)\i \ B(Suc n)\i \ B(Suc n)\i \ B(n)\i \ + (\i\Basis. A(n)\i \ A(Suc n)\i \ A(Suc n)\i \ B(Suc n)\i \ B(Suc n)\i \ B(n)\i \ 2 * (B(Suc n)\i - A(Suc n)\i) \ B(n)\i - A(n)\i)" (is "\n. ?P n") - proof- show "A 0 = a" "B 0 = b" unfolding ab_def by auto - case goal3 note S = ab_def funpow.simps o_def id_apply show ?case - proof(induct n) case 0 thus ?case unfolding S apply(rule f[rule_format]) using assms(3) by auto - next case (Suc n) show ?case unfolding S apply(rule f[rule_format]) using Suc unfolding S by auto - qed qed note AB = this(1-2) conjunctD2[OF this(3),rule_format] - - have interv:"\e. 0 < e \ \n. \x\{A n..B n}. \y\{A n..B n}. dist x y < e" - proof- case goal1 guess n using real_arch_pow2[of "(setsum (\i. b\i - a\i) Basis) / e"] .. note n=this - show ?case apply(rule_tac x=n in exI) proof(rule,rule) - fix x y assume xy:"x\{A n..B n}" "y\{A n..B n}" - have "dist x y \ setsum (\i. abs((x - y)\i)) Basis" unfolding dist_norm by(rule norm_le_l1) + proof - + show "A 0 = a" "B 0 = b" + unfolding ab_def by auto + case goal3 + note S = ab_def funpow.simps o_def id_apply + show ?case + proof (induct n) + case 0 + then show ?case + unfolding S + apply (rule f[rule_format]) using assms(3) + apply auto + done + next + case (Suc n) + show ?case + unfolding S + apply (rule f[rule_format]) + using Suc + unfolding S + apply auto + done + qed + qed + note AB = this(1-2) conjunctD2[OF this(3),rule_format] + + have interv: "\e. 0 < e \ \n. \x\{A n..B n}. \y\{A n..B n}. dist x y < e" + proof - + case goal1 + obtain n where n: "(\i\Basis. b \ i - a \ i) / e < 2 ^ n" + using real_arch_pow2[of "(setsum (\i. b\i - a\i) Basis) / e"] .. + show ?case + apply (rule_tac x=n in exI) + apply rule + apply rule + proof - + fix x y + assume xy: "x\{A n..B n}" "y\{A n..B n}" + have "dist x y \ setsum (\i. abs((x - y)\i)) Basis" + unfolding dist_norm by(rule norm_le_l1) also have "\ \ setsum (\i. B n\i - A n\i) Basis" - proof(rule setsum_mono) - fix i :: 'a assume i: "i \ Basis" show "\(x - y) \ i\ \ B n \ i - A n \ i" - using xy[unfolded mem_interval,THEN bspec, OF i] by (auto simp: inner_diff_left) qed - also have "\ \ setsum (\i. b\i - a\i) Basis / 2^n" unfolding setsum_divide_distrib - proof(rule setsum_mono) case goal1 thus ?case - proof(induct n) case 0 thus ?case unfolding AB by auto - next case (Suc n) have "B (Suc n) \ i - A (Suc n) \ i \ (B n \ i - A n \ i) / 2" + proof (rule setsum_mono) + fix i :: 'a + assume i: "i \ Basis" + show "\(x - y) \ i\ \ B n \ i - A n \ i" + using xy[unfolded mem_interval,THEN bspec, OF i] + by (auto simp: inner_diff_left) + qed + also have "\ \ setsum (\i. b\i - a\i) Basis / 2^n" + unfolding setsum_divide_distrib + proof (rule setsum_mono) + case goal1 + then show ?case + proof (induct n) + case 0 + then show ?case + unfolding AB by auto + next + case (Suc n) + have "B (Suc n) \ i - A (Suc n) \ i \ (B n \ i - A n \ i) / 2" using AB(4)[of i n] using goal1 by auto - also have "\ \ (b \ i - a \ i) / 2 ^ Suc n" using Suc by(auto simp add:field_simps) finally show ?case . - qed qed - also have "\ < e" using n using goal1 by(auto simp add:field_simps) finally show "dist x y < e" . - qed qed - { fix n m :: nat assume "m \ n" then have "{A n..B n} \ {A m..B m}" - proof(induct rule: inc_induct) - case (step i) show ?case + also have "\ \ (b \ i - a \ i) / 2 ^ Suc n" + using Suc by (auto simp add:field_simps) + finally show ?case . + qed + qed + also have "\ < e" + using n using goal1 by (auto simp add:field_simps) + finally show "dist x y < e" . + qed + qed + { + fix n m :: nat + assume "m \ n" + then have "{A n..B n} \ {A m..B m}" + proof (induct rule: inc_induct) + case (step i) + show ?case using AB(4) by (intro order_trans[OF step(2)] subset_interval_imp) auto - qed simp } note ABsubset = this - have "\a. \n. a\{A n..B n}" apply(rule decreasing_closed_nest[rule_format,OF closed_interval _ ABsubset interv]) - proof- fix n show "{A n..B n} \ {}" apply(cases "0{a..b}" using x0[of 0] unfolding AB . - fix e assume "0 < (e::real)" from interv[OF this] guess n .. note n=this + qed simp + } note ABsubset = this + have "\a. \n. a\{A n..B n}" + apply (rule decreasing_closed_nest[rule_format,OF closed_interval _ ABsubset interv]) + proof - + fix n + show "{A n..B n} \ {}" + apply (cases "0 < n") + using AB(3)[of "n - 1"] assms(1,3) AB(1-2) + apply auto + done + qed auto + then obtain x0 where x0: "\n. x0 \ {A n..B n}" + by blast + show thesis + proof (rule that[rule_format, of x0]) + show "x0\{a..b}" + using x0[of 0] unfolding AB . + fix e :: real + assume "e > 0" + from interv[OF this] obtain n + where n: "\x\{A n..B n}. \y\{A n..B n}. dist x y < e" .. show "\c d. x0 \ {c..d} \ {c..d} \ ball x0 e \ {c..d} \ {a..b} \ \ P {c..d}" - apply(rule_tac x="A n" in exI,rule_tac x="B n" in exI) apply(rule,rule x0) apply rule defer - proof show "\ P {A n..B n}" apply(cases "0 ball x0 e" using n using x0[of n] by auto - show "{A n..B n} \ {a..b}" unfolding AB(1-2)[symmetric] apply(rule ABsubset) by auto - qed qed qed + apply (rule_tac x="A n" in exI) + apply (rule_tac x="B n" in exI) + apply rule + apply (rule x0) + apply rule + defer + apply rule + proof - + show "\ P {A n..B n}" + apply (cases "0 < n") + using AB(3)[of "n - 1"] assms(3) AB(1-2) + apply auto + done + show "{A n..B n} \ ball x0 e" + using n using x0[of n] by auto + show "{A n..B n} \ {a..b}" + unfolding AB(1-2)[symmetric] by (rule ABsubset) auto + qed + qed +qed + subsection {* Cousin's lemma. *} -lemma fine_division_exists: assumes "gauge g" - obtains p where "p tagged_division_of {a..b::'a::ordered_euclidean_space}" "g fine p" -proof- presume "\ (\p. p tagged_division_of {a..b} \ g fine p) \ False" - then guess p unfolding atomize_not not_not .. thus thesis apply-apply(rule that[of p]) by auto -next assume as:"\ (\p. p tagged_division_of {a..b} \ g fine p)" - guess x apply(rule interval_bisection[of "\s. \p. p tagged_division_of s \ g fine p",rule_format,OF _ _ as]) - apply(rule_tac x="{}" in exI) defer apply(erule conjE exE)+ - proof- show "{} tagged_division_of {} \ g fine {}" unfolding fine_def by auto - fix s t p p' assume "p tagged_division_of s" "g fine p" "p' tagged_division_of t" "g fine p'" "interior s \ interior t = {}" - thus "\p. p tagged_division_of s \ t \ g fine p" apply-apply(rule_tac x="p \ p'" in exI) apply rule - apply(rule tagged_division_union) prefer 4 apply(rule fine_union) by auto - qed note x=this - obtain e where e:"e>0" "ball x e \ g x" using gaugeD[OF assms, of x] unfolding open_contains_ball by auto - from x(2)[OF e(1)] guess c d apply-apply(erule exE conjE)+ . note c_d = this - have "g fine {(x, {c..d})}" unfolding fine_def using e using c_d(2) by auto - thus False using tagged_division_of_self[OF c_d(1)] using c_d by auto qed +lemma fine_division_exists: + fixes a b :: "'a::ordered_euclidean_space" + assumes "gauge g" + obtains p where "p tagged_division_of {a..b}" "g fine p" +proof - + presume "\ (\p. p tagged_division_of {a..b} \ g fine p) \ False" + then obtain p where "p tagged_division_of {a..b}" "g fine p" + by blast + then show thesis .. +next + assume as: "\ (\p. p tagged_division_of {a..b} \ g fine p)" + guess x + apply (rule interval_bisection[of "\s. \p. p tagged_division_of s \ g fine p",rule_format,OF _ _ as]) + apply (rule_tac x="{}" in exI) + defer + apply (erule conjE exE)+ + proof - + show "{} tagged_division_of {} \ g fine {}" + unfolding fine_def by auto + fix s t p p' + assume "p tagged_division_of s" "g fine p" "p' tagged_division_of t" "g fine p'" + "interior s \ interior t = {}" + then show "\p. p tagged_division_of s \ t \ g fine p" + apply - + apply (rule_tac x="p \ p'" in exI) + apply rule + apply (rule tagged_division_union) + prefer 4 + apply (rule fine_union) + apply auto + done + qed note x = this + obtain e where e: "e > 0" "ball x e \ g x" + using gaugeD[OF assms, of x] unfolding open_contains_ball by auto + from x(2)[OF e(1)] obtain c d where c_d: + "x \ {c..d}" + "{c..d} \ ball x e" + "{c..d} \ {a..b}" + "\ (\p. p tagged_division_of {c..d} \ g fine p)" + by blast + have "g fine {(x, {c..d})}" + unfolding fine_def using e using c_d(2) by auto + then show False + using tagged_division_of_self[OF c_d(1)] using c_d by auto +qed + subsection {* Basic theorems about integrals. *} -lemma has_integral_unique: fixes f::"'n::ordered_euclidean_space \ 'a::real_normed_vector" - assumes "(f has_integral k1) i" "(f has_integral k2) i" shows "k1 = k2" -proof(rule ccontr) let ?e = "norm(k1 - k2) / 2" assume as:"k1 \ k2" hence e:"?e > 0" by auto - have lem:"\f::'n \ 'a. \ a b k1 k2. +lemma has_integral_unique: + fixes f :: "'n::ordered_euclidean_space \ 'a::real_normed_vector" + assumes "(f has_integral k1) i" + and "(f has_integral k2) i" + shows "k1 = k2" +proof (rule ccontr) + let ?e = "norm(k1 - k2) / 2" + assume as:"k1 \ k2" + then have e: "?e > 0" + by auto + have lem: "\f::'n \ 'a. \a b k1 k2. (f has_integral k1) ({a..b}) \ (f has_integral k2) ({a..b}) \ k1 \ k2 \ False" - proof- case goal1 let ?e = "norm(k1 - k2) / 2" from goal1(3) have e:"?e > 0" by auto - guess d1 by(rule has_integralD[OF goal1(1) e]) note d1=this - guess d2 by(rule has_integralD[OF goal1(2) e]) note d2=this - guess p by(rule fine_division_exists[OF gauge_inter[OF d1(1) d2(1)],of a b]) note p=this - let ?c = "(\(x, k)\p. content k *\<^sub>R f x)" have "norm (k1 - k2) \ norm (?c - k2) + norm (?c - k1)" - using norm_triangle_ineq4[of "k1 - ?c" "k2 - ?c"] by(auto simp add:algebra_simps norm_minus_commute) + proof - + case goal1 + let ?e = "norm (k1 - k2) / 2" + from goal1(3) have e: "?e > 0" by auto + guess d1 by (rule has_integralD[OF goal1(1) e]) note d1=this + guess d2 by (rule has_integralD[OF goal1(2) e]) note d2=this + guess p by (rule fine_division_exists[OF gauge_inter[OF d1(1) d2(1)],of a b]) note p=this + let ?c = "(\(x, k)\p. content k *\<^sub>R f x)" + have "norm (k1 - k2) \ norm (?c - k2) + norm (?c - k1)" + using norm_triangle_ineq4[of "k1 - ?c" "k2 - ?c"] + by (auto simp add:algebra_simps norm_minus_commute) also have "\ < norm (k1 - k2) / 2 + norm (k1 - k2) / 2" - apply(rule add_strict_mono) apply(rule_tac[!] d2(2) d1(2)) using p unfolding fine_def by auto + apply (rule add_strict_mono) + apply (rule_tac[!] d2(2) d1(2)) + using p unfolding fine_def + apply auto + done finally show False by auto - qed { presume "\ (\a b. i = {a..b}) \ False" - thus False apply-apply(cases "\a b. i = {a..b}") - using assms by(auto simp add:has_integral intro:lem[OF _ _ as]) } - assume as:"\ (\a b. i = {a..b})" - guess B1 by(rule has_integral_altD[OF assms(1) as,OF e]) note B1=this[rule_format] - guess B2 by(rule has_integral_altD[OF assms(2) as,OF e]) note B2=this[rule_format] - have "\a b::'n. ball 0 B1 \ ball 0 B2 \ {a..b}" apply(rule bounded_subset_closed_interval) - using bounded_Un bounded_ball by auto then guess a b apply-by(erule exE)+ - note ab=conjunctD2[OF this[unfolded Un_subset_iff]] - guess w using B1(2)[OF ab(1)] .. note w=conjunctD2[OF this] - guess z using B2(2)[OF ab(2)] .. note z=conjunctD2[OF this] - have "z = w" using lem[OF w(1) z(1)] by auto - hence "norm (k1 - k2) \ norm (z - k2) + norm (w - k1)" - using norm_triangle_ineq4[of "k1 - w" "k2 - z"] by(auto simp add: norm_minus_commute) - also have "\ < norm (k1 - k2) / 2 + norm (k1 - k2) / 2" apply(rule add_strict_mono) by(rule_tac[!] z(2) w(2)) - finally show False by auto qed - -lemma integral_unique[intro]: - "(f has_integral y) k \ integral k f = y" - unfolding integral_def apply(rule some_equality) by(auto intro: has_integral_unique) - -lemma has_integral_is_0: fixes f::"'n::ordered_euclidean_space \ 'a::real_normed_vector" - assumes "\x\s. f x = 0" shows "(f has_integral 0) s" -proof- have lem:"\a b. \f::'n \ 'a. - (\x\{a..b}. f(x) = 0) \ (f has_integral 0) ({a..b})" unfolding has_integral - proof(rule,rule) fix a b e and f::"'n \ 'a" - assume as:"\x\{a..b}. f x = 0" "0 < (e::real)" - show "\d. gauge d \ (\p. p tagged_division_of {a..b} \ d fine p \ norm ((\(x, k)\p. content k *\<^sub>R f x) - 0) < e)" - apply(rule_tac x="\x. ball x 1" in exI) apply(rule,rule gaugeI) unfolding centre_in_ball defer apply(rule open_ball) - proof(rule,rule,erule conjE) case goal1 - have "(\(x, k)\p. content k *\<^sub>R f x) = 0" proof(rule setsum_0',rule) - fix x assume x:"x\p" have "f (fst x) = 0" using tagged_division_ofD(2-3)[OF goal1(1), of "fst x" "snd x"] using as x by auto - thus "(\(x, k). content k *\<^sub>R f x) x = 0" apply(subst surjective_pairing[of x]) unfolding split_conv by auto - qed thus ?case using as by auto - qed auto qed { presume "\ (\a b. s = {a..b}) \ ?thesis" - thus ?thesis apply-apply(cases "\a b. s = {a..b}") - using assms by(auto simp add:has_integral intro:lem) } - have *:"(\x. if x \ s then f x else 0) = (\x. 0)" apply(rule ext) using assms by auto - assume "\ (\a b. s = {a..b})" thus ?thesis apply(subst has_integral_alt) unfolding if_not_P * - apply(rule,rule,rule_tac x=1 in exI,rule) defer apply(rule,rule,rule) - proof- fix e::real and a b assume "e>0" - thus "\z. ((\x::'n. 0::'a) has_integral z) {a..b} \ norm (z - 0) < e" - apply(rule_tac x=0 in exI) apply(rule,rule lem) by auto - qed auto qed + qed + { + presume "\ (\a b. i = {a..b}) \ False" + then show False + apply - + apply (cases "\a b. i = {a..b}") + using assms + apply (auto simp add:has_integral intro:lem[OF _ _ as]) + done + } + assume as: "\ (\a b. i = {a..b})" + guess B1 by (rule has_integral_altD[OF assms(1) as,OF e]) note B1=this[rule_format] + guess B2 by (rule has_integral_altD[OF assms(2) as,OF e]) note B2=this[rule_format] + have "\a b::'n. ball 0 B1 \ ball 0 B2 \ {a..b}" + apply (rule bounded_subset_closed_interval) + using bounded_Un bounded_ball + apply auto + done + then obtain a b :: 'n where ab: "ball 0 B1 \ {a..b}" "ball 0 B2 \ {a..b}" + by blast + obtain w where w: + "((\x. if x \ i then f x else 0) has_integral w) {a..b}" + "norm (w - k1) < norm (k1 - k2) / 2" + using B1(2)[OF ab(1)] by blast + obtain z where z: + "((\x. if x \ i then f x else 0) has_integral z) {a..b}" + "norm (z - k2) < norm (k1 - k2) / 2" + using B2(2)[OF ab(2)] by blast + have "z = w" + using lem[OF w(1) z(1)] by auto + then have "norm (k1 - k2) \ norm (z - k2) + norm (w - k1)" + using norm_triangle_ineq4 [of "k1 - w" "k2 - z"] + by (auto simp add: norm_minus_commute) + also have "\ < norm (k1 - k2) / 2 + norm (k1 - k2) / 2" + apply (rule add_strict_mono) + apply (rule_tac[!] z(2) w(2)) + done + finally show False by auto +qed + +lemma integral_unique [intro]: "(f has_integral y) k \ integral k f = y" + unfolding integral_def + by (rule some_equality) (auto intro: has_integral_unique) + +lemma has_integral_is_0: + fixes f :: "'n::ordered_euclidean_space \ 'a::real_normed_vector" + assumes "\x\s. f x = 0" + shows "(f has_integral 0) s" +proof - + have lem: "\a b. \f::'n \ 'a. + (\x\{a..b}. f(x) = 0) \ (f has_integral 0) ({a..b})" + unfolding has_integral + apply rule + apply rule + proof - + fix a b e + fix f :: "'n \ 'a" + assume as: "\x\{a..b}. f x = 0" "0 < (e::real)" + show "\d. gauge d \ + (\p. p tagged_division_of {a..b} \ d fine p \ norm ((\(x, k)\p. content k *\<^sub>R f x) - 0) < e)" + apply (rule_tac x="\x. ball x 1" in exI) + apply rule + apply (rule gaugeI) + unfolding centre_in_ball + defer + apply (rule open_ball) + apply rule + apply rule + apply (erule conjE) + proof - + case goal1 + have "(\(x, k)\p. content k *\<^sub>R f x) = 0" + proof (rule setsum_0', rule) + fix x + assume x: "x \ p" + have "f (fst x) = 0" + using tagged_division_ofD(2-3)[OF goal1(1), of "fst x" "snd x"] using as x by auto + then show "(\(x, k). content k *\<^sub>R f x) x = 0" + apply (subst surjective_pairing[of x]) + unfolding split_conv + apply auto + done + qed + then show ?case + using as by auto + qed auto + qed + { + presume "\ (\a b. s = {a..b}) \ ?thesis" + then show ?thesis + apply - + apply (cases "\a b. s = {a..b}") + using assms + apply (auto simp add:has_integral intro: lem) + done + } + have *: "(\x. if x \ s then f x else 0) = (\x. 0)" + apply (rule ext) + using assms + apply auto + done + assume "\ (\a b. s = {a..b})" + then show ?thesis + apply (subst has_integral_alt) + unfolding if_not_P * + apply rule + apply rule + apply (rule_tac x=1 in exI) + apply rule + defer + apply rule + apply rule + apply rule + proof - + fix e :: real + fix a b + assume "e > 0" + then show "\z. ((\x::'n. 0::'a) has_integral z) {a..b} \ norm (z - 0) < e" + apply (rule_tac x=0 in exI) + apply(rule,rule lem) + apply auto + done + qed auto +qed lemma has_integral_0[simp]: "((\x::'n::ordered_euclidean_space. 0) has_integral 0) s" - apply(rule has_integral_is_0) by auto + by (rule has_integral_is_0) auto lemma has_integral_0_eq[simp]: "((\x. 0) has_integral i) s \ i = 0" using has_integral_unique[OF has_integral_0] by auto -lemma has_integral_linear: fixes f::"'n::ordered_euclidean_space \ 'a::real_normed_vector" - assumes "(f has_integral y) s" "bounded_linear h" shows "((h o f) has_integral ((h y))) s" -proof- interpret bounded_linear h using assms(2) . from pos_bounded guess B .. note B=conjunctD2[OF this,rule_format] - have lem:"\f::'n \ 'a. \ y a b. - (f has_integral y) ({a..b}) \ ((h o f) has_integral h(y)) ({a..b})" - proof(subst has_integral,rule,rule) case goal1 - from pos_bounded guess B .. note B=conjunctD2[OF this,rule_format] - have *:"e / B > 0" apply(rule divide_pos_pos) using goal1(2) B by auto - guess g using has_integralD[OF goal1(1) *] . note g=this - show ?case apply(rule_tac x=g in exI) apply(rule,rule g(1)) - proof(rule,rule,erule conjE) fix p assume as:"p tagged_division_of {a..b}" "g fine p" - have *:"\x k. h ((\(x, k). content k *\<^sub>R f x) x) = (\(x, k). h (content k *\<^sub>R f x)) x" by auto +lemma has_integral_linear: + fixes f :: "'n::ordered_euclidean_space \ 'a::real_normed_vector" + assumes "(f has_integral y) s" + and "bounded_linear h" + shows "((h o f) has_integral ((h y))) s" +proof - + interpret bounded_linear h + using assms(2) . + from pos_bounded obtain B where B: "0 < B" "\x. norm (h x) \ norm x * B" + by blast + have lem: "\(f :: 'n \ 'a) y a b. + (f has_integral y) {a..b} \ ((h o f) has_integral h y) {a..b}" + apply (subst has_integral) + apply rule + apply rule + proof - + case goal1 + from pos_bounded + obtain B where B: "0 < B" "\x. norm (h x) \ norm x * B" + by blast + have *: "e / B > 0" + apply (rule divide_pos_pos) + using goal1(2) B + apply auto + done + thm has_integralD[OF goal1(1) *] + obtain g where g: + "gauge g" + "\p. p tagged_division_of {a..b} \ g fine p \ + norm ((\(x, k)\p. content k *\<^sub>R f x) - y) < e / B" + by (rule has_integralD[OF goal1(1) *]) blast + show ?case + apply (rule_tac x=g in exI) + apply rule + apply (rule g(1)) + apply rule + apply rule + apply (erule conjE) + proof - + fix p + assume as: "p tagged_division_of {a..b}" "g fine p" + have *: "\x k. h ((\(x, k). content k *\<^sub>R f x) x) = (\(x, k). h (content k *\<^sub>R f x)) x" + by auto have "(\(x, k)\p. content k *\<^sub>R (h \ f) x) = setsum (h \ (\(x, k). content k *\<^sub>R f x)) p" - unfolding o_def unfolding scaleR[THEN sym] * by simp - also have "\ = h (\(x, k)\p. content k *\<^sub>R f x)" using setsum[of "\(x,k). content k *\<^sub>R f x" p] using as by auto - finally have *:"(\(x, k)\p. content k *\<^sub>R (h \ f) x) = h (\(x, k)\p. content k *\<^sub>R f x)" . - show "norm ((\(x, k)\p. content k *\<^sub>R (h \ f) x) - h y) < e" unfolding * diff[THEN sym] - apply(rule le_less_trans[OF B(2)]) using g(2)[OF as] B(1) by(auto simp add:field_simps) - qed qed { presume "\ (\a b. s = {a..b}) \ ?thesis" - thus ?thesis apply-apply(cases "\a b. s = {a..b}") using assms by(auto simp add:has_integral intro!:lem) } - assume as:"\ (\a b. s = {a..b})" thus ?thesis apply(subst has_integral_alt) unfolding if_not_P - proof(rule,rule) fix e::real assume e:"0B>0. \a b. ball 0 B \ {a..b} \ (\z. ((\x. if x \ s then (h \ f) x else 0) has_integral z) {a..b} \ norm (z - h y) < e)" - apply(rule_tac x=M in exI) apply(rule,rule M(1)) - proof(rule,rule,rule) case goal1 guess z using M(2)[OF goal1(1)] .. note z=conjunctD2[OF this] - have *:"(\x. if x \ s then (h \ f) x else 0) = h \ (\x. if x \ s then f x else 0)" - unfolding o_def apply(rule ext) using zero by auto - show ?case apply(rule_tac x="h z" in exI,rule) unfolding * apply(rule lem[OF z(1)]) unfolding diff[THEN sym] - apply(rule le_less_trans[OF B(2)]) using B(1) z(2) by(auto simp add:field_simps) - qed qed qed - -lemma has_integral_cmul: - shows "(f has_integral k) s \ ((\x. c *\<^sub>R f x) has_integral (c *\<^sub>R k)) s" - unfolding o_def[THEN sym] apply(rule has_integral_linear,assumption) - by(rule bounded_linear_scaleR_right) + unfolding o_def unfolding scaleR[symmetric] * by simp + also have "\ = h (\(x, k)\p. content k *\<^sub>R f x)" + using setsum[of "\(x,k). content k *\<^sub>R f x" p] using as by auto + finally have *: "(\(x, k)\p. content k *\<^sub>R (h \ f) x) = h (\(x, k)\p. content k *\<^sub>R f x)" . + show "norm ((\(x, k)\p. content k *\<^sub>R (h \ f) x) - h y) < e" + unfolding * diff[symmetric] + apply (rule le_less_trans[OF B(2)]) + using g(2)[OF as] B(1) + apply (auto simp add: field_simps) + done + qed + qed + { + presume "\ (\a b. s = {a..b}) \ ?thesis" + then show ?thesis + apply - + apply (cases "\a b. s = {a..b}") + using assms + apply (auto simp add:has_integral intro!:lem) + done + } + assume as: "\ (\a b. s = {a..b})" + then show ?thesis + apply (subst has_integral_alt) + unfolding if_not_P + apply rule + apply rule + proof - + fix e :: real + assume e: "e > 0" + have *: "0 < e/B" + by (rule divide_pos_pos,rule e,rule B(1)) + obtain M where M: + "M > 0" + "\a b. ball 0 M \ {a..b} \ + \z. ((\x. if x \ s then f x else 0) has_integral z) {a..b} \ norm (z - y) < e / B" + using has_integral_altD[OF assms(1) as *] by blast + show "\B>0. \a b. ball 0 B \ {a..b} \ + (\z. ((\x. if x \ s then (h \ f) x else 0) has_integral z) {a..b} \ norm (z - h y) < e)" + apply (rule_tac x=M in exI) + apply rule + apply (rule M(1)) + apply rule + apply rule + apply rule + proof - + case goal1 + obtain z where z: + "((\x. if x \ s then f x else 0) has_integral z) {a..b}" + "norm (z - y) < e / B" + using M(2)[OF goal1(1)] by blast + have *: "(\x. if x \ s then (h \ f) x else 0) = h \ (\x. if x \ s then f x else 0)" + unfolding o_def + apply (rule ext) + using zero + apply auto + done + show ?case + apply (rule_tac x="h z" in exI) + apply rule + unfolding * + apply (rule lem[OF z(1)]) + unfolding diff[symmetric] + apply (rule le_less_trans[OF B(2)]) + using B(1) z(2) + apply (auto simp add: field_simps) + done + qed + qed +qed + +lemma has_integral_cmul: "(f has_integral k) s \ ((\x. c *\<^sub>R f x) has_integral (c *\<^sub>R k)) s" + unfolding o_def[symmetric] + apply (rule has_integral_linear,assumption) + apply (rule bounded_linear_scaleR_right) + done lemma has_integral_cmult_real: fixes c :: real assumes "c \ 0 \ (f has_integral x) A" shows "((\x. c * f x) has_integral c * x) A" -proof cases - assume "c \ 0" +proof (cases "c = 0") + case True + then show ?thesis by simp +next + case False from has_integral_cmul[OF assms[OF this], of c] show ?thesis unfolding real_scaleR_def . -qed simp - -lemma has_integral_neg: - shows "(f has_integral k) s \ ((\x. -(f x)) has_integral (-k)) s" - apply(drule_tac c="-1" in has_integral_cmul) by auto - -lemma has_integral_add: fixes f::"'n::ordered_euclidean_space \ 'a::real_normed_vector" - assumes "(f has_integral k) s" "(g has_integral l) s" +qed + +lemma has_integral_neg: "(f has_integral k) s \ ((\x. -(f x)) has_integral (-k)) s" + apply (drule_tac c="-1" in has_integral_cmul) + apply auto + done + +lemma has_integral_add: + fixes f :: "'n::ordered_euclidean_space \ 'a::real_normed_vector" + assumes "(f has_integral k) s" + and "(g has_integral l) s" shows "((\x. f x + g x) has_integral (k + l)) s" -proof- have lem:"\f g::'n \ 'a. \a b k l. - (f has_integral k) ({a..b}) \ (g has_integral l) ({a..b}) \ - ((\x. f(x) + g(x)) has_integral (k + l)) ({a..b})" proof- case goal1 - show ?case unfolding has_integral proof(rule,rule) fix e::real assume e:"e>0" hence *:"e/2>0" by auto - guess d1 using has_integralD[OF goal1(1) *] . note d1=this - guess d2 using has_integralD[OF goal1(2) *] . note d2=this - show "\d. gauge d \ (\p. p tagged_division_of {a..b} \ d fine p \ norm ((\(x, k)\p. content k *\<^sub>R (f x + g x)) - (k + l)) < e)" - apply(rule_tac x="\x. (d1 x) \ (d2 x)" in exI) apply(rule,rule gauge_inter[OF d1(1) d2(1)]) - proof(rule,rule,erule conjE) fix p assume as:"p tagged_division_of {a..b}" "(\x. d1 x \ d2 x) fine p" - have *:"(\(x, k)\p. content k *\<^sub>R (f x + g x)) = (\(x, k)\p. content k *\<^sub>R f x) + (\(x, k)\p. content k *\<^sub>R g x)" - unfolding scaleR_right_distrib setsum_addf[of "\(x,k). content k *\<^sub>R f x" "\(x,k). content k *\<^sub>R g x" p,THEN sym] - by(rule setsum_cong2,auto) - have "norm ((\(x, k)\p. content k *\<^sub>R (f x + g x)) - (k + l)) = norm (((\(x, k)\p. content k *\<^sub>R f x) - k) + ((\(x, k)\p. content k *\<^sub>R g x) - l))" - unfolding * by(auto simp add:algebra_simps) also let ?res = "\" - from as have *:"d1 fine p" "d2 fine p" unfolding fine_inter by auto - have "?res < e/2 + e/2" apply(rule le_less_trans[OF norm_triangle_ineq]) - apply(rule add_strict_mono) using d1(2)[OF as(1) *(1)] and d2(2)[OF as(1) *(2)] by auto - finally show "norm ((\(x, k)\p. content k *\<^sub>R (f x + g x)) - (k + l)) < e" by auto - qed qed qed { presume "\ (\a b. s = {a..b}) \ ?thesis" - thus ?thesis apply-apply(cases "\a b. s = {a..b}") using assms by(auto simp add:has_integral intro!:lem) } - assume as:"\ (\a b. s = {a..b})" thus ?thesis apply(subst has_integral_alt) unfolding if_not_P - proof(rule,rule) case goal1 hence *:"e/2 > 0" by auto +proof - + have lem:"\(f:: 'n \ 'a) g a b k l. + (f has_integral k) {a..b} \ + (g has_integral l) {a..b} \ + ((\x. f x + g x) has_integral (k + l)) {a..b}" + proof - + case goal1 + show ?case + unfolding has_integral + apply rule + apply rule + proof - + fix e :: real + assume e: "e > 0" + then have *: "e/2 > 0" + by auto + obtain d1 where d1: + "gauge d1" + "\p. p tagged_division_of {a..b} \ d1 fine p \ + norm ((\(x, k)\p. content k *\<^sub>R f x) - k) < e / 2" + using has_integralD[OF goal1(1) *] by blast + obtain d2 where d2: + "gauge d2" + "\p. p tagged_division_of {a..b} \ d2 fine p \ + norm ((\(x, k)\p. content k *\<^sub>R g x) - l) < e / 2" + using has_integralD[OF goal1(2) *] by blast + show "\d. gauge d \ (\p. p tagged_division_of {a..b} \ d fine p \ + norm ((\(x, k)\p. content k *\<^sub>R (f x + g x)) - (k + l)) < e)" + apply (rule_tac x="\x. (d1 x) \ (d2 x)" in exI) + apply rule + apply (rule gauge_inter[OF d1(1) d2(1)]) + apply (rule,rule,erule conjE) + proof - + fix p + assume as: "p tagged_division_of {a..b}" "(\x. d1 x \ d2 x) fine p" + have *: "(\(x, k)\p. content k *\<^sub>R (f x + g x)) = + (\(x, k)\p. content k *\<^sub>R f x) + (\(x, k)\p. content k *\<^sub>R g x)" + unfolding scaleR_right_distrib setsum_addf[of "\(x,k). content k *\<^sub>R f x" "\(x,k). content k *\<^sub>R g x" p,symmetric] + by (rule setsum_cong2) auto + have "norm ((\(x, k)\p. content k *\<^sub>R (f x + g x)) - (k + l)) = + norm (((\(x, k)\p. content k *\<^sub>R f x) - k) + ((\(x, k)\p. content k *\<^sub>R g x) - l))" + unfolding * by (auto simp add: algebra_simps) + also + let ?res = "\" + from as have *: "d1 fine p" "d2 fine p" + unfolding fine_inter by auto + have "?res < e/2 + e/2" + apply (rule le_less_trans[OF norm_triangle_ineq]) + apply (rule add_strict_mono) + using d1(2)[OF as(1) *(1)] and d2(2)[OF as(1) *(2)] + apply auto + done + finally show "norm ((\(x, k)\p. content k *\<^sub>R (f x + g x)) - (k + l)) < e" + by auto + qed + qed + qed + { + presume "\ (\a b. s = {a..b}) \ ?thesis" + then show ?thesis + apply - + apply (cases "\a b. s = {a..b}") + using assms + apply (auto simp add:has_integral intro!:lem) + done + } + assume as: "\ (\a b. s = {a..b})" + then show ?thesis + apply (subst has_integral_alt) + unfolding if_not_P + apply rule + apply rule + proof - + case goal1 + then have *: "e/2 > 0" + by auto from has_integral_altD[OF assms(1) as *] guess B1 . note B1=this[rule_format] from has_integral_altD[OF assms(2) as *] guess B2 . note B2=this[rule_format] - show ?case apply(rule_tac x="max B1 B2" in exI) apply(rule,rule min_max.less_supI1,rule B1) - proof(rule,rule,rule) fix a b assume "ball 0 (max B1 B2) \ {a..b::'n}" - hence *:"ball 0 B1 \ {a..b::'n}" "ball 0 B2 \ {a..b::'n}" by auto - guess w using B1(2)[OF *(1)] .. note w=conjunctD2[OF this] - guess z using B2(2)[OF *(2)] .. note z=conjunctD2[OF this] - have *:"\x. (if x \ s then f x + g x else 0) = (if x \ s then f x else 0) + (if x \ s then g x else 0)" by auto + show ?case + apply (rule_tac x="max B1 B2" in exI) + apply rule + apply (rule min_max.less_supI1) + apply (rule B1) + apply rule + apply rule + apply rule + proof - + fix a b + assume "ball 0 (max B1 B2) \ {a..b::'n}" + then have *: "ball 0 B1 \ {a..b::'n}" "ball 0 B2 \ {a..b::'n}" + by auto + obtain w where w: + "((\x. if x \ s then f x else 0) has_integral w) {a..b}" + "norm (w - k) < e / 2" + using B1(2)[OF *(1)] by blast + obtain z where z: + "((\x. if x \ s then g x else 0) has_integral z) {a..b}" + "norm (z - l) < e / 2" + using B2(2)[OF *(2)] by blast + have *: "\x. (if x \ s then f x + g x else 0) = + (if x \ s then f x else 0) + (if x \ s then g x else 0)" + by auto show "\z. ((\x. if x \ s then f x + g x else 0) has_integral z) {a..b} \ norm (z - (k + l)) < e" - apply(rule_tac x="w + z" in exI) apply(rule,rule lem[OF w(1) z(1), unfolded *[THEN sym]]) - using norm_triangle_ineq[of "w - k" "z - l"] w(2) z(2) by(auto simp add:field_simps) - qed qed qed + apply (rule_tac x="w + z" in exI) + apply rule + apply (rule lem[OF w(1) z(1), unfolded *[symmetric]]) + using norm_triangle_ineq[of "w - k" "z - l"] w(2) z(2) + apply (auto simp add: field_simps) + done + qed + qed +qed lemma has_integral_sub: - shows "(f has_integral k) s \ (g has_integral l) s \ ((\x. f(x) - g(x)) has_integral (k - l)) s" - using has_integral_add[OF _ has_integral_neg,of f k s g l] unfolding algebra_simps by auto - -lemma integral_0: "integral s (\x::'n::ordered_euclidean_space. 0::'m::real_normed_vector) = 0" - by(rule integral_unique has_integral_0)+ - -lemma integral_add: - shows "f integrable_on s \ g integrable_on s \ - integral s (\x. f x + g x) = integral s f + integral s g" - apply(rule integral_unique) apply(drule integrable_integral)+ - apply(rule has_integral_add) by assumption+ - -lemma integral_cmul: - shows "f integrable_on s \ integral s (\x. c *\<^sub>R f x) = c *\<^sub>R integral s f" - apply(rule integral_unique) apply(drule integrable_integral)+ - apply(rule has_integral_cmul) by assumption+ - -lemma integral_neg: - shows "f integrable_on s \ integral s (\x. - f x) = - integral s f" - apply(rule integral_unique) apply(drule integrable_integral)+ - apply(rule has_integral_neg) by assumption+ - -lemma integral_sub: - shows "f integrable_on s \ g integrable_on s \ integral s (\x. f x - g x) = integral s f - integral s g" - apply(rule integral_unique) apply(drule integrable_integral)+ - apply(rule has_integral_sub) by assumption+ + "(f has_integral k) s \ (g has_integral l) s \ + ((\x. f x - g x) has_integral (k - l)) s" + using has_integral_add[OF _ has_integral_neg, of f k s g l] + unfolding algebra_simps + by auto + +lemma integral_0: + "integral s (\x::'n::ordered_euclidean_space. 0::'m::real_normed_vector) = 0" + by (rule integral_unique has_integral_0)+ + +lemma integral_add: "f integrable_on s \ g integrable_on s \ + integral s (\x. f x + g x) = integral s f + integral s g" + apply (rule integral_unique) + apply (drule integrable_integral)+ + apply (rule has_integral_add) + apply assumption+ + done + +lemma integral_cmul: "f integrable_on s \ integral s (\x. c *\<^sub>R f x) = c *\<^sub>R integral s f" + apply (rule integral_unique) + apply (drule integrable_integral)+ + apply (rule has_integral_cmul) + apply assumption+ + done + +lemma integral_neg: "f integrable_on s \ integral s (\x. - f x) = - integral s f" + apply (rule integral_unique) + apply (drule integrable_integral)+ + apply (rule has_integral_neg) + apply assumption+ + done + +lemma integral_sub: "f integrable_on s \ g integrable_on s \ + integral s (\x. f x - g x) = integral s f - integral s g" + apply (rule integral_unique) + apply (drule integrable_integral)+ + apply (rule has_integral_sub) + apply assumption+ + done lemma integrable_0: "(\x. 0) integrable_on s" unfolding integrable_on_def using has_integral_0 by auto -lemma integrable_add: - shows "f integrable_on s \ g integrable_on s \ (\x. f x + g x) integrable_on s" +lemma integrable_add: "f integrable_on s \ g integrable_on s \ (\x. f x + g x) integrable_on s" unfolding integrable_on_def by(auto intro: has_integral_add) -lemma integrable_cmul: - shows "f integrable_on s \ (\x. c *\<^sub>R f(x)) integrable_on s" +lemma integrable_cmul: "f integrable_on s \ (\x. c *\<^sub>R f(x)) integrable_on s" unfolding integrable_on_def by(auto intro: has_integral_cmul) lemma integrable_on_cmult_iff: - fixes c :: real assumes "c \ 0" + fixes c :: real + assumes "c \ 0" shows "(\x. c * f x) integrable_on s \ f integrable_on s" using integrable_cmul[of "\x. c * f x" s "1 / c"] integrable_cmul[of f s c] `c \ 0` by auto -lemma integrable_neg: - shows "f integrable_on s \ (\x. -f(x)) integrable_on s" +lemma integrable_neg: "f integrable_on s \ (\x. -f(x)) integrable_on s" unfolding integrable_on_def by(auto intro: has_integral_neg) lemma integrable_sub: - shows "f integrable_on s \ g integrable_on s \ (\x. f x - g x) integrable_on s" + "f integrable_on s \ g integrable_on s \ (\x. f x - g x) integrable_on s" unfolding integrable_on_def by(auto intro: has_integral_sub) lemma integrable_linear: - shows "f integrable_on s \ bounded_linear h \ (h o f) integrable_on s" + "f integrable_on s \ bounded_linear h \ (h \ f) integrable_on s" unfolding integrable_on_def by(auto intro: has_integral_linear) lemma integral_linear: - shows "f integrable_on s \ bounded_linear h \ integral s (h o f) = h(integral s f)" - apply(rule has_integral_unique) defer unfolding has_integral_integral - apply(drule has_integral_linear,assumption,assumption) unfolding has_integral_integral[THEN sym] - apply(rule integrable_linear) by assumption+ - -lemma integral_component_eq[simp]: fixes f::"'n::ordered_euclidean_space \ 'm::ordered_euclidean_space" - assumes "f integrable_on s" shows "integral s (\x. f x \ k) = integral s f \ k" + "f integrable_on s \ bounded_linear h \ integral s (h \ f) = h (integral s f)" + apply (rule has_integral_unique) + defer + unfolding has_integral_integral + apply (drule (2) has_integral_linear) + unfolding has_integral_integral[symmetric] + apply (rule integrable_linear) + apply assumption+ + done + +lemma integral_component_eq[simp]: + fixes f :: "'n::ordered_euclidean_space \ 'm::ordered_euclidean_space" + assumes "f integrable_on s" + shows "integral s (\x. f x \ k) = integral s f \ k" unfolding integral_linear[OF assms(1) bounded_linear_component,unfolded o_def] .. lemma has_integral_setsum: - assumes "finite t" "\a\t. ((f a) has_integral (i a)) s" + assumes "finite t" + and "\a\t. ((f a) has_integral (i a)) s" shows "((\x. setsum (\a. f a x) t) has_integral (setsum i t)) s" -proof(insert assms(1) subset_refl[of t],induct rule:finite_subset_induct) - case (insert x F) show ?case unfolding setsum_insert[OF insert(1,3)] - apply(rule has_integral_add) using insert assms by auto -qed auto - -lemma integral_setsum: - shows "finite t \ \a\t. (f a) integrable_on s \ + using assms(1) subset_refl[of t] +proof (induct rule: finite_subset_induct) + case empty + then show ?case by auto +next + case (insert x F) + show ?case + unfolding setsum_insert[OF insert(1,3)] + apply (rule has_integral_add) + using insert assms + apply auto + done +qed + +lemma integral_setsum: "finite t \ \a\t. (f a) integrable_on s \ integral s (\x. setsum (\a. f a x) t) = setsum (\a. integral s (f a)) t" - apply(rule integral_unique) apply(rule has_integral_setsum) - using integrable_integral by auto + apply (rule integral_unique) + apply (rule has_integral_setsum) + using integrable_integral + apply auto + done lemma integrable_setsum: - shows "finite t \ \a \ t.(f a) integrable_on s \ (\x. setsum (\a. f a x) t) integrable_on s" - unfolding integrable_on_def apply(drule bchoice) using has_integral_setsum[of t] by auto + "finite t \ \a \ t.(f a) integrable_on s \ (\x. setsum (\a. f a x) t) integrable_on s" + unfolding integrable_on_def + apply (drule bchoice) + using has_integral_setsum[of t] + apply auto + done lemma has_integral_eq: - assumes "\x\s. f x = g x" "(f has_integral k) s" shows "(g has_integral k) s" + assumes "\x\s. f x = g x" + and "(f has_integral k) s" + shows "(g has_integral k) s" using has_integral_sub[OF assms(2), of "\x. f x - g x" 0] - using has_integral_is_0[of s "\x. f x - g x"] using assms(1) by auto - -lemma integrable_eq: - shows "\x\s. f x = g x \ f integrable_on s \ g integrable_on s" - unfolding integrable_on_def using has_integral_eq[of s f g] by auto - -lemma has_integral_eq_eq: - shows "\x\s. f x = g x \ ((f has_integral k) s \ (g has_integral k) s)" - using has_integral_eq[of s f g] has_integral_eq[of s g f] by rule auto + using has_integral_is_0[of s "\x. f x - g x"] + using assms(1) + by auto + +lemma integrable_eq: "\x\s. f x = g x \ f integrable_on s \ g integrable_on s" + unfolding integrable_on_def + using has_integral_eq[of s f g] + by auto + +lemma has_integral_eq_eq: "\x\s. f x = g x \ (f has_integral k) s \ (g has_integral k) s" + using has_integral_eq[of s f g] has_integral_eq[of s g f] + by auto lemma has_integral_null[dest]: - assumes "content({a..b}) = 0" shows "(f has_integral 0) ({a..b})" - unfolding has_integral apply(rule,rule,rule_tac x="\x. ball x 1" in exI,rule) defer -proof(rule,rule,erule conjE) fix e::real assume e:"e>0" thus "gauge (\x. ball x 1)" by auto - fix p assume p:"p tagged_division_of {a..b}" (*"(\x. ball x 1) fine p"*) - have "norm ((\(x, k)\p. content k *\<^sub>R f x) - 0) = 0" unfolding norm_eq_zero diff_0_right - using setsum_content_null[OF assms(1) p, of f] . - thus "norm ((\(x, k)\p. content k *\<^sub>R f x) - 0) < e" using e by auto qed - -lemma has_integral_null_eq[simp]: - shows "content({a..b}) = 0 \ ((f has_integral i) ({a..b}) \ i = 0)" - apply rule apply(rule has_integral_unique,assumption) - apply(drule has_integral_null,assumption) - apply(drule has_integral_null) by auto - -lemma integral_null[dest]: shows "content({a..b}) = 0 \ integral({a..b}) f = 0" - by(rule integral_unique,drule has_integral_null) - -lemma integrable_on_null[dest]: shows "content({a..b}) = 0 \ f integrable_on {a..b}" - unfolding integrable_on_def apply(drule has_integral_null) by auto - -lemma has_integral_empty[intro]: shows "(f has_integral 0) {}" - unfolding empty_as_interval apply(rule has_integral_null) - using content_empty unfolding empty_as_interval . - -lemma has_integral_empty_eq[simp]: shows "(f has_integral i) {} \ i = 0" - apply(rule,rule has_integral_unique,assumption) by auto - -lemma integrable_on_empty[intro]: shows "f integrable_on {}" unfolding integrable_on_def by auto - -lemma integral_empty[simp]: shows "integral {} f = 0" - apply(rule integral_unique) using has_integral_empty . - -lemma has_integral_refl[intro]: shows "(f has_integral 0) {a..a}" "(f has_integral 0) {a::'a::ordered_euclidean_space}" -proof- - have *:"{a} = {a..a}" apply(rule set_eqI) unfolding mem_interval singleton_iff euclidean_eq_iff[where 'a='a] - apply safe prefer 3 apply(erule_tac x=b in ballE) by(auto simp add: field_simps) - show "(f has_integral 0) {a..a}" "(f has_integral 0) {a}" unfolding * - apply(rule_tac[!] has_integral_null) unfolding content_eq_0_interior - unfolding interior_closed_interval using interval_sing by auto qed - -lemma integrable_on_refl[intro]: shows "f integrable_on {a..a}" unfolding integrable_on_def by auto - -lemma integral_refl: shows "integral {a..a} f = 0" apply(rule integral_unique) by auto + assumes "content({a..b}) = 0" + shows "(f has_integral 0) ({a..b})" + unfolding has_integral + apply rule + apply rule + apply (rule_tac x="\x. ball x 1" in exI) + apply rule + defer + apply rule + apply rule + apply (erule conjE) +proof - + fix e :: real + assume e: "e > 0" + then show "gauge (\x. ball x 1)" + by auto + fix p + assume p: "p tagged_division_of {a..b}" + have "norm ((\(x, k)\p. content k *\<^sub>R f x) - 0) = 0" + unfolding norm_eq_zero diff_0_right + using setsum_content_null[OF assms(1) p, of f] . + then show "norm ((\(x, k)\p. content k *\<^sub>R f x) - 0) < e" + using e by auto +qed + +lemma has_integral_null_eq[simp]: "content {a..b} = 0 \ (f has_integral i) {a..b} \ i = 0" + apply rule + apply (rule has_integral_unique) + apply assumption + apply (drule (1) has_integral_null) + apply (drule has_integral_null) + apply auto + done + +lemma integral_null[dest]: "content {a..b} = 0 \ integral {a..b} f = 0" + apply (rule integral_unique) + apply (drule has_integral_null) + apply assumption + done + +lemma integrable_on_null[dest]: "content {a..b} = 0 \ f integrable_on {a..b}" + unfolding integrable_on_def + apply (drule has_integral_null) + apply auto + done + +lemma has_integral_empty[intro]: "(f has_integral 0) {}" + unfolding empty_as_interval + apply (rule has_integral_null) + using content_empty + unfolding empty_as_interval + apply assumption + done + +lemma has_integral_empty_eq[simp]: "(f has_integral i) {} \ i = 0" + apply rule + apply (rule has_integral_unique) + apply assumption + apply auto + done + +lemma integrable_on_empty[intro]: "f integrable_on {}" + unfolding integrable_on_def by auto + +lemma integral_empty[simp]: "integral {} f = 0" + by (rule integral_unique) (rule has_integral_empty) + +lemma has_integral_refl[intro]: + fixes a :: "'a::ordered_euclidean_space" + shows "(f has_integral 0) {a..a}" + and "(f has_integral 0) {a}" +proof - + have *: "{a} = {a..a}" + apply (rule set_eqI) + unfolding mem_interval singleton_iff euclidean_eq_iff[where 'a='a] + apply safe + prefer 3 + apply (erule_tac x=b in ballE) + apply (auto simp add: field_simps) + done + show "(f has_integral 0) {a..a}" "(f has_integral 0) {a}" + unfolding * + apply (rule_tac[!] has_integral_null) + unfolding content_eq_0_interior + unfolding interior_closed_interval + using interval_sing + apply auto + done +qed + +lemma integrable_on_refl[intro]: "f integrable_on {a..a}" + unfolding integrable_on_def by auto + +lemma integral_refl: "integral {a..a} f = 0" + by (rule integral_unique) auto + subsection {* Cauchy-type criterion for integrability. *} (* XXXXXXX *) -lemma integrable_cauchy: fixes f::"'n::ordered_euclidean_space \ 'a::{real_normed_vector,complete_space}" +lemma integrable_cauchy: fixes f::"'n::ordered_euclidean_space \ 'a::{real_normed_vector,complete_space}" shows "f integrable_on {a..b} \ (\e>0.\d. gauge d \ (\p1 p2. p1 tagged_division_of {a..b} \ d fine p1 \ p2 tagged_division_of {a..b} \ d fine p2 @@ -1985,15 +3155,15 @@ proof(rule,rule,rule,rule) fix m n assume mn:"N \ m" "N \ n" have *:"N = (N - 1) + 1" using N by auto show "norm ((\(x, k)\p m. content k *\<^sub>R f x) - (\(x, k)\p n. content k *\<^sub>R f x)) < e" apply(rule less_trans[OF _ N[THEN conjunct2,THEN conjunct2]]) apply(subst *) apply(rule d(2)) - using dp p(1) using mn by auto + using dp p(1) using mn by auto qed qed - then guess y unfolding convergent_eq_cauchy[THEN sym] .. note y=this[THEN LIMSEQ_D] + then guess y unfolding convergent_eq_cauchy[symmetric] .. note y=this[THEN LIMSEQ_D] show ?l unfolding integrable_on_def has_integral apply(rule_tac x=y in exI) proof(rule,rule) fix e::real assume "e>0" hence *:"e/2 > 0" by auto then guess N1 unfolding real_arch_inv[of "e/2"] .. note N1=this hence N1':"N1 = N1 - 1 + 1" by auto guess N2 using y[OF *] .. note N2=this show "\d. gauge d \ (\p. p tagged_division_of {a..b} \ d fine p \ norm ((\(x, k)\p. content k *\<^sub>R f x) - y) < e)" - apply(rule_tac x="d (N1 + N2)" in exI) apply rule defer + apply(rule_tac x="d (N1 + N2)" in exI) apply rule defer proof(rule,rule,erule conjE) show "gauge (d (N1 + N2))" using d by auto fix q assume as:"q tagged_division_of {a..b}" "d (N1 + N2) fine q" have *:"inverse (real (N1 + N2 + 1)) < e / 2" apply(rule less_trans) using N1 by auto @@ -2019,12 +3189,12 @@ have *:"Basis = insert k (Basis - {k})" "\x. finite (Basis-{x})" "\x. x\Basis-{x}" using assms by auto have *:"\X Y Z. (\i\Basis. Z i (if i = k then X else Y i)) = Z k X * (\i\Basis-{k}. Z i (Y i))" - "(\i\Basis. b\i - a\i) = (\i\Basis-{k}. b\i - a\i) * (b\k - a\k)" + "(\i\Basis. b\i - a\i) = (\i\Basis-{k}. b\i - a\i) * (b\k - a\k)" apply(subst *(1)) defer apply(subst *(1)) unfolding setprod_insert[OF *(2-)] by auto assume as:"a\b" moreover have "\x. min (b \ k) c = max (a \ k) c \ x* (b\k - a\k) = x*(max (a \ k) c - a \ k) + x*(b \ k - max (a \ k) c)" by (auto simp add:field_simps) - moreover have **:"(\i\Basis. ((\i\Basis. (if i = k then min (b \ k) c else b \ i) *\<^sub>R i) \ i - a \ i)) = + moreover have **:"(\i\Basis. ((\i\Basis. (if i = k then min (b \ k) c else b \ i) *\<^sub>R i) \ i - a \ i)) = (\i\Basis. (if i = k then min (b \ k) c else b \ i) - a \ i)" "(\i\Basis. b \ i - ((\i\Basis. (if i = k then max (a \ k) c else a \ i) *\<^sub>R i) \ i)) = (\i\Basis. b \ i - (if i = k then max (a \ k) c else a \ i))" @@ -2041,7 +3211,7 @@ qed lemma division_split_left_inj: fixes type::"'a::ordered_euclidean_space" - assumes "d division_of i" "k1 \ d" "k2 \ d" "k1 \ k2" + assumes "d division_of i" "k1 \ d" "k2 \ d" "k1 \ k2" "k1 \ {x::'a. x\k \ c} = k2 \ {x. x\k \ c}"and k:"k\Basis" shows "content(k1 \ {x. x\k \ c}) = 0" proof- note d=division_ofD[OF assms(1)] @@ -2052,7 +3222,7 @@ have **:"\s t u. s \ t = {} \ u \ s \ u \ t \ u = {}" by auto show ?thesis unfolding uv1 uv2 * apply(rule **[OF d(5)[OF assms(2-4)]]) defer apply(subst assms(5)[unfolded uv1 uv2]) unfolding uv1 uv2 by auto qed - + lemma division_split_right_inj: fixes type::"'a::ordered_euclidean_space" assumes "d division_of i" "k1 \ d" "k2 \ d" "k1 \ k2" "k1 \ {x::'a. x\k \ c} = k2 \ {x. x\k \ c}" and k:"k\Basis" @@ -2067,7 +3237,7 @@ defer apply(subst assms(5)[unfolded uv1 uv2]) unfolding uv1 uv2 by auto qed lemma tagged_division_split_left_inj: fixes x1::"'a::ordered_euclidean_space" - assumes "d tagged_division_of i" "(x1,k1) \ d" "(x2,k2) \ d" "k1 \ k2" "k1 \ {x. x\k \ c} = k2 \ {x. x\k \ c}" + assumes "d tagged_division_of i" "(x1,k1) \ d" "(x2,k2) \ d" "k1 \ k2" "k1 \ {x. x\k \ c} = k2 \ {x. x\k \ c}" and k:"k\Basis" shows "content(k1 \ {x. x\k \ c}) = 0" proof- have *:"\a b c. (a,b) \ c \ b \ snd ` c" unfolding image_iff apply(rule_tac x="(a,b)" in bexI) by auto @@ -2075,7 +3245,7 @@ apply(rule_tac[1-2] *) using assms(2-) by auto qed lemma tagged_division_split_right_inj: fixes x1::"'a::ordered_euclidean_space" - assumes "d tagged_division_of i" "(x1,k1) \ d" "(x2,k2) \ d" "k1 \ k2" "k1 \ {x. x\k \ c} = k2 \ {x. x\k \ c}" + assumes "d tagged_division_of i" "(x1,k1) \ d" "(x2,k2) \ d" "k1 \ k2" "k1 \ {x. x\k \ c} = k2 \ {x. x\k \ c}" and k:"k\Basis" shows "content(k1 \ {x. x\k \ c}) = 0" proof- have *:"\a b c. (a,b) \ c \ b \ snd ` c" unfolding image_iff apply(rule_tac x="(a,b)" in bexI) by auto @@ -2084,10 +3254,10 @@ lemma division_split: fixes a::"'a::ordered_euclidean_space" assumes "p division_of {a..b}" and k:"k\Basis" - shows "{l \ {x. x\k \ c} | l. l \ p \ ~(l \ {x. x\k \ c} = {})} division_of({a..b} \ {x. x\k \ c})" (is "?p1 division_of ?I1") and + shows "{l \ {x. x\k \ c} | l. l \ p \ ~(l \ {x. x\k \ c} = {})} division_of({a..b} \ {x. x\k \ c})" (is "?p1 division_of ?I1") and "{l \ {x. x\k \ c} | l. l \ p \ ~(l \ {x. x\k \ c} = {})} division_of ({a..b} \ {x. x\k \ c})" (is "?p2 division_of ?I2") proof(rule_tac[!] division_ofI) note p=division_ofD[OF assms(1)] - show "finite ?p1" "finite ?p2" using p(1) by auto show "\?p1 = ?I1" "\?p2 = ?I2" unfolding p(6)[THEN sym] by auto + show "finite ?p1" "finite ?p2" using p(1) by auto show "\?p1 = ?I1" "\?p2 = ?I2" unfolding p(6)[symmetric] by auto { fix k assume "k\?p1" then guess l unfolding mem_Collect_eq apply-by(erule exE,(erule conjE)+) note l=this guess u v using p(4)[OF l(2)] apply-by(erule exE)+ note uv=this show "k\?I1" "k \ {}" "\a b. k = {a..b}" unfolding l @@ -2106,8 +3276,8 @@ assumes "(f has_integral i) ({a..b} \ {x. x\k \ c})" "(f has_integral j) ({a..b} \ {x. x\k \ c})" and k:"k\Basis" shows "(f has_integral (i + j)) ({a..b})" proof(unfold has_integral,rule,rule) case goal1 hence e:"e/2>0" by auto - guess d1 using has_integralD[OF assms(1)[unfolded interval_split[OF k]] e] . note d1=this[unfolded interval_split[THEN sym,OF k]] - guess d2 using has_integralD[OF assms(2)[unfolded interval_split[OF k]] e] . note d2=this[unfolded interval_split[THEN sym,OF k]] + guess d1 using has_integralD[OF assms(1)[unfolded interval_split[OF k]] e] . note d1=this[unfolded interval_split[symmetric,OF k]] + guess d2 using has_integralD[OF assms(2)[unfolded interval_split[OF k]] e] . note d2=this[unfolded interval_split[symmetric,OF k]] let ?d = "\x. if x\k = c then (d1 x \ d2 x) else ball x (abs(x\k - c)) \ d1 x \ d2 x" show ?case apply(rule_tac x="?d" in exI,rule) defer apply(rule,rule,(erule conjE)+) proof- show "gauge ?d" using d1(1) d2(1) unfolding gauge_def by auto @@ -2119,7 +3289,7 @@ proof(rule ccontr) case goal1 from this(2)[unfolded not_le] have "kk \ ball x \x \ k - c\" using p(2)[unfolded fine_def,rule_format,OF as,unfolded split_conv] by auto - hence "\y. y \ ball x \x \ k - c\ \ {x. x \ k \ c}" using goal1(1) by blast + hence "\y. y \ ball x \x \ k - c\ \ {x. x \ k \ c}" using goal1(1) by blast then guess y .. hence "\x \ k - y \ k\ < \x \ k - c\" "y\k \ c" apply-apply(rule le_less_trans) using Basis_le_norm[OF k, of "x - y"] by (auto simp add: dist_norm inner_diff_left) thus False using goal1(2)[unfolded not_le] by(auto simp add:field_simps) @@ -2128,7 +3298,7 @@ proof(rule ccontr) case goal1 from this(2)[unfolded not_le] have "kk \ ball x \x \ k - c\" using p(2)[unfolded fine_def,rule_format,OF as,unfolded split_conv] by auto - hence "\y. y \ ball x \x \ k - c\ \ {x. x \ k \ c}" using goal1(1) by blast + hence "\y. y \ ball x \x \ k - c\ \ {x. x \ k \ c}" using goal1(1) by blast then guess y .. hence "\x \ k - y \ k\ < \x \ k - c\" "y\k \ c" apply-apply(rule le_less_trans) using Basis_le_norm[OF k, of "x - y"] by (auto simp add: dist_norm inner_diff_left) thus False using goal1(2)[unfolded not_le] by(auto simp add:field_simps) @@ -2153,7 +3323,7 @@ let ?M1 = "{(x,kk \ {x. x\k \ c}) |x kk. (x,kk) \ p \ kk \ {x. x\k \ c} \ {}}" have "norm ((\(x, k)\?M1. content k *\<^sub>R f x) - i) < e/2" apply(rule d1(2),rule tagged_division_ofI) apply(rule lem2 p(3))+ prefer 6 apply(rule fineI) - proof- show "\{k. \x. (x, k) \ ?M1} = {a..b} \ {x. x\k \ c}" unfolding p(8)[THEN sym] by auto + proof- show "\{k. \x. (x, k) \ ?M1} = {a..b} \ {x. x\k \ c}" unfolding p(8)[symmetric] by auto fix x l assume xl:"(x,l)\?M1" then guess x' l' unfolding mem_Collect_eq apply- unfolding Pair_eq apply((erule exE)+,(erule conjE)+) . note xl'=this have "l' \ d1 x'" apply(rule order_trans[OF fineD[OF p(2) xl'(3)]]) by auto @@ -2170,10 +3340,10 @@ thus ?thesis using p(7)[OF xl'(3) yr'(3)] using as unfolding xl' yr' by auto qed qed moreover - let ?M2 = "{(x,kk \ {x. x\k \ c}) |x kk. (x,kk) \ p \ kk \ {x. x\k \ c} \ {}}" + let ?M2 = "{(x,kk \ {x. x\k \ c}) |x kk. (x,kk) \ p \ kk \ {x. x\k \ c} \ {}}" have "norm ((\(x, k)\?M2. content k *\<^sub>R f x) - j) < e/2" apply(rule d2(2),rule tagged_division_ofI) apply(rule lem2 p(3))+ prefer 6 apply(rule fineI) - proof- show "\{k. \x. (x, k) \ ?M2} = {a..b} \ {x. x\k \ c}" unfolding p(8)[THEN sym] by auto + proof- show "\{k. \x. (x, k) \ ?M2} = {a..b} \ {x. x\k \ c}" unfolding p(8)[symmetric] by auto fix x l assume xl:"(x,l)\?M2" then guess x' l' unfolding mem_Collect_eq apply- unfolding Pair_eq apply((erule exE)+,(erule conjE)+) . note xl'=this have "l' \ d2 x'" apply(rule order_trans[OF fineD[OF p(2) xl'(3)]]) by auto @@ -2198,15 +3368,15 @@ also have "\ = (\(x, ka)\p. content (ka \ {x. x \ k \ c}) *\<^sub>R f x) + (\(x, ka)\p. content (ka \ {x. c \ x \ k}) *\<^sub>R f x) - (i + j)" unfolding lem3[OF p(3)] apply(subst setsum_reindex_nonzero[OF p(3)]) defer apply(subst setsum_reindex_nonzero[OF p(3)]) - defer unfolding lem4[THEN sym] apply(rule refl) unfolding split_paired_all split_conv apply(rule_tac[!] *) + defer unfolding lem4[symmetric] apply(rule refl) unfolding split_paired_all split_conv apply(rule_tac[!] *) proof- case goal1 thus ?case apply- apply(rule tagged_division_split_left_inj [OF p(1), of a b aa ba]) using k by auto next case goal2 thus ?case apply- apply(rule tagged_division_split_right_inj[OF p(1), of a b aa ba]) using k by auto - qed also note setsum_addf[THEN sym] + qed also note setsum_addf[symmetric] also have *:"\x. x\p \ (\(x, ka). content (ka \ {x. x \ k \ c}) *\<^sub>R f x) x + (\(x, ka). content (ka \ {x. c \ x \ k}) *\<^sub>R f x) x = (\(x,ka). content ka *\<^sub>R f x) x" unfolding split_paired_all split_conv proof- fix a b assume "(a,b) \ p" from p(6)[OF this] guess u v apply-by(erule exE)+ note uv=this thus "content (b \ {x. x \ k \ c}) *\<^sub>R f a + content (b \ {x. c \ x \ k}) *\<^sub>R f a = content b *\<^sub>R f a" - unfolding scaleR_left_distrib[THEN sym] unfolding uv content_split[OF k,of u v c] by auto + unfolding scaleR_left_distrib[symmetric] unfolding uv content_split[OF k,of u v c] by auto qed note setsum_cong2[OF this] finally have "(\(x, k)\{(x, kk \ {x. x \ k \ c}) |x kk. (x, kk) \ p \ kk \ {x. x \ k \ c} \ {}}. content k *\<^sub>R f x) - i + ((\(x, k)\{(x, kk \ {x. c \ x \ k}) |x kk. (x, kk) \ p \ kk \ {x. c \ x \ k} \ {}}. content k *\<^sub>R f x) - j) = @@ -2240,7 +3410,7 @@ proof- fix a b assume ab:"(a,b) \ p1 \ p2" have "(a,b) \ p1" using ab by auto from p1(4)[OF this] guess u v apply-by(erule exE)+ note uv =this have "b \ {x. x\k = c}" using ab p1(3)[of a b] p2(3)[of a b] by fastforce - moreover have "interior {x::'a. x \ k = c} = {}" + moreover have "interior {x::'a. x \ k = c} = {}" proof(rule ccontr) case goal1 then obtain x where x:"x\interior {x::'a. x\k = c}" by auto then guess e unfolding mem_interior .. note e=this have x:"x\k = c" using x interior_subset by fastforce @@ -2248,7 +3418,7 @@ = (if i = k then e/2 else 0)" using e k by (auto simp: inner_simps inner_not_same_Basis) have "(\i\Basis. \(x - (x + (e / 2 ) *\<^sub>R k)) \ i\) = (\i\Basis. (if i = k then e / 2 else 0))" apply(rule setsum_cong2) apply(subst *) by auto - also have "... < e" apply(subst setsum_delta) using e by auto + also have "... < e" apply(subst setsum_delta) using e by auto finally have "x + (e/2) *\<^sub>R k \ ball x e" unfolding mem_ball dist_norm by(rule le_less_trans[OF norm_le_l1]) hence "x + (e/2) *\<^sub>R k \ {x. x\k = c}" using e by auto @@ -2262,11 +3432,11 @@ lemma integrable_split[intro]: fixes f::"'a::ordered_euclidean_space \ 'b::{real_normed_vector,complete_space}" assumes "f integrable_on {a..b}" and k:"k\Basis" - shows "f integrable_on ({a..b} \ {x. x\k \ c})" (is ?t1) and "f integrable_on ({a..b} \ {x. x\k \ c})" (is ?t2) + shows "f integrable_on ({a..b} \ {x. x\k \ c})" (is ?t1) and "f integrable_on ({a..b} \ {x. x\k \ c})" (is ?t2) proof- guess y using assms(1) unfolding integrable_on_def .. note y=this def b' \ "\i\Basis. (if i = k then min (b\k) c else b\i)*\<^sub>R i::'a" def a' \ "\i\Basis. (if i = k then max (a\k) c else a\i)*\<^sub>R i::'a" - show ?t1 ?t2 unfolding interval_split[OF k] integrable_cauchy unfolding interval_split[THEN sym,OF k] + show ?t1 ?t2 unfolding interval_split[OF k] integrable_cauchy unfolding interval_split[symmetric,OF k] proof(rule_tac[!] allI impI)+ fix e::real assume "e>0" hence "e/2>0" by auto from has_integral_separate_sides[OF y this k,of c] guess d . note d=this[rule_format] let ?P = "\A. \d. gauge d \ (\p1 p2. p1 tagged_division_of {a..b} \ A \ d fine p1 @@ -2280,7 +3450,7 @@ show ?thesis using norm_triangle_half_l[OF d(2)[of p1 p] d(2)[of p2 p]] using as unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric] using p using assms by(auto simp add:algebra_simps) - qed qed + qed qed show "?P {x. x \ k \ c}" apply(rule_tac x=d in exI) apply(rule,rule d) apply(rule,rule,rule) proof- fix p1 p2 assume as:"p1 tagged_division_of {a..b} \ {x. x \ k \ c} \ d fine p1 \ p2 tagged_division_of {a..b} \ {x. x \ k \ c} \ d fine p2" @@ -2295,7 +3465,7 @@ definition "neutral opp = (SOME x. \y. opp x y = y \ opp y x = y)" definition operative :: "('a \ 'a \ 'a) \ (('b::ordered_euclidean_space) set \ 'a) \ bool" where - "operative opp f \ + "operative opp f \ (\a b. content {a..b} = 0 \ f {a..b} = neutral(opp)) \ (\a b c. \k\Basis. f({a..b}) = opp (f({a..b} \ {x. x\k \ c})) @@ -2311,7 +3481,7 @@ unfolding operative_def by auto lemma property_empty_interval: - "(\a b. content({a..b}) = 0 \ P({a..b})) \ P {}" + "(\a b. content({a..b}) = 0 \ P({a..b})) \ P {}" using content_empty unfolding empty_as_interval by auto lemma operative_empty: "operative opp f \ f {} = neutral opp" @@ -2395,10 +3565,10 @@ unfolding support_def by auto lemma iterate_empty[simp]:"iterate opp {} f = neutral opp" - unfolding iterate_def fold'_def by auto + unfolding iterate_def fold'_def by auto lemma iterate_insert[simp]: assumes "monoidal opp" "finite s" - shows "iterate opp (insert x s) f = (if x \ s then iterate opp s f else opp (f x) (iterate opp s f))" + shows "iterate opp (insert x s) f = (if x \ s then iterate opp s f else opp (f x) (iterate opp s f))" proof(cases "x\s") case True hence *:"insert x s = s" by auto show ?thesis unfolding iterate_def if_P[OF True] * by auto next case False note x=this @@ -2408,7 +3578,7 @@ unfolding True monoidal_simps[OF assms(1)] by auto next case False show ?thesis unfolding iterate_def fold'_def if_not_P[OF x] support_clauses if_not_P[OF False] apply(subst comp_fun_commute.fold_insert[OF * finite_support, simplified comp_def]) - using `finite s` unfolding support_def using False x by auto qed qed + using `finite s` unfolding support_def using False x by auto qed qed lemma iterate_some: assumes "monoidal opp" "finite s" @@ -2419,19 +3589,19 @@ subsection {* Two key instances of additivity. *} lemma neutral_add[simp]: - "neutral op + = (0::_::comm_monoid_add)" unfolding neutral_def + "neutral op + = (0::_::comm_monoid_add)" unfolding neutral_def apply(rule some_equality) defer apply(erule_tac x=0 in allE) by auto -lemma operative_content[intro]: "operative (op +) content" - unfolding operative_def neutral_add apply safe - unfolding content_split[THEN sym] .. +lemma operative_content[intro]: "operative (op +) content" + unfolding operative_def neutral_add apply safe + unfolding content_split[symmetric] .. lemma neutral_monoid: "neutral ((op +)::('a::comm_monoid_add) \ 'a \ 'a) = 0" by (rule neutral_add) (* FIXME: duplicate *) lemma monoidal_monoid[intro]: shows "monoidal ((op +)::('a::comm_monoid_add) \ 'a \ 'a)" - unfolding monoidal_def neutral_monoid by(auto simp add: algebra_simps) + unfolding monoidal_def neutral_monoid by(auto simp add: algebra_simps) lemma operative_integral: fixes f::"'a::ordered_euclidean_space \ 'b::banach" shows "operative (lifted(op +)) (\i. if f integrable_on i then Some(integral i f) else None)" @@ -2442,25 +3612,25 @@ show "(if f integrable_on {a..b} then Some (integral {a..b} f) else None) = lifted op + (if f integrable_on {a..b} \ {x. x \ k \ c} then Some (integral ({a..b} \ {x. x \ k \ c}) f) else None) (if f integrable_on {a..b} \ {x. c \ x \ k} then Some (integral ({a..b} \ {x. c \ x \ k}) f) else None)" - proof(cases "f integrable_on {a..b}") + proof(cases "f integrable_on {a..b}") case True show ?thesis unfolding if_P[OF True] using k apply- unfolding if_P[OF integrable_split(1)[OF True]] unfolding if_P[OF integrable_split(2)[OF True]] - unfolding lifted.simps option.inject apply(rule integral_unique) apply(rule has_integral_split[OF _ _ k]) + unfolding lifted.simps option.inject apply(rule integral_unique) apply(rule has_integral_split[OF _ _ k]) apply(rule_tac[!] integrable_integral integrable_split)+ using True k by auto next case False have "(\ (f integrable_on {a..b} \ {x. x \ k \ c})) \ (\ ( f integrable_on {a..b} \ {x. c \ x \ k}))" proof(rule ccontr) case goal1 hence "f integrable_on {a..b}" apply- unfolding integrable_on_def apply(rule_tac x="integral ({a..b} \ {x. x \ k \ c}) f + integral ({a..b} \ {x. x \ k \ c}) f" in exI) apply(rule has_integral_split[OF _ _ k]) apply(rule_tac[!] integrable_integral) by auto thus False using False by auto - qed thus ?thesis using False by auto - qed next + qed thus ?thesis using False by auto + qed next fix a b assume as:"content {a..b::'a} = 0" thus "(if f integrable_on {a..b} then Some (integral {a..b} f) else None) = Some 0" unfolding if_P[OF integrable_on_null[OF as]] using has_integral_null_eq[OF as] by auto qed subsection {* Points of division of a partition. *} -definition "division_points (k::('a::ordered_euclidean_space) set) d = +definition "division_points (k::('a::ordered_euclidean_space) set) d = {(j,x). j\Basis \ (interval_lowerbound k)\j < x \ x < (interval_upperbound k)\j \ (\i\d. (interval_lowerbound i)\j = x \ (interval_upperbound i)\j = x)}" @@ -2502,7 +3672,7 @@ from assm(4)[OF this(5)] guess u v apply-by(erule exE)+ note l=this have *:"\i\Basis. u \ i \ (\i\Basis. (if i = k then min (v \ k) c else v \ i) *\<^sub>R i) \ i" using as(6) unfolding l interval_split[OF k] interval_ne_empty as . - have **:"\i\Basis. u\i \ v\i" using l using as(6) unfolding interval_ne_empty[THEN sym] by auto + have **:"\i\Basis. u\i \ v\i" using l using as(6) unfolding interval_ne_empty[symmetric] by auto show "\i\d. interval_lowerbound i \ fst x = snd x \ interval_upperbound i \ fst x = snd x" apply (rule bexI[OF _ `l \ d`]) using as(1-3,5) fstx @@ -2520,12 +3690,12 @@ apply(erule exE conjE)+ proof fix i l x assume as:"(if fst x = k then c else a \ fst x) < snd x" "snd x < b \ fst x" - "interval_lowerbound i \ fst x = snd x \ interval_upperbound i \ fst x = snd x" + "interval_lowerbound i \ fst x = snd x \ interval_upperbound i \ fst x = snd x" "i = l \ {x. c \ x \ k}" "l \ d" "l \ {x. c \ x \ k} \ {}" and fstx:"fst x \ Basis" from assm(4)[OF this(5)] guess u v apply-by(erule exE)+ note l=this have *:"\i\Basis. (\i\Basis. (if i = k then max (u \ k) c else u \ i) *\<^sub>R i) \ i \ v \ i" using as(6) unfolding l interval_split[OF k] interval_ne_empty as . - have **:"\i\Basis. u\i \ v\i" using l using as(6) unfolding interval_ne_empty[THEN sym] by auto + have **:"\i\Basis. u\i \ v\i" using l using as(6) unfolding interval_ne_empty[symmetric] by auto show "\i\d. interval_lowerbound i \ fst x = snd x \ interval_upperbound i \ fst x = snd x" apply (rule bexI[OF _ `l \ d`]) using as(1-3,5) fstx @@ -2540,9 +3710,9 @@ assumes "d division_of {a..b}" "\i\Basis. a\i < b\i" "a\k < c" "c < b\k" "l \ d" "interval_lowerbound l\k = c \ interval_upperbound l\k = c" and k:"k\Basis" shows "division_points ({a..b} \ {x. x\k \ c}) {l \ {x. x\k \ c} | l. l\d \ l \ {x. x\k \ c} \ {}} - \ division_points ({a..b}) d" (is "?D1 \ ?D") + \ division_points ({a..b}) d" (is "?D1 \ ?D") "division_points ({a..b} \ {x. x\k \ c}) {l \ {x. x\k \ c} | l. l\d \ l \ {x. x\k \ c} \ {}} - \ division_points ({a..b}) d" (is "?D2 \ ?D") + \ division_points ({a..b}) d" (is "?D2 \ ?D") proof- have ab:"\i\Basis. a\i \ b\i" using assms(2) by(auto intro!:less_imp_le) guess u v using division_ofD(4)[OF assms(1,5)] apply-by(erule exE)+ note l=this have uv:"\i\Basis. u\i \ v\i" "\i\Basis. a\i \ u\i \ v\i \ b\i" @@ -2555,7 +3725,7 @@ have "\x. x \ ?D - ?D1" using assms(2-) apply-apply(erule disjE) apply(rule_tac x="(k,(interval_lowerbound l)\k)" in exI) defer apply(rule_tac x="(k,(interval_upperbound l)\k)" in exI) - unfolding division_points_def unfolding interval_bounds[OF ab] by(auto simp add:*) + unfolding division_points_def unfolding interval_bounds[OF ab] by(auto simp add:*) thus "?D1 \ ?D" apply-apply(rule,rule division_points_subset[OF assms(1-4)]) using k by auto have *:"interval_lowerbound ({a..b} \ {x. x \ k \ interval_lowerbound l \ k}) \ k = interval_lowerbound l \ k" @@ -2565,7 +3735,7 @@ have "\x. x \ ?D - ?D2" using assms(2-) apply-apply(erule disjE) apply(rule_tac x="(k,(interval_lowerbound l)\k)" in exI) defer apply(rule_tac x="(k,(interval_upperbound l)\k)" in exI) - unfolding division_points_def unfolding interval_bounds[OF ab] by(auto simp add:*) + unfolding division_points_def unfolding interval_bounds[OF ab] by(auto simp add:*) thus "?D2 \ ?D" apply-apply(rule,rule division_points_subset[OF assms(1-4) k]) by auto qed subsection {* Preservation by divisions and tagged divisions. *} @@ -2578,7 +3748,7 @@ lemma iterate_expand_cases: "iterate opp s f = (if finite(support opp f s) then iterate opp (support opp f s) f else neutral opp)" - apply(cases) apply(subst if_P,assumption) unfolding iterate_def support_support fold'_def by auto + apply(cases) apply(subst if_P,assumption) unfolding iterate_def support_support fold'_def by auto lemma iterate_image: assumes "monoidal opp" "inj_on f s" shows "iterate opp (f ` s) g = iterate opp s (g \ f)" @@ -2587,14 +3757,14 @@ proof- case goal1 show ?case using goal1 proof(induct s) case empty thus ?case using assms(1) by auto next case (insert x s) show ?case unfolding iterate_insert[OF assms(1) insert(1)] - unfolding if_not_P[OF insert(2)] apply(subst insert(3)[THEN sym]) + unfolding if_not_P[OF insert(2)] apply(subst insert(3)[symmetric]) unfolding image_insert defer apply(subst iterate_insert[OF assms(1)]) apply(rule finite_imageI insert)+ apply(subst if_not_P) unfolding image_iff o_def using insert(2,4) by auto qed qed - show ?thesis + show ?thesis apply(cases "finite (support opp g (f ` s))") - apply(subst (1) iterate_support[THEN sym],subst (2) iterate_support[THEN sym]) + apply(subst (1) iterate_support[symmetric],subst (2) iterate_support[symmetric]) unfolding support_clauses apply(rule *)apply(rule finite_imageD,assumption) unfolding inj_on_def[symmetric] apply(rule subset_inj_on[OF assms(2) support_subset])+ apply(subst iterate_expand_cases) unfolding support_clauses apply(simp only: if_False) @@ -2610,16 +3780,16 @@ have **:"support opp (g \ f) {x \ s. f x \ a} = support opp (g \ f) s" unfolding support_def using assms(3) by auto show ?thesis unfolding * - apply(subst iterate_support[THEN sym]) unfolding support_clauses + apply(subst iterate_support[symmetric]) unfolding support_clauses apply(subst iterate_image[OF assms(1)]) defer - apply(subst(2) iterate_support[THEN sym]) apply(subst **) + apply(subst(2) iterate_support[symmetric]) apply(subst **) unfolding inj_on_def using assms(3,4) unfolding support_def by auto qed lemma iterate_eq_neutral: assumes "monoidal opp" "\x \ s. (f(x) = neutral opp)" shows "(iterate opp s f = neutral opp)" proof- have *:"support opp f s = {}" unfolding support_def using assms(2) by auto - show ?thesis apply(subst iterate_support[THEN sym]) + show ?thesis apply(subst iterate_support[symmetric]) unfolding * using assms(1) by auto qed lemma iterate_op: assumes "monoidal opp" "finite s" @@ -2637,11 +3807,11 @@ case False thus ?thesis apply(subst iterate_expand_cases,subst(2) iterate_expand_cases) unfolding * by auto next def su \ "support opp f s" - case True note support_subset[of opp f s] - thus ?thesis apply- apply(subst iterate_support[THEN sym],subst(2) iterate_support[THEN sym]) unfolding * using True + case True note support_subset[of opp f s] + thus ?thesis apply- apply(subst iterate_support[symmetric],subst(2) iterate_support[symmetric]) unfolding * using True unfolding su_def[symmetric] proof(induct su) case empty show ?case by auto - next case (insert x s) show ?case unfolding iterate_insert[OF assms(1) insert(1)] + next case (insert x s) show ?case unfolding iterate_insert[OF assms(1) insert(1)] unfolding if_not_P[OF insert(2)] apply(subst insert(3)) defer apply(subst assms(2)[of x]) using insert by auto qed qed qed @@ -2659,11 +3829,11 @@ show ?case unfolding operativeD(1)[OF assms(2) as] apply(rule iterate_eq_neutral[OF goal1(2)]) proof fix x assume x:"x\d" then guess u v apply(drule_tac division_ofD(4)[OF goal1(4)]) by(erule exE)+ - thus "f x = neutral opp" using division_of_content_0[OF as goal1(4)] + thus "f x = neutral opp" using division_of_content_0[OF as goal1(4)] using operativeD(1)[OF assms(2)] x by auto qed qed } - assume "content {a..b} \ 0" note ab = this[unfolded content_lt_nz[THEN sym] content_pos_lt_eq] - hence ab':"\i\Basis. a\i \ b\i" by (auto intro!: less_imp_le) show ?case + assume "content {a..b} \ 0" note ab = this[unfolded content_lt_nz[symmetric] content_pos_lt_eq] + hence ab':"\i\Basis. a\i \ b\i" by (auto intro!: less_imp_le) show ?case proof(cases "division_points {a..b} d = {}") case True have d':"\i\d. \u v. i = {u..v} \ (\j\Basis. u\j = a\j \ v\j = a\j \ u\j = b\j \ v\j = b\j \ u\j = a\j \ v\j = b\j)" @@ -2677,7 +3847,7 @@ "(j, v\j) \ division_points {a..b} d" using True by auto note this[unfolded de_Morgan_conj division_points_def mem_Collect_eq split_conv interval_bounds[OF ab'] bex_simps] note *[OF this(1)] *[OF this(2)] note this[unfolded interval_bounds[OF uv(1)]] - moreover have "a\j \ u\j" "v\j \ b\j" using division_ofD(2,2,3)[OF goal1(4) as] + moreover have "a\j \ u\j" "v\j \ b\j" using division_ofD(2,2,3)[OF goal1(4) as] unfolding subset_eq apply- apply(erule_tac x=u in ballE,erule_tac[3] x=v in ballE) unfolding interval_ne_empty mem_interval using j by auto ultimately show "u\j = a\j \ v\j = a\j \ u\j = b\j \ v\j = b\j \ u\j = a\j \ v\j = b\j" @@ -2685,7 +3855,7 @@ qed have "(1/2) *\<^sub>R (a+b) \ {a..b}" unfolding mem_interval using ab by(auto intro!: less_imp_le simp: inner_simps) - note this[unfolded division_ofD(6)[OF goal1(4),THEN sym] Union_iff] + note this[unfolded division_ofD(6)[OF goal1(4),symmetric] Union_iff] then guess i .. note i=this guess u v using d'[rule_format,OF i(1)] apply-by(erule exE conjE)+ note uv=this have "{a..b} \ d" proof- { presume "i = {a..b}" thus ?thesis using i by auto } @@ -2700,12 +3870,12 @@ have "iterate opp (d - {{a..b}}) f = neutral opp" apply(rule iterate_eq_neutral[OF goal1(2)]) proof fix x assume x:"x \ d - {{a..b}}" hence "x\d" by auto note d'[rule_format,OF this] then guess u v apply-by(erule exE conjE)+ note uv=this - have "u\a \ v\b" using x[unfolded uv] by auto + have "u\a \ v\b" using x[unfolded uv] by auto then obtain j where "u\j \ a\j \ v\j \ b\j" and j:"j\Basis" unfolding euclidean_eq_iff[where 'a='a] by auto hence "u\j = v\j" using uv(2)[rule_format,OF j] by auto hence "content {u..v} = 0" unfolding content_eq_0 apply(rule_tac x=j in bexI) using j by auto thus "f x = neutral opp" unfolding uv(1) by(rule operativeD(1)[OF goal1(3)]) - qed thus "iterate opp d f = f {a..b}" apply-apply(subst *) + qed thus "iterate opp d f = f {a..b}" apply-apply(subst *) apply(subst iterate_insert[OF goal1(2)]) using goal1(2,4) by auto next case False hence "\x. x\division_points {a..b} d" by auto then guess k c unfolding split_paired_Ex apply- unfolding division_points_def mem_Collect_eq split_conv @@ -2723,32 +3893,32 @@ unfolding interval_split[OF kc(4)] d1_def[symmetric] d2_def[symmetric] unfolding goal1(2) Suc_le_mono using goal1(2-3) using division_points_finite[OF goal1(4)] using kc(4) by auto have "f {a..b} = opp (iterate opp d1 f) (iterate opp d2 f)" (is "_ = ?prev") - unfolding * apply(rule operativeD(2)) using goal1(3) using kc(4) by auto + unfolding * apply(rule operativeD(2)) using goal1(3) using kc(4) by auto also have "iterate opp d1 f = iterate opp d (\l. f(l \ {x. x\k \ c}))" unfolding d1_def apply(rule iterate_nonzero_image_lemma[unfolded o_def]) unfolding empty_as_interval apply(rule goal1 division_of_finite operativeD[OF goal1(3)])+ - unfolding empty_as_interval[THEN sym] apply(rule content_empty) - proof(rule,rule,rule,erule conjE) fix l y assume as:"l \ d" "y \ d" "l \ {x. x \ k \ c} = y \ {x. x \ k \ c}" "l \ y" + unfolding empty_as_interval[symmetric] apply(rule content_empty) + proof(rule,rule,rule,erule conjE) fix l y assume as:"l \ d" "y \ d" "l \ {x. x \ k \ c} = y \ {x. x \ k \ c}" "l \ y" from division_ofD(4)[OF goal1(4) this(1)] guess u v apply-by(erule exE)+ note l=this - show "f (l \ {x. x \ k \ c}) = neutral opp" unfolding l interval_split[OF kc(4)] - apply(rule operativeD(1) goal1)+ unfolding interval_split[THEN sym,OF kc(4)] apply(rule division_split_left_inj) - apply(rule goal1) unfolding l[THEN sym] apply(rule as(1),rule as(2)) by(rule kc(4) as)+ + show "f (l \ {x. x \ k \ c}) = neutral opp" unfolding l interval_split[OF kc(4)] + apply(rule operativeD(1) goal1)+ unfolding interval_split[symmetric,OF kc(4)] apply(rule division_split_left_inj) + apply(rule goal1) unfolding l[symmetric] apply(rule as(1),rule as(2)) by(rule kc(4) as)+ qed also have "iterate opp d2 f = iterate opp d (\l. f(l \ {x. x\k \ c}))" unfolding d2_def apply(rule iterate_nonzero_image_lemma[unfolded o_def]) unfolding empty_as_interval apply(rule goal1 division_of_finite operativeD[OF goal1(3)])+ - unfolding empty_as_interval[THEN sym] apply(rule content_empty) - proof(rule,rule,rule,erule conjE) fix l y assume as:"l \ d" "y \ d" "l \ {x. c \ x \ k} = y \ {x. c \ x \ k}" "l \ y" + unfolding empty_as_interval[symmetric] apply(rule content_empty) + proof(rule,rule,rule,erule conjE) fix l y assume as:"l \ d" "y \ d" "l \ {x. c \ x \ k} = y \ {x. c \ x \ k}" "l \ y" from division_ofD(4)[OF goal1(4) this(1)] guess u v apply-by(erule exE)+ note l=this - show "f (l \ {x. x \ k \ c}) = neutral opp" unfolding l interval_split[OF kc(4)] - apply(rule operativeD(1) goal1)+ unfolding interval_split[THEN sym,OF kc(4)] apply(rule division_split_right_inj) - apply(rule goal1) unfolding l[THEN sym] apply(rule as(1),rule as(2)) by(rule as kc(4))+ + show "f (l \ {x. x \ k \ c}) = neutral opp" unfolding l interval_split[OF kc(4)] + apply(rule operativeD(1) goal1)+ unfolding interval_split[symmetric,OF kc(4)] apply(rule division_split_right_inj) + apply(rule goal1) unfolding l[symmetric] apply(rule as(1),rule as(2)) by(rule as kc(4))+ qed also have *:"\x\d. f x = opp (f (x \ {x. x \ k \ c})) (f (x \ {x. c \ x \ k}))" - unfolding forall_in_division[OF goal1(4)] apply(rule,rule,rule,rule operativeD(2)) using goal1(3) kc by auto + unfolding forall_in_division[OF goal1(4)] apply(rule,rule,rule,rule operativeD(2)) using goal1(3) kc by auto have "opp (iterate opp d (\l. f (l \ {x. x \ k \ c}))) (iterate opp d (\l. f (l \ {x. c \ x \ k}))) = iterate opp d f" apply(subst(3) iterate_eq[OF _ *[rule_format]]) prefer 3 - apply(rule iterate_op[THEN sym]) using goal1 by auto + apply(rule iterate_op[symmetric]) using goal1 by auto finally show ?thesis by auto - qed qed qed + qed qed qed lemma iterate_image_nonzero: assumes "monoidal opp" "finite s" "\x\s. \y\s. ~(x = y) \ f x = f y \ g(f x) = neutral opp" @@ -2763,20 +3933,20 @@ apply(subst iterate_insert[OF assms(1) goal2(1)]) unfolding if_not_P[OF goal2(3)] defer unfolding image_iff defer apply(erule bexE) apply(rule *) unfolding o_def apply(rule_tac y=x in goal2(7)[rule_format]) - using goal2 unfolding o_def by auto qed + using goal2 unfolding o_def by auto qed lemma operative_tagged_division: assumes "monoidal opp" "operative opp f" "d tagged_division_of {a..b}" shows "iterate(opp) d (\(x,l). f l) = f {a..b}" proof- have *:"(\(x,l). f l) = (f o snd)" unfolding o_def by(rule,auto) note assm = tagged_division_ofD[OF assms(3)] have "iterate(opp) d (\(x,l). f l) = iterate opp (snd ` d) f" unfolding * - apply(rule iterate_image_nonzero[THEN sym,OF assms(1)]) apply(rule tagged_division_of_finite assms)+ + apply(rule iterate_image_nonzero[symmetric,OF assms(1)]) apply(rule tagged_division_of_finite assms)+ unfolding Ball_def split_paired_All snd_conv apply(rule,rule,rule,rule,rule,rule,rule,erule conjE) proof- fix a b aa ba assume as:"(a, b) \ d" "(aa, ba) \ d" "(a, b) \ (aa, ba)" "b = ba" guess u v using assm(4)[OF as(1)] apply-by(erule exE)+ note uv=this show "f b = neutral opp" unfolding uv apply(rule operativeD(1)[OF assms(2)]) unfolding content_eq_0_interior using tagged_division_ofD(5)[OF assms(3) as(1-3)] - unfolding as(4)[THEN sym] uv by auto - qed also have "\ = f {a..b}" + unfolding as(4)[symmetric] uv by auto + qed also have "\ = f {a..b}" using operative_division[OF assms(1-2) division_of_tagged_division[OF assms(3)]] . finally show ?thesis . qed @@ -2794,13 +3964,13 @@ lemma additive_content_division: assumes "d division_of {a..b}" shows "setsum content d = content({a..b})" - unfolding operative_division[OF monoidal_monoid operative_content assms,THEN sym] + unfolding operative_division[OF monoidal_monoid operative_content assms,symmetric] apply(subst setsum_iterate) using assms by auto lemma additive_content_tagged_division: assumes "d tagged_division_of {a..b}" shows "setsum (\(x,l). content l) d = content({a..b})" - unfolding operative_tagged_division[OF monoidal_monoid operative_content assms,THEN sym] + unfolding operative_tagged_division[OF monoidal_monoid operative_content assms,symmetric] apply(subst setsum_iterate) using assms by auto subsection {* Finally, the integral of a constant *} @@ -2809,7 +3979,7 @@ "((\x. c) has_integral (content({a..b::'a::ordered_euclidean_space}) *\<^sub>R c)) ({a..b})" unfolding has_integral apply(rule,rule,rule_tac x="\x. ball x 1" in exI) apply(rule,rule gauge_trivial)apply(rule,rule,erule conjE) - unfolding split_def apply(subst scaleR_left.setsum[THEN sym, unfolded o_def]) + unfolding split_def apply(subst scaleR_left.setsum[symmetric, unfolded o_def]) defer apply(subst additive_content_tagged_division[unfolded split_def]) apply assumption by auto lemma integral_const[simp]: @@ -2821,7 +3991,7 @@ lemma dsum_bound: assumes "p division_of {a..b}" "norm(c) \ e" shows "norm(setsum (\l. content l *\<^sub>R c) p) \ e * content({a..b})" (is "?l \ ?r") - apply(rule order_trans,rule norm_setsum) unfolding norm_scaleR setsum_left_distrib[THEN sym] + apply(rule order_trans,rule norm_setsum) unfolding norm_scaleR setsum_left_distrib[symmetric] apply(rule order_trans[OF mult_left_mono],rule assms,rule setsum_abs_ge_zero) apply(subst mult_commute) apply(rule mult_left_mono) apply(rule order_trans[of _ "setsum content p"]) apply(rule eq_refl,rule setsum_cong2) @@ -2838,11 +4008,11 @@ next case False show ?thesis apply(rule order_trans,rule norm_setsum) unfolding split_def norm_scaleR apply(rule order_trans[OF setsum_mono]) apply(rule mult_left_mono[OF _ abs_ge_zero, of _ e]) defer - unfolding setsum_left_distrib[THEN sym] apply(subst mult_commute) apply(rule mult_left_mono) + unfolding setsum_left_distrib[symmetric] apply(subst mult_commute) apply(rule mult_left_mono) apply(rule order_trans[of _ "setsum (content \ snd) p"]) apply(rule eq_refl,rule setsum_cong2) apply(subst o_def, rule abs_of_nonneg) proof- show "setsum (content \ snd) p \ content {a..b}" apply(rule eq_refl) - unfolding additive_content_tagged_division[OF assms(1),THEN sym] split_def by auto + unfolding additive_content_tagged_division[OF assms(1),symmetric] split_def by auto guess w using nonempty_witness[OF False] . thus "e\0" apply-apply(rule order_trans) defer apply(rule assms(2)[rule_format],assumption) by auto fix xk assume *:"xk\p" guess x k using surj_pair[of xk] apply-by(erule exE)+ note xk = this *[unfolded this] @@ -2855,7 +4025,7 @@ assumes "p tagged_division_of {a..b}" "\x\{a..b}. norm(f x - g x) \ e" shows "norm(setsum (\(x,k). content k *\<^sub>R f x) p - setsum (\(x,k). content k *\<^sub>R g x) p) \ e * content({a..b})" apply(rule order_trans[OF _ rsum_bound[OF assms]]) apply(rule eq_refl) apply(rule arg_cong[where f=norm]) - unfolding setsum_subtractf[THEN sym] apply(rule setsum_cong2) unfolding scaleR_diff_right by auto + unfolding setsum_subtractf[symmetric] apply(rule setsum_cong2) unfolding scaleR_diff_right by auto lemma has_integral_bound: fixes f::"'a::ordered_euclidean_space \ 'b::real_normed_vector" assumes "0 \ B" "(f has_integral i) ({a..b})" "\x\{a..b}. norm(f x) \ B" @@ -2863,7 +4033,7 @@ proof- let ?P = "content {a..b} > 0" { presume "?P \ ?thesis" thus ?thesis proof(cases ?P) case False hence *:"content {a..b} = 0" using content_lt_nz by auto - hence **:"i = 0" using assms(2) apply(subst has_integral_null_eq[THEN sym]) by auto + hence **:"i = 0" using assms(2) apply(subst has_integral_null_eq[symmetric]) by auto show ?thesis unfolding * ** using assms(1) by auto qed auto } assume ab:?P { presume "\ ?thesis \ False" thus ?thesis by auto } @@ -2893,7 +4063,7 @@ assumes "(f has_integral i) s" "(g has_integral j) s" "\x\s. (f x)\k \ (g x)\k" shows "i\k \ j\k" proof - - have lem:"\a b i (j::'b). \g f::'a \ 'b. (f has_integral i) ({a..b}) \ + have lem:"\a b i (j::'b). \g f::'a \ 'b. (f has_integral i) ({a..b}) \ (g has_integral j) ({a..b}) \ \x\{a..b}. (f x)\k \ (g x)\k \ i\k \ j\k" proof (rule ccontr) case goal1 @@ -2935,7 +4105,7 @@ apply(rule has_integral_component_le) using integrable_integral assms by auto lemma has_integral_component_nonneg: fixes f::"'a::ordered_euclidean_space \ 'b::euclidean_space" - assumes "k\Basis" "(f has_integral i) s" "\x\s. 0 \ (f x)\k" shows "0 \ i\k" + assumes "k\Basis" "(f has_integral i) s" "\x\s. 0 \ (f x)\k" shows "0 \ i\k" using has_integral_component_le[OF assms(1) has_integral_0 assms(2)] using assms(3-) by auto lemma integral_component_nonneg: fixes f::"'a::ordered_euclidean_space \ 'b::euclidean_space" @@ -2943,7 +4113,7 @@ apply(rule has_integral_component_nonneg) using assms by auto lemma has_integral_component_neg: fixes f::"'a::ordered_euclidean_space \ 'b::ordered_euclidean_space" - assumes "k\Basis" "(f has_integral i) s" "\x\s. (f x)\k \ 0"shows "i\k \ 0" + assumes "k\Basis" "(f has_integral i) s" "\x\s. (f x)\k \ 0"shows "i\k \ 0" using has_integral_component_le[OF assms(1,2) has_integral_0] assms(2-) by auto lemma has_integral_component_lbound: @@ -2966,7 +4136,7 @@ apply(rule has_integral_component_lbound) using assms unfolding has_integral_integral by auto lemma integral_component_ubound: fixes f::"'a::ordered_euclidean_space => 'b::ordered_euclidean_space" - assumes "f integrable_on {a..b}" "\x\{a..b}. f(x)\k \ B" "k\Basis" + assumes "f integrable_on {a..b}" "\x\{a..b}. f(x)\k \ B" "k\Basis" shows "(integral({a..b}) f)\k \ B * content({a..b})" apply(rule has_integral_component_ubound) using assms unfolding has_integral_integral by auto @@ -2982,7 +4152,7 @@ have *:"\P. \e>(0::real). P e \ \n::nat. P (inverse (real n+1))" by auto from choice[OF *[OF assms]] guess g .. note g=conjunctD2[OF this[rule_format],rule_format] from choice[OF allI[OF g(2)[unfolded integrable_on_def], of "\x. x"]] guess i .. note i=this[rule_format] - + have "Cauchy i" unfolding Cauchy_def proof(rule,rule) fix e::real assume "e>0" hence "e / 4 / content {a..b} > 0" using as by(auto simp add:field_simps) @@ -3003,10 +4173,10 @@ apply(rule gm(2)[OF conjI[OF p(1)]],rule_tac[2] gn(2)[OF conjI[OF p(1)]]) using conjunctD2[OF p(2)[unfolded fine_inter]] apply- apply assumption+ apply(rule order_trans) apply(rule rsum_diff_bound[OF p(1), where e="2 / real M"]) - proof show "2 / real M * content {a..b} \ e / 2" unfolding divide_inverse + proof show "2 / real M * content {a..b} \ e / 2" unfolding divide_inverse using M as by(auto simp add:field_simps) fix x assume x:"x \ {a..b}" - have "norm (f x - g n x) + norm (f x - g m x) \ inverse (real n + 1) + inverse (real m + 1)" + have "norm (f x - g n x) + norm (f x - g m x) \ inverse (real n + 1) + inverse (real m + 1)" using g(1)[OF x, of n] g(1)[OF x, of m] by auto also have "\ \ inverse (real M) + inverse (real M)" apply(rule add_mono) apply(rule_tac[!] le_imp_inverse_le) using goal1 M by auto @@ -3015,10 +4185,10 @@ using norm_triangle_le[of "g n x - f x" "f x - g m x" "2 / real M"] by(auto simp add:algebra_simps simp add:norm_minus_commute) qed qed qed - from this[unfolded convergent_eq_cauchy[THEN sym]] guess s .. note s=this + from this[unfolded convergent_eq_cauchy[symmetric]] guess s .. note s=this show ?thesis unfolding integrable_on_def apply(rule_tac x=s in exI) unfolding has_integral - proof(rule,rule) + proof(rule,rule) case goal1 hence *:"e/3 > 0" by auto from LIMSEQ_D [OF s this] guess N1 .. note N1=this from goal1 as have "e / 3 / content {a..b} > 0" by(auto simp add:field_simps) @@ -3038,7 +4208,7 @@ proof- have "content {a..b} < e / 3 * (real N2)" using N2 unfolding inverse_eq_divide using as by(auto simp add:field_simps) hence "content {a..b} < e / 3 * (real (N1 + N2) + 1)" - apply-apply(rule less_le_trans,assumption) using `e>0` by auto + apply-apply(rule less_le_trans,assumption) using `e>0` by auto thus "inverse (real (N1 + N2) + 1) * content {a..b} \ e / 3" unfolding inverse_eq_divide by(auto simp add:field_simps) show "norm (i (N1 + N2) - s) < e / 3" by(rule N1[rule_format],auto) @@ -3050,17 +4220,17 @@ subsection {* Negligibility of hyperplane. *} -lemma vsum_nonzero_image_lemma: +lemma vsum_nonzero_image_lemma: assumes "finite s" "g(a) = 0" "\x\s. \y\s. f x = f y \ x \ y \ g(f x) = 0" shows "setsum g {f x |x. x \ s \ f x \ a} = setsum (g o f) s" unfolding setsum_iterate[OF assms(1)] apply(subst setsum_iterate) defer apply(rule iterate_nonzero_image_lemma) apply(rule assms monoidal_monoid)+ - unfolding assms using neutral_add unfolding neutral_add using assms by auto + unfolding assms using neutral_add unfolding neutral_add using assms by auto lemma interval_doublesplit: fixes a::"'a::ordered_euclidean_space" assumes "k\Basis" - shows "{a..b} \ {x . abs(x\k - c) \ (e::real)} = - {(\i\Basis. (if i = k then max (a\k) (c - e) else a\i) *\<^sub>R i) .. + shows "{a..b} \ {x . abs(x\k - c) \ (e::real)} = + {(\i\Basis. (if i = k then max (a\k) (c - e) else a\i) *\<^sub>R i) .. (\i\Basis. (if i = k then min (b\k) (c + e) else b\i) *\<^sub>R i)}" proof- have *:"\x c e::real. abs(x - c) \ e \ x \ c - e \ x \ c + e" by auto have **:"\s P Q. s \ {x. P x \ Q x} = (s \ {x. Q x}) \ {x. P x}" by blast @@ -3071,7 +4241,7 @@ proof- have *:"\x c. abs(x - c) \ e \ x \ c - e \ x \ c + e" by auto have **:"\p q p' q'. p division_of q \ p = p' \ q = q' \ p' division_of q'" by auto note division_split(1)[OF assms, where c="c+e",unfolded interval_split[OF k]] - note division_split(2)[OF this, where c="c-e" and k=k,OF k] + note division_split(2)[OF this, where c="c-e" and k=k,OF k] thus ?thesis apply(rule **) using k apply- unfolding interval_doublesplit unfolding * unfolding interval_split interval_doublesplit apply(rule set_eqI) unfolding mem_Collect_eq apply rule apply(erule conjE exE)+ apply(rule_tac x=la in exI) defer apply(erule conjE exE)+ apply(rule_tac x="l \ {x. c + e \ x \ k}" in exI) apply rule defer apply rule @@ -3082,17 +4252,17 @@ proof(cases "content {a..b} = 0") case True show ?thesis apply(rule that[of 1]) defer unfolding interval_doublesplit[OF k] apply(rule le_less_trans[OF content_subset]) defer apply(subst True) - unfolding interval_doublesplit[THEN sym,OF k] using assms by auto + unfolding interval_doublesplit[symmetric,OF k] using assms by auto next case False def d \ "e / 3 / setprod (\i. b\i - a\i) (Basis - {k})" note False[unfolded content_eq_0 not_ex not_le, rule_format] hence "\x. x\Basis \ b\x > a\x" by(auto simp add:not_le) hence prod0:"0 < setprod (\i. b\i - a\i) (Basis - {k})" apply-apply(rule setprod_pos) by(auto simp add:field_simps) hence "d > 0" unfolding d_def using assms by(auto simp add:field_simps) thus ?thesis proof(rule that[of d]) have *:"Basis = insert k (Basis - {k})" using k by auto - have **:"{a..b} \ {x. \x \ k - c\ \ d} \ {} \ + have **:"{a..b} \ {x. \x \ k - c\ \ d} \ {} \ (\i\Basis - {k}. interval_upperbound ({a..b} \ {x. \x \ k - c\ \ d}) \ i - interval_lowerbound ({a..b} \ {x. \x \ k - c\ \ d}) \ i) - = (\i\Basis - {k}. b\i - a\i)" apply(rule setprod_cong,rule refl) + = (\i\Basis - {k}. b\i - a\i)" apply(rule setprod_cong,rule refl) unfolding interval_doublesplit[OF k] apply(subst interval_bounds) defer apply(subst interval_bounds) unfolding interval_eq_empty not_ex not_less by auto show "content ({a..b} \ {x. \x \ k - c\ \ d}) < e" apply(cases) unfolding content_def apply(subst if_P,assumption,rule assms) @@ -3109,10 +4279,10 @@ qed qed -lemma negligible_standard_hyperplane[intro]: +lemma negligible_standard_hyperplane[intro]: fixes k :: "'a::ordered_euclidean_space" assumes k: "k \ Basis" - shows "negligible {x. x\k = c}" + shows "negligible {x. x\k = c}" unfolding negligible_def has_integral apply(rule,rule,rule,rule) proof- case goal1 from content_doublesplit[OF this k,of a b c] guess d . note d=this @@ -3136,30 +4306,30 @@ prefer 2 apply(subst(asm) eq_commute) apply assumption apply(subst interval_doublesplit[OF k]) apply(rule content_pos_le) apply(rule indicator_pos_le) proof- have "(\(x, ka)\p. content (ka \ {x. \x \ k - c\ \ d}) * ?i x) \ (\(x, ka)\p. content (ka \ {x. \x \ k - c\ \ d}))" - apply(rule setsum_mono) unfolding split_paired_all split_conv + apply(rule setsum_mono) unfolding split_paired_all split_conv apply(rule mult_right_le_one_le) apply(drule p'(4)) by(auto simp add:interval_doublesplit[OF k]) also have "... < e" apply(subst setsum_over_tagged_division_lemma[OF p[THEN conjunct1]]) proof- case goal1 have "content ({u..v} \ {x. \x \ k - c\ \ d}) \ content {u..v}" - unfolding interval_doublesplit[OF k] apply(rule content_subset) unfolding interval_doublesplit[THEN sym,OF k] by auto + unfolding interval_doublesplit[OF k] apply(rule content_subset) unfolding interval_doublesplit[symmetric,OF k] by auto thus ?case unfolding goal1 unfolding interval_doublesplit[OF k] by (blast intro: antisym) next have *:"setsum content {l \ {x. \x \ k - c\ \ d} |l. l \ snd ` p \ l \ {x. \x \ k - c\ \ d} \ {}} \ 0" - apply(rule setsum_nonneg,rule) unfolding mem_Collect_eq image_iff apply(erule exE bexE conjE)+ unfolding split_paired_all + apply(rule setsum_nonneg,rule) unfolding mem_Collect_eq image_iff apply(erule exE bexE conjE)+ unfolding split_paired_all proof- fix x l a b assume as:"x = l \ {x. \x \ k - c\ \ d}" "(a, b) \ p" "l = snd (a, b)" guess u v using p'(4)[OF as(2)] apply-by(erule exE)+ note * = this show "content x \ 0" unfolding as snd_conv * interval_doublesplit[OF k] by(rule content_pos_le) qed have **:"norm (1::real) \ 1" by auto note division_doublesplit[OF p'' k,unfolded interval_doublesplit[OF k]] - note dsum_bound[OF this **,unfolded interval_doublesplit[THEN sym,OF k]] + note dsum_bound[OF this **,unfolded interval_doublesplit[symmetric,OF k]] note this[unfolded real_scaleR_def real_norm_def mult_1_right mult_1, of c d] note le_less_trans[OF this d(2)] from this[unfolded abs_of_nonneg[OF *]] show "(\ka\snd ` p. content (ka \ {x. \x \ k - c\ \ d})) < e" - apply(subst vsum_nonzero_image_lemma[of "snd ` p" content "{}", unfolded o_def,THEN sym]) + apply(subst vsum_nonzero_image_lemma[of "snd ` p" content "{}", unfolded o_def,symmetric]) apply(rule finite_imageI p' content_empty)+ unfolding forall_in_division[OF p''] proof(rule,rule,rule,rule,rule,rule,rule,erule conjE) fix m n u v assume as:"{m..n} \ snd ` p" "{u..v} \ snd ` p" "{m..n} \ {u..v}" "{m..n} \ {x. \x \ k - c\ \ d} = {u..v} \ {x. \x \ k - c\ \ d}" have "({m..n} \ {x. \x \ k - c\ \ d}) \ ({u..v} \ {x. \x \ k - c\ \ d}) \ {m..n} \ {u..v}" by blast note interior_mono[OF this, unfolded division_ofD(5)[OF p'' as(1-3)] interior_inter[of "{m..n}"]] hence "interior ({m..n} \ {x. \x \ k - c\ \ d}) = {}" unfolding as Int_absorb by auto - thus "content ({m..n} \ {x. \x \ k - c\ \ d}) = 0" unfolding interval_doublesplit[OF k] content_eq_0_interior[THEN sym] . + thus "content ({m..n} \ {x. \x \ k - c\ \ d}) = 0" unfolding interval_doublesplit[OF k] content_eq_0_interior[symmetric] . qed qed finally show "(\(x, ka)\p. content (ka \ {x. \x \ k - c\ \ d}) * ?i x) < e" . qed qed qed @@ -3177,7 +4347,7 @@ presume "\p. finite p \ ?P p" from this[rule_format,OF * assms(2)] guess q .. note q=this thus ?thesis apply-apply(rule that[of q]) unfolding tagged_division_ofD[OF assms(1)] by auto } fix p::"(('a::ordered_euclidean_space) \ (('a::ordered_euclidean_space) set)) set" assume as:"finite p" - show "?P p" apply(rule,rule) using as proof(induct p) + show "?P p" apply(rule,rule) using as proof(induct p) case empty show ?case apply(rule_tac x="{}" in exI) unfolding fine_def by auto next case (insert xk p) guess x k using surj_pair[of xk] apply- by(erule exE)+ note xk=this note tagged_partial_division_subset[OF insert(4) subset_insertI] @@ -3186,19 +4356,19 @@ note p = tagged_partial_division_ofD[OF insert(4)] from p(4)[unfolded xk, OF insertI1] guess u v apply-by(erule exE)+ note uv=this - have "finite {k. \x. (x, k) \ p}" + have "finite {k. \x. (x, k) \ p}" apply(rule finite_subset[of _ "snd ` p"],rule) unfolding subset_eq image_iff mem_Collect_eq apply(erule exE,rule_tac x="(xa,x)" in bexI) using p by auto hence int:"interior {u..v} \ interior (\{k. \x. (x, k) \ p}) = {}" apply(rule inter_interior_unions_intervals) apply(rule open_interior) apply(rule_tac[!] ballI) - unfolding mem_Collect_eq apply(erule_tac[!] exE) apply(drule p(4)[OF insertI2],assumption) + unfolding mem_Collect_eq apply(erule_tac[!] exE) apply(drule p(4)[OF insertI2],assumption) apply(rule p(5)) unfolding uv xk apply(rule insertI1,rule insertI2) apply assumption using insert(2) unfolding uv xk by auto show ?case proof(cases "{u..v} \ d x") case True thus ?thesis apply(rule_tac x="{(x,{u..v})} \ q1" in exI) apply rule unfolding * uv apply(rule tagged_division_union,rule tagged_division_of_self) - apply(rule p[unfolded xk uv] insertI1)+ apply(rule q1,rule int) + apply(rule p[unfolded xk uv] insertI1)+ apply(rule q1,rule int) apply(rule,rule fine_union,subst fine_def) defer apply(rule q1) unfolding Ball_def split_paired_All split_conv apply(rule,rule,rule,rule) apply(erule insertE) defer apply(rule UnI2) apply(drule q1(3)[rule_format]) unfolding xk uv by auto @@ -3214,7 +4384,7 @@ lemma finite_product_dependent: assumes "finite s" "\x. x\s\ finite (t x)" shows "finite {(i, j) |i j. i \ s \ j \ t i}" using assms -proof(induct) case (insert x s) +proof(induct) case (insert x s) have *:"{(i, j) |i j. i \ insert x s \ j \ t i} = (\y. (x,y)) ` (t x) \ {(i, j) |i j. i \ s \ j \ t i}" by auto show ?case unfolding * apply(rule finite_UnI) using insert by auto qed auto @@ -3241,16 +4411,16 @@ apply(safe,rule_tac x=1 in exI,rule) apply(rule zero_less_one,safe) apply(rule_tac x=0 in exI) apply(rule,rule P) using assms(2) by auto qed -next fix f::"'b \ 'a" and a b::"'b" assume assm:"\x. x \ s \ f x = 0" +next fix f::"'b \ 'a" and a b::"'b" assume assm:"\x. x \ s \ f x = 0" show "(f has_integral 0) {a..b}" unfolding has_integral proof(safe) case goal1 - hence "\n. e / 2 / ((real n+1) * (2 ^ n)) > 0" + hence "\n. e / 2 / ((real n+1) * (2 ^ n)) > 0" apply-apply(rule divide_pos_pos) defer apply(rule mult_pos_pos) by(auto simp add:field_simps) - note assms(1)[unfolded negligible_def has_integral,rule_format,OF this,of a b] note allI[OF this,of "\x. x"] + note assms(1)[unfolded negligible_def has_integral,rule_format,OF this,of a b] note allI[OF this,of "\x. x"] from choice[OF this] guess d .. note d=conjunctD2[OF this[rule_format]] - show ?case apply(rule_tac x="\x. d (nat \norm (f x)\) x" in exI) + show ?case apply(rule_tac x="\x. d (nat \norm (f x)\) x" in exI) proof safe show "gauge (\x. d (nat \norm (f x)\) x)" using d(1) unfolding gauge_def by auto - fix p assume as:"p tagged_division_of {a..b}" "(\x. d (nat \norm (f x)\) x) fine p" + fix p assume as:"p tagged_division_of {a..b}" "(\x. d (nat \norm (f x)\) x) fine p" let ?goal = "norm ((\(x, k)\p. content k *\<^sub>R f x) - 0) < e" { presume "p\{} \ ?goal" thus ?goal apply(cases "p={}") using goal1 by auto } assume as':"p \ {}" from real_arch_simple[of "Sup((\(x,k). norm(f x)) ` p)"] guess N .. @@ -3258,7 +4428,7 @@ have "\i. \q. q tagged_division_of {a..b} \ (d i) fine q \ (\(x, k)\p. k \ (d i) x \ (x, k) \ q)" apply(rule,rule tagged_division_finer[OF as(1) d(1)]) by auto from choice[OF this] guess q .. note q=conjunctD3[OF this[rule_format]] - have *:"\i. (\(x, k)\q i. content k *\<^sub>R indicator s x) \ (0::real)" apply(rule setsum_nonneg,safe) + have *:"\i. (\(x, k)\q i. content k *\<^sub>R indicator s x) \ (0::real)" apply(rule setsum_nonneg,safe) unfolding real_scaleR_def apply(rule mult_nonneg_nonneg) apply(drule tagged_division_ofD(4)[OF q(1)]) by auto have **:"\f g s t. finite s \ finite t \ (\(x,y) \ t. (0::real) \ g(x,y)) \ (\y\s. \x. (x,y) \ t \ f(y) \ g(x,y)) \ setsum f s \ setsum g t" proof- case goal1 thus ?case apply-apply(rule setsum_le_included[of s t g snd f]) prefer 4 @@ -3266,7 +4436,7 @@ have "norm ((\(x, k)\p. content k *\<^sub>R f x) - 0) \ setsum (\i. (real i + 1) * norm(setsum (\(x,k). content k *\<^sub>R indicator s x :: real) (q i))) {0..N+1}" unfolding real_norm_def setsum_right_distrib abs_of_nonneg[OF *] diff_0_right - apply(rule order_trans,rule norm_setsum) apply(subst sum_sum_product) prefer 3 + apply(rule order_trans,rule norm_setsum) apply(subst sum_sum_product) prefer 3 proof(rule **,safe) show "finite {(i, j) |i j. i \ {0..N + 1} \ j \ q i}" apply(rule finite_product_dependent) using q by auto fix i a b assume as'':"(a,b) \ q i" show "0 \ (real i + 1) * (content b *\<^sub>R indicator s a)" unfolding real_scaleR_def apply(rule mult_nonneg_nonneg) defer apply(rule mult_nonneg_nonneg) @@ -3286,11 +4456,11 @@ qed ultimately show "\y. (y, x, k) \ {(i, j) |i j. i \ {0..N + 1} \ j \ q i} \ norm (content k *\<^sub>R f x) \ (real y + 1) * (content k *\<^sub>R indicator s x)" apply(rule_tac x=n in exI,safe) apply(rule_tac x=n in exI,rule_tac x="(x,k)" in exI,safe) by auto qed(insert as, auto) - also have "... \ setsum (\i. e / 2 / 2 ^ i) {0..N+1}" apply(rule setsum_mono) - proof- case goal1 thus ?case apply(subst mult_commute, subst pos_le_divide_eq[THEN sym]) + also have "... \ setsum (\i. e / 2 / 2 ^ i) {0..N+1}" apply(rule setsum_mono) + proof- case goal1 thus ?case apply(subst mult_commute, subst pos_le_divide_eq[symmetric]) using d(2)[rule_format,of "q i" i] using q[rule_format] by(auto simp add:field_simps) - qed also have "... < e * inverse 2 * 2" unfolding divide_inverse setsum_right_distrib[THEN sym] - apply(rule mult_strict_left_mono) unfolding power_inverse atLeastLessThanSuc_atLeastAtMost[THEN sym] + qed also have "... < e * inverse 2 * 2" unfolding divide_inverse setsum_right_distrib[symmetric] + apply(rule mult_strict_left_mono) unfolding power_inverse atLeastLessThanSuc_atLeastAtMost[symmetric] apply(subst sumr_geometric) using goal1 by auto finally show "?goal" by auto qed qed qed @@ -3323,7 +4493,7 @@ subsection {* Some other trivialities about negligible sets. *} -lemma negligible_subset[intro]: assumes "negligible s" "t \ s" shows "negligible t" unfolding negligible_def +lemma negligible_subset[intro]: assumes "negligible s" "t \ s" shows "negligible t" unfolding negligible_def proof(safe) case goal1 show ?case using assms(1)[unfolded negligible_def,rule_format,of a b] apply-apply(rule has_integral_spike[OF assms(1)]) defer apply assumption using assms(2) unfolding indicator_def by auto qed @@ -3332,7 +4502,7 @@ lemma negligible_inter: assumes "negligible s \ negligible t" shows "negligible(s \ t)" using assms by auto -lemma negligible_union: assumes "negligible s" "negligible t" shows "negligible (s \ t)" unfolding negligible_def +lemma negligible_union: assumes "negligible s" "negligible t" shows "negligible (s \ t)" unfolding negligible_def proof safe case goal1 note assm = assms[unfolded negligible_def,rule_format,of a b] thus ?case apply(subst has_integral_spike_eq[OF assms(2)]) defer apply assumption unfolding indicator_def by auto qed @@ -3340,8 +4510,8 @@ lemma negligible_union_eq[simp]: "negligible (s \ t) \ (negligible s \ negligible t)" using negligible_union by auto -lemma negligible_sing[intro]: "negligible {a::_::ordered_euclidean_space}" - using negligible_standard_hyperplane[OF SOME_Basis, of "a \ (SOME i. i \ Basis)"] by auto +lemma negligible_sing[intro]: "negligible {a::_::ordered_euclidean_space}" + using negligible_standard_hyperplane[OF SOME_Basis, of "a \ (SOME i. i \ Basis)"] by auto lemma negligible_insert[simp]: "negligible(insert a s) \ negligible s" apply(subst insert_is_Un) unfolding negligible_union_eq by auto @@ -3352,7 +4522,7 @@ using assms apply(induct s) by auto lemma negligible_unions[intro]: assumes "finite s" "\t\s. negligible t" shows "negligible(\s)" - using assms by(induct,auto) + using assms by(induct,auto) lemma negligible: "negligible s \ (\t::('a::ordered_euclidean_space) set. ((indicator s::'a\real) has_integral 0) t)" apply safe defer apply(subst negligible_def) @@ -3377,7 +4547,7 @@ subsection {* Finite case of the spike theorem is quite commonly needed. *} -lemma has_integral_spike_finite: assumes "finite s" "\x\t-s. g x = f x" +lemma has_integral_spike_finite: assumes "finite s" "\x\t-s. g x = f x" "(f has_integral y) t" shows "(g has_integral y) t" apply(rule has_integral_spike) using assms by auto @@ -3438,7 +4608,7 @@ proof safe fix a b::"'b" { assume "content {a..b} = 0" - thus "\g. (\x\{a..b}. norm (f x - g x) \ e) \ g integrable_on {a..b}" + thus "\g. (\x\{a..b}. norm (f x - g x) \ e) \ g integrable_on {a..b}" apply(rule_tac x=f in exI) using assms by(auto intro!:integrable_on_null) } { fix c g and k :: 'b assume as:"\x\{a..b}. norm (f x - g x) \ e" "g integrable_on {a..b}" and k:"k\Basis" @@ -3452,7 +4622,7 @@ show "\g. (\x\{a..b}. norm (f x - g x) \ e) \ g integrable_on {a..b}" apply(rule_tac x="?g" in exI) proof safe case goal1 thus ?case apply- apply(cases "x\k=c", case_tac "x\k < c") using as assms by auto next case goal2 presume "?g integrable_on {a..b} \ {x. x \ k \ c}" "?g integrable_on {a..b} \ {x. x \ k \ c}" - then guess h1 h2 unfolding integrable_on_def by auto from has_integral_split[OF this k] + then guess h1 h2 unfolding integrable_on_def by auto from has_integral_split[OF this k] show ?case unfolding integrable_on_def by auto next show "?g integrable_on {a..b} \ {x. x \ k \ c}" "?g integrable_on {a..b} \ {x. x \ k \ c}" apply(rule_tac[!] integrable_spike[OF negligible_standard_hyperplane[of k c]]) using k as(2,4) by auto qed qed @@ -3472,7 +4642,7 @@ from fine_division_exists[OF gauge_ball[OF d(1)], of a b] guess p . note p=this note p' = tagged_division_ofD[OF p(1)] have *:"\i\snd ` p. \g. (\x\i. norm (f x - g x) \ e) \ g integrable_on i" - proof(safe,unfold snd_conv) fix x l assume as:"(x,l) \ p" + proof(safe,unfold snd_conv) fix x l assume as:"(x,l) \ p" from p'(4)[OF this] guess a b apply-by(erule exE)+ note l=this show "\g. (\x\l. norm (f x - g x) \ e) \ g integrable_on l" apply(rule_tac x="\y. f x" in exI) proof safe show "(\y. f x) integrable_on l" unfolding integrable_on_def l by(rule,rule has_integral_const) @@ -3480,11 +4650,11 @@ note d(2)[OF _ _ this[unfolded mem_ball]] thus "norm (f y - f x) \ e" using y p'(2-3)[OF as] unfolding dist_norm l norm_minus_commute by fastforce qed qed from e have "0 \ e" by auto from approximable_on_division[OF this division_of_tagged_division[OF p(1)] *] guess g . - thus "\g. (\x\{a..b}. norm (f x - g x) \ e) \ g integrable_on {a..b}" by auto qed + thus "\g. (\x\{a..b}. norm (f x - g x) \ e) \ g integrable_on {a..b}" by auto qed subsection {* Specialization of additivity to one dimension. *} -lemma +lemma shows real_inner_1_left: "inner 1 x = x" and real_inner_1_right: "inner x 1 = x" by simp_all @@ -3510,9 +4680,9 @@ qed next case True hence *:"min (b) c = c" "max a c = c" by auto have **: "(1::real) \ Basis" by simp - have ***:"\P Q. (\i\Basis. (if i = 1 then P i else Q i) *\<^sub>R i) = (P 1::real)" + have ***:"\P Q. (\i\Basis. (if i = 1 then P i else Q i) *\<^sub>R i) = (P 1::real)" by simp - show ?thesis + show ?thesis unfolding interval_split[OF **, unfolded real_inner_1_right] unfolding *** * proof(cases "c = a \ c = b") case False thus "f {a..b} = opp (f {a..c}) (f {c..b})" @@ -3540,7 +4710,7 @@ proof(erule disjE) assume *:"c=a" hence "f {a..c} = neutral opp" apply-apply(rule as(1)[rule_format]) by auto thus ?thesis using assms unfolding * by auto next assume *:"c=b" hence "f {c..b} = neutral opp" apply-apply(rule as(1)[rule_format]) by auto - thus ?thesis using assms unfolding * by auto qed qed qed + thus ?thesis using assms unfolding * by auto qed qed qed subsection {* Special case of additivity we need for the FCT. *} @@ -3554,8 +4724,8 @@ have ***:"\i\Basis. a \ i \ b \ i" using assms by auto have *:"operative op + ?f" unfolding operative_1_lt[OF monoidal_monoid] interval_eq_empty by auto have **:"{a..b} \ {}" using assms(1) by auto note operative_tagged_division[OF monoidal_monoid * assms(2)] - note * = this[unfolded if_not_P[OF **] interval_bounds[OF ***],THEN sym] - show ?thesis unfolding * apply(subst setsum_iterate[THEN sym]) defer + note * = this[unfolded if_not_P[OF **] interval_bounds[OF ***],symmetric] + show ?thesis unfolding * apply(subst setsum_iterate[symmetric]) defer apply(rule setsum_cong2) unfolding split_paired_all split_conv using assms(2) by auto qed subsection {* A useful lemma allowing us to factor out the content size. *} @@ -3565,10 +4735,10 @@ \ norm (setsum (\(x,k). content k *\<^sub>R f x) p - i) \ e * content {a..b}))" proof(cases "content {a..b} = 0") case True show ?thesis unfolding has_integral_null_eq[OF True] apply safe - apply(rule,rule,rule gauge_trivial,safe) unfolding setsum_content_null[OF True] True defer + apply(rule,rule,rule gauge_trivial,safe) unfolding setsum_content_null[OF True] True defer apply(erule_tac x=1 in allE,safe) defer apply(rule fine_division_exists[of _ a b],assumption) apply(erule_tac x=p in allE) unfolding setsum_content_null[OF True] by auto -next case False note F = this[unfolded content_lt_nz[THEN sym]] +next case False note F = this[unfolded content_lt_nz[symmetric]] let ?P = "\e opp. \d. gauge d \ (\p. p tagged_division_of {a..b} \ d fine p \ opp (norm ((\(x, k)\p. content k *\<^sub>R f x) - i)) e)" show ?thesis apply(subst has_integral) proof safe fix e::real assume e:"e>0" @@ -3599,10 +4769,10 @@ apply(rule_tac x="\x. ball x (d x)" in exI,safe) apply(rule gauge_ball_dependent,rule,rule d(1)) proof- fix p assume as:"p tagged_division_of {a..b}" "(\x. ball x (d x)) fine p" - show "norm ((\(x, k)\p. content k *\<^sub>R f' x) - (f b - f a)) \ e * content {a..b}" - unfolding content_real[OF assms(1)] additive_tagged_division_1[OF assms(1) as(1),of f,THEN sym] - unfolding additive_tagged_division_1[OF assms(1) as(1),of "\x. x",THEN sym] - unfolding setsum_right_distrib defer unfolding setsum_subtractf[THEN sym] + show "norm ((\(x, k)\p. content k *\<^sub>R f' x) - (f b - f a)) \ e * content {a..b}" + unfolding content_real[OF assms(1)] additive_tagged_division_1[OF assms(1) as(1),of f,symmetric] + unfolding additive_tagged_division_1[OF assms(1) as(1),of "\x. x",symmetric] + unfolding setsum_right_distrib defer unfolding setsum_subtractf[symmetric] proof(rule setsum_norm_le,safe) fix x k assume "(x,k)\p" note xk = tagged_division_ofD(2-4)[OF as(1) this] from this(3) guess u v apply-by(erule exE)+ note k=this have *:"u \ v" using xk unfolding k by auto @@ -3615,8 +4785,8 @@ also have "... \ e * norm (u - x) + e * norm (v - x)" apply(rule add_mono) apply(rule d(2)[of "x" "u",unfolded o_def]) prefer 4 apply(rule d(2)[of "x" "v",unfolded o_def]) - using ball[rule_format,of u] ball[rule_format,of v] - using xk(1-2) unfolding k subset_eq by(auto simp add:dist_real_def) + using ball[rule_format,of u] ball[rule_format,of v] + using xk(1-2) unfolding k subset_eq by(auto simp add:dist_real_def) also have "... \ e * (interval_upperbound k - interval_lowerbound k)" unfolding k interval_bounds_real[OF *] using xk(1) unfolding k by(auto simp add:dist_real_def field_simps) finally show "norm (content k *\<^sub>R f' x - (f (interval_upperbound k) - f (interval_lowerbound k))) \ @@ -3638,7 +4808,7 @@ shows "{k. k \ s \ content k \ 0} division_of {a..b}" using assms(1) apply- proof(induct "card s" arbitrary:s rule:nat_less_induct) fix s::"'a set set" assume assm:"s division_of {a..b}" - "\mx. m = card x \ x division_of {a..b} \ {k \ x. content k \ 0} division_of {a..b}" + "\mx. m = card x \ x division_of {a..b} \ {k \ x. content k \ 0} division_of {a..b}" note s = division_ofD[OF assm(1)] let ?thesis = "{k \ s. content k \ 0} division_of {a..b}" { presume *:"{k \ s. content k \ 0} \ s \ ?thesis" show ?thesis apply cases defer apply(rule *,assumption) using assm(1) by auto } @@ -3651,12 +4821,12 @@ apply safe apply(rule closed_interval) using assm(1) by auto have "k \ \(s - {k})" apply safe apply(rule *[unfolded closed_limpt,rule_format]) unfolding islimpt_approachable proof safe fix x and e::real assume as:"x\k" "e>0" - from k(2)[unfolded k content_eq_0] guess i .. + from k(2)[unfolded k content_eq_0] guess i .. hence i:"c\i = d\i" "i\Basis" using s(3)[OF k(1),unfolded k] unfolding interval_ne_empty by auto hence xi:"x\i = d\i" using as unfolding k mem_interval by (metis antisym) def y \ "(\j\Basis. (if j = i then if c\i \ (a\i + b\i) / 2 then c\i + min e (b\i - c\i) / 2 else c\i - min e (c\i - a\i) / 2 else x\j) *\<^sub>R j)::'a" - show "\x'\\(s - {k}). x' \ x \ dist x' x < e" apply(rule_tac x=y in bexI) + show "\x'\\(s - {k}). x' \ x \ dist x' x < e" apply(rule_tac x=y in bexI) proof have "d \ {c..d}" using s(3)[OF k(1)] unfolding k interval_eq_empty mem_interval by(fastforce simp add: not_less) hence "d \ {a..b}" using s(2)[OF k(1)] unfolding k by auto note di = this[unfolded mem_interval,THEN bspec[where x=i]] hence xyi:"y\i \ x\i" @@ -3677,7 +4847,7 @@ using set_rev_mp[OF as(1) s(2)[OF k(1)]] as(2) di i unfolding s mem_interval y_def by (auto simp: field_simps elim!: ballE[of _ _ i]) ultimately show "y \ \(s - {k})" by auto - qed qed hence "\(s - {k}) = {a..b}" unfolding s(6)[THEN sym] by auto + qed qed hence "\(s - {k}) = {a..b}" unfolding s(6)[symmetric] by auto hence "{ka \ s - {k}. content ka \ 0} division_of {a..b}" apply-apply(rule assm(2)[rule_format,OF card refl]) apply(rule division_ofI) defer apply(rule_tac[1-4] s) using assm(1) by auto moreover have "{ka \ s - {k}. content ka \ 0} = {k \ s. content k \ 0}" using k by auto ultimately show ?thesis by auto qed @@ -3690,10 +4860,10 @@ unfolding has_integral_null_eq apply(rule,rule refl) apply(rule,assumption,assumption)+ unfolding integrable_on_def by(auto intro!: has_integral_split) -lemma integrable_subinterval: fixes f::"'b::ordered_euclidean_space \ 'a::banach" - assumes "f integrable_on {a..b}" "{c..d} \ {a..b}" shows "f integrable_on {c..d}" +lemma integrable_subinterval: fixes f::"'b::ordered_euclidean_space \ 'a::banach" + assumes "f integrable_on {a..b}" "{c..d} \ {a..b}" shows "f integrable_on {c..d}" apply(cases "{c..d} = {}") defer apply(rule partial_division_extend_1[OF assms(2)],assumption) - using operative_division_and[OF operative_integrable,THEN sym,of _ _ _ f] assms(1) by auto + using operative_division_and[OF operative_integrable,symmetric,of _ _ _ f] assms(1) by auto subsection {* Combining adjacent intervals in 1 dimension. *} @@ -3710,7 +4880,7 @@ lemma integral_combine: fixes f::"real \ 'a::banach" assumes "a \ c" "c \ b" "f integrable_on ({a..b})" shows "integral {a..c} f + integral {c..b} f = integral({a..b}) f" - apply(rule integral_unique[THEN sym]) apply(rule has_integral_combine[OF assms(1-2)]) + apply(rule integral_unique[symmetric]) apply(rule has_integral_combine[OF assms(1-2)]) apply(rule_tac[!] integrable_integral integrable_subinterval[OF assms(3)])+ using assms(1-2) by auto lemma integrable_combine: fixes f::"real \ 'a::banach" @@ -3725,7 +4895,7 @@ proof- have "\x. \d. x\{a..b} \ d>0 \ (\u v. x \ {u..v} \ {u..v} \ ball x d \ {u..v} \ {a..b} \ f integrable_on {u..v})" using assms by auto note this[unfolded gauge_existence_lemma] from choice[OF this] guess d .. note d=this[rule_format] guess p apply(rule fine_division_exists[OF gauge_ball_dependent,of d a b]) using d by auto note p=this(1-2) - note division_of_tagged_division[OF this(1)] note * = operative_division_and[OF operative_integrable,OF this,THEN sym,of f] + note division_of_tagged_division[OF this(1)] note * = operative_division_and[OF operative_integrable,OF this,symmetric,of f] show ?thesis unfolding * apply safe unfolding snd_conv proof- fix x k assume "(x,k) \ p" note tagged_division_ofD(2-4)[OF p(1) this] fineD[OF p(2) this] thus "f integrable_on k" apply safe apply(rule d[THEN conjunct2,rule_format,of x]) by auto qed qed @@ -3765,10 +4935,10 @@ hence *:"?I a x - ?I a y = ?I y x" unfolding algebra_simps apply(subst eq_commute) apply(rule integral_combine) using True using assms(2) goal1 by auto have **:"norm (y - x) = content {y..x}" apply(subst content_real) using True unfolding not_less by auto - have ***:"\fy fx c::'a. fx - fy - (y - x) *\<^sub>R c = -(fy - fx - (x - y) *\<^sub>R c)" unfolding scaleR_left.diff by auto + have ***:"\fy fx c::'a. fx - fy - (y - x) *\<^sub>R c = -(fy - fx - (x - y) *\<^sub>R c)" unfolding scaleR_left.diff by auto show ?thesis apply(subst ***) unfolding norm_minus_cancel ** apply(rule has_integral_bound[where f="(\u. f u - f x)"]) unfolding * unfolding o_def - defer apply(rule has_integral_sub) apply(subst minus_minus[THEN sym]) unfolding minus_minus + defer apply(rule has_integral_sub) apply(subst minus_minus[symmetric]) unfolding minus_minus apply(rule integrable_integral) apply(rule integrable_subinterval,rule integrable_continuous) apply(rule assms)+ proof- show "{y..x} \ {a..b}" using goal1 assms(2) by auto have *:"x - y = norm(y - x)" using True by auto @@ -3813,8 +4983,8 @@ def d' \ "\x. {y. g y \ d (g x)}" have d':"\x. d' x = {y. g y \ (d (g x))}" unfolding d'_def .. show "\d. gauge d \ (\p. p tagged_division_of h ` {a..b} \ d fine p \ norm ((\(x, k)\p. content k *\<^sub>R f (g x)) - (1 / r) *\<^sub>R i) < e)" proof(rule_tac x=d' in exI,safe) show "gauge d'" using d(1) unfolding gauge_def d' using continuous_open_preimage_univ[OF assms(4)] by auto - fix p assume as:"p tagged_division_of h ` {a..b}" "d' fine p" note p = tagged_division_ofD[OF as(1)] - have "(\(x, k). (g x, g ` k)) ` p tagged_division_of {a..b} \ d fine (\(x, k). (g x, g ` k)) ` p" unfolding tagged_division_of + fix p assume as:"p tagged_division_of h ` {a..b}" "d' fine p" note p = tagged_division_ofD[OF as(1)] + have "(\(x, k). (g x, g ` k)) ` p tagged_division_of {a..b} \ d fine (\(x, k). (g x, g ` k)) ` p" unfolding tagged_division_of proof safe show "finite ((\(x, k). (g x, g ` k)) ` p)" using as by auto show "d fine (\(x, k). (g x, g ` k)) ` p" using as(2) unfolding fine_def d' by auto fix x k assume xk[intro]:"(x,k) \ p" show "g x \ g ` k" using p(2)[OF xk] by auto @@ -3852,12 +5022,12 @@ lemma setprod_cong2: assumes "\x. x \ A \ f x = g x" shows "setprod f A = setprod g A" apply(rule setprod_cong) using assms by auto -lemma content_image_affinity_interval: +lemma content_image_affinity_interval: "content((\x::'a::ordered_euclidean_space. m *\<^sub>R x + c) ` {a..b}) = (abs m) ^ DIM('a) * content {a..b}" (is "?l = ?r") proof- { presume *:"{a..b}\{} \ ?thesis" show ?thesis apply(cases,rule *,assumption) unfolding not_not using content_empty by auto } - assume as: "{a..b}\{}" - show ?thesis + assume as: "{a..b}\{}" + show ?thesis proof (cases "m \ 0") case True with as have "{m *\<^sub>R a + c..m *\<^sub>R b + c} \ {}" @@ -3903,10 +5073,10 @@ lemma image_stretch_interval: "(\x. \k\Basis. (m k * (x\k)) *\<^sub>R k) ` {a..b::'a::ordered_euclidean_space} = (if {a..b} = {} then {} else - {(\k\Basis. (min (m k * (a\k)) (m k * (b\k))) *\<^sub>R k)::'a .. + {(\k\Basis. (min (m k * (a\k)) (m k * (b\k))) *\<^sub>R k)::'a .. (\k\Basis. (max (m k * (a\k)) (m k * (b\k))) *\<^sub>R k)})" proof cases - assume *: "{a..b} \ {}" + assume *: "{a..b} \ {}" show ?thesis unfolding interval_ne_empty if_not_P[OF *] apply (simp add: interval image_Collect set_eq_iff euclidean_eq_iff[where 'a='a] ball_conj_distrib[symmetric]) @@ -3929,14 +5099,14 @@ "max (m i * (a \ i)) (m i * (b \ i)) = (if 0 < m i then m i * (b \ i) else m i * (a \ i))" using a_le_b by (auto simp: min_def max_def mult_le_cancel_left) with False show ?thesis using a_le_b - unfolding * by (auto simp add: le_divide_eq divide_le_eq ac_simps) + unfolding * by (auto simp add: le_divide_eq divide_le_eq ac_simps) qed qed qed simp -lemma interval_image_stretch_interval: +lemma interval_image_stretch_interval: "\u v. (\x. \k\Basis. (m k * (x\k))*\<^sub>R k) ` {a..b::'a::ordered_euclidean_space} = {u..v::'a}" - unfolding image_stretch_interval by auto + unfolding image_stretch_interval by auto lemma content_image_stretch_interval: "content((\x::'a::ordered_euclidean_space. (\k\Basis. (m k * (x\k))*\<^sub>R k)::'a) ` {a..b}) = abs(setprod m Basis) * content({a..b})" @@ -3944,12 +5114,12 @@ unfolding content_def image_is_empty image_stretch_interval if_P[OF True] by auto next case False hence "(\x. (\k\Basis. (m k * (x\k))*\<^sub>R k)::'a) ` {a..b} \ {}" by auto thus ?thesis using False unfolding content_def image_stretch_interval apply- unfolding interval_bounds' if_not_P - unfolding abs_setprod setprod_timesf[THEN sym] apply(rule setprod_cong2) unfolding lessThan_iff + unfolding abs_setprod setprod_timesf[symmetric] apply(rule setprod_cong2) unfolding lessThan_iff proof (simp only: inner_setsum_left_Basis) fix i :: 'a assume i:"i\Basis" have "(m i < 0 \ m i > 0) \ m i = 0" by auto - thus "max (m i * (a \ i)) (m i * (b \ i)) - min (m i * (a \ i)) (m i * (b \ i)) = + thus "max (m i * (a \ i)) (m i * (b \ i)) - min (m i * (a \ i)) (m i * (b \ i)) = \m i\ * (b \ i - a \ i)" - apply-apply(erule disjE)+ unfolding min_def max_def using False[unfolded interval_ne_empty,rule_format,of i] i + apply-apply(erule disjE)+ unfolding min_def max_def using False[unfolded interval_ne_empty,rule_format,of i] i by(auto simp add:field_simps not_le mult_le_cancel_left_neg mult_le_cancel_left_pos) qed qed lemma has_integral_stretch: fixes f::"'a::ordered_euclidean_space => 'b::real_normed_vector" @@ -3966,7 +5136,7 @@ lemma integrable_stretch: fixes f::"'a::ordered_euclidean_space => 'b::real_normed_vector" assumes "f integrable_on {a..b}" "\k\Basis. ~(m k = 0)" shows "(\x::'a. f (\k\Basis. (m k * (x\k))*\<^sub>R k)) integrable_on ((\x. \k\Basis. (1 / m k * (x\k))*\<^sub>R k) ` {a..b})" - using assms unfolding integrable_on_def apply-apply(erule exE) + using assms unfolding integrable_on_def apply-apply(erule exE) apply(drule has_integral_stretch,assumption) by auto subsection {* even more special cases. *} @@ -4001,13 +5171,13 @@ unfolding split_def by(rule refl) lemma norm_triangle_le_sub: "norm x + norm y \ e \ norm (x - y) \ e" - apply(subst(asm)(2) norm_minus_cancel[THEN sym]) + apply(subst(asm)(2) norm_minus_cancel[symmetric]) apply(drule norm_triangle_le) by(auto simp add:algebra_simps) lemma fundamental_theorem_of_calculus_interior: fixes f::"real => 'a::real_normed_vector" assumes"a \ b" "continuous_on {a..b} f" "\x\{a<.. ?thesis" +proof- { presume *:"a < b \ ?thesis" show ?thesis proof(cases,rule *,assumption) assume "\ a < b" hence "a = b" using assms(1) by auto hence *:"{a .. b} = {b}" "f b - f a = 0" by(auto simp add: order_antisym) @@ -4034,15 +5204,15 @@ from *[OF this] guess k .. note k = conjunctD2[OF this,rule_format] have "\l. 0 < l \ norm(l *\<^sub>R f' a) \ (e * (b - a)) / 8" proof(cases "f' a = 0") case True - thus ?thesis apply(rule_tac x=1 in exI) using ab e by(auto intro!:mult_nonneg_nonneg) + thus ?thesis apply(rule_tac x=1 in exI) using ab e by(auto intro!:mult_nonneg_nonneg) next case False thus ?thesis - apply(rule_tac x="(e * (b - a)) / 8 / norm (f' a)" in exI) using ab e by(auto simp add:field_simps) + apply(rule_tac x="(e * (b - a)) / 8 / norm (f' a)" in exI) using ab e by(auto simp add:field_simps) qed then guess l .. note l = conjunctD2[OF this] show ?thesis apply(rule_tac x="min k l" in exI) apply safe unfolding min_less_iff_conj apply(rule,(rule l k)+) - proof- fix c assume as:"a \ c" "{a..c} \ {a..b}" "{a..c} \ ball a (min k l)" + proof- fix c assume as:"a \ c" "{a..c} \ {a..b}" "{a..c} \ ball a (min k l)" note as' = this[unfolded subset_eq Ball_def mem_ball dist_real_def mem_interval] have "norm ((c - a) *\<^sub>R f' a - (f c - f a)) \ norm ((c - a) *\<^sub>R f' a) + norm (f c - f a)" by(rule norm_triangle_ineq4) - also have "... \ e * (b - a) / 8 + e * (b - a) / 8" + also have "... \ e * (b - a) / 8 + e * (b - a) / 8" proof(rule add_mono) case goal1 have "\c - a\ \ \l\" using as' by auto thus ?case apply-apply(rule order_trans[OF _ l(2)]) unfolding norm_scaleR apply(rule mult_right_mono) by auto next case goal2 show ?case apply(rule less_imp_le) apply(cases "a = c") defer @@ -4060,16 +5230,16 @@ from *[OF this] guess k .. note k = conjunctD2[OF this,rule_format] have "\l. 0 < l \ norm(l *\<^sub>R f' b) \ (e * (b - a)) / 8" proof(cases "f' b = 0") case True - thus ?thesis apply(rule_tac x=1 in exI) using ab e by(auto intro!:mult_nonneg_nonneg) - next case False thus ?thesis + thus ?thesis apply(rule_tac x=1 in exI) using ab e by(auto intro!:mult_nonneg_nonneg) + next case False thus ?thesis apply(rule_tac x="(e * (b - a)) / 8 / norm (f' b)" in exI) using ab e by(auto simp add:field_simps) qed then guess l .. note l = conjunctD2[OF this] show ?thesis apply(rule_tac x="min k l" in exI) apply safe unfolding min_less_iff_conj apply(rule,(rule l k)+) - proof- fix c assume as:"c \ b" "{c..b} \ {a..b}" "{c..b} \ ball b (min k l)" + proof- fix c assume as:"c \ b" "{c..b} \ {a..b}" "{c..b} \ ball b (min k l)" note as' = this[unfolded subset_eq Ball_def mem_ball dist_real_def mem_interval] have "norm ((b - c) *\<^sub>R f' b - (f b - f c)) \ norm ((b - c) *\<^sub>R f' b) + norm (f b - f c)" by(rule norm_triangle_ineq4) - also have "... \ e * (b - a) / 8 + e * (b - a) / 8" + also have "... \ e * (b - a) / 8 + e * (b - a) / 8" proof(rule add_mono) case goal1 have "\c - b\ \ \l\" using as' by auto thus ?case apply-apply(rule order_trans[OF _ l(2)]) unfolding norm_scaleR apply(rule mult_right_mono) by auto next case goal2 show ?case apply(rule less_imp_le) apply(cases "b = c") defer apply(subst norm_minus_commute) @@ -4083,11 +5253,11 @@ proof safe case goal1 show ?case apply(rule gauge_ball_dependent) using ab db(1) da(1) d(1) by auto next case goal2 note as=this let ?A = "{t. fst t \ {a, b}}" note p = tagged_division_ofD[OF goal2(1)] have pA:"p = (p \ ?A) \ (p - ?A)" "finite (p \ ?A)" "finite (p - ?A)" "(p \ ?A) \ (p - ?A) = {}" using goal2 by auto - note * = additive_tagged_division_1'[OF assms(1) goal2(1), THEN sym] + note * = additive_tagged_division_1'[OF assms(1) goal2(1), symmetric] have **:"\n1 s1 n2 s2::real. n2 \ s2 / 2 \ n1 - s1 \ s2 / 2 \ n1 + n2 \ s1 + s2" by arith - show ?case unfolding content_real[OF assms(1)] and *[of "\x. x"] *[of f] setsum_subtractf[THEN sym] split_minus + show ?case unfolding content_real[OF assms(1)] and *[of "\x. x"] *[of f] setsum_subtractf[symmetric] split_minus unfolding setsum_right_distrib apply(subst(2) pA,subst pA) unfolding setsum_Un_disjoint[OF pA(2-)] - proof(rule norm_triangle_le,rule **) + proof(rule norm_triangle_le,rule **) case goal1 show ?case apply(rule order_trans,rule setsum_norm_le) defer apply(subst setsum_divide_distrib) proof(rule order_refl,safe,unfold not_le o_def split_conv fst_conv,rule ccontr) fix x k assume as:"(x,k) \ p" "e * (interval_upperbound k - interval_lowerbound k) / 2 @@ -4099,8 +5269,8 @@ assume as':"x \ a" "x \ b" hence "x \ {a<..R f' (x) - (f (v) - f (u))) = - norm ((f (u) - f (x) - (u - x) *\<^sub>R f' (x)) - (f (v) - f (x) - (v - x) *\<^sub>R f' (x)))" - apply(rule arg_cong[of _ _ norm]) unfolding scaleR_left.diff by auto + norm ((f (u) - f (x) - (u - x) *\<^sub>R f' (x)) - (f (v) - f (x) - (v - x) *\<^sub>R f' (x)))" + apply(rule arg_cong[of _ _ norm]) unfolding scaleR_left.diff by auto also have "... \ e / 2 * norm (u - x) + e / 2 * norm (v - x)" apply(rule norm_triangle_le_sub) apply(rule add_mono) apply(rule_tac[!] *) using fineD[OF goal2(2) as(1)] as' unfolding k subset_eq apply- apply(erule_tac x=u in ballE,erule_tac[3] x=v in ballE) using uv by(auto simp:dist_real_def) @@ -4110,7 +5280,7 @@ next have *:"\x s1 s2::real. 0 \ s1 \ x \ (s1 + s2) / 2 \ x - s1 \ s2 / 2" by auto case goal2 show ?case apply(rule *) apply(rule setsum_nonneg) apply(rule,unfold split_paired_all split_conv) - defer unfolding setsum_Un_disjoint[OF pA(2-),THEN sym] pA(1)[THEN sym] unfolding setsum_right_distrib[THEN sym] + defer unfolding setsum_Un_disjoint[OF pA(2-),symmetric] pA(1)[symmetric] unfolding setsum_right_distrib[symmetric] apply(subst additive_tagged_division_1[OF _ as(1)]) apply(rule assms) proof- fix x k assume "(x,k) \ p \ {t. fst t \ {a, b}}" note xk=IntD1[OF this] from p(4)[OF this] guess u v apply-by(erule exE)+ note uv=this @@ -4119,7 +5289,7 @@ unfolding uv using e by(auto simp add:field_simps) next have *:"\s f t e. setsum f s = setsum f t \ norm(setsum f t) \ e \ norm(setsum f s) \ e" by auto show "norm (\(x, k)\p \ ?A. content k *\<^sub>R f' x - - (f ((interval_upperbound k)) - f ((interval_lowerbound k)))) \ e * (b - a) / 2" + (f ((interval_upperbound k)) - f ((interval_lowerbound k)))) \ e * (b - a) / 2" apply(rule *[where t="p \ {t. fst t \ {a, b} \ content(snd t) \ 0}"]) apply(rule setsum_mono_zero_right[OF pA(2)]) defer apply(rule) unfolding split_paired_all split_conv o_def proof- fix x k assume "(x,k) \ p \ {t. fst t \ {a, b}} - p \ {t. fst t \ {a, b} \ content (snd t) \ 0}" @@ -4127,7 +5297,7 @@ have "k\{}" using p(2)[OF xk(1)] by auto hence *:"u = v" using xk unfolding uv content_eq_0 interval_eq_empty by auto thus "content k *\<^sub>R (f' (x)) - (f ((interval_upperbound k)) - f ((interval_lowerbound k))) = 0" using xk unfolding uv by auto - next have *:"p \ {t. fst t \ {a, b} \ content(snd t) \ 0} = + next have *:"p \ {t. fst t \ {a, b} \ content(snd t) \ 0} = {t. t\p \ fst t = a \ content(snd t) \ 0} \ {t. t\p \ fst t = b \ content(snd t) \ 0}" by blast have **:"\s f. \e::real. (\x y. x \ s \ y \ s \ x = y) \ (\x. x \ s \ norm(f x) \ e) \ e>0 \ norm(setsum f s) \ e" @@ -4135,22 +5305,22 @@ thus ?case using `x\s` goal2(2) by auto qed auto case goal2 show ?case apply(subst *, subst setsum_Un_disjoint) prefer 4 - apply(rule order_trans[of _ "e * (b - a)/4 + e * (b - a)/4"]) + apply(rule order_trans[of _ "e * (b - a)/4 + e * (b - a)/4"]) apply(rule norm_triangle_le,rule add_mono) apply(rule_tac[1-2] **) proof- let ?B = "\x. {t \ p. fst t = x \ content (snd t) \ 0}" - have pa:"\k. (a, k) \ p \ \v. k = {a .. v} \ a \ v" + have pa:"\k. (a, k) \ p \ \v. k = {a .. v} \ a \ v" proof- case goal1 guess u v using p(4)[OF goal1] apply-by(erule exE)+ note uv=this have *:"u \ v" using p(2)[OF goal1] unfolding uv by auto - have u:"u = a" proof(rule ccontr) have "u \ {u..v}" using p(2-3)[OF goal1(1)] unfolding uv by auto + have u:"u = a" proof(rule ccontr) have "u \ {u..v}" using p(2-3)[OF goal1(1)] unfolding uv by auto have "u \ a" using p(2-3)[OF goal1(1)] unfolding uv subset_eq by auto moreover assume "u\a" ultimately have "u > a" by auto thus False using p(2)[OF goal1(1)] unfolding uv by(auto simp add:) qed thus ?case apply(rule_tac x=v in exI) unfolding uv using * by auto qed - have pb:"\k. (b, k) \ p \ \v. k = {v .. b} \ b \ v" + have pb:"\k. (b, k) \ p \ \v. k = {v .. b} \ b \ v" proof- case goal1 guess u v using p(4)[OF goal1] apply-by(erule exE)+ note uv=this have *:"u \ v" using p(2)[OF goal1] unfolding uv by auto - have u:"v = b" proof(rule ccontr) have "u \ {u..v}" using p(2-3)[OF goal1(1)] unfolding uv by auto + have u:"v = b" proof(rule ccontr) have "u \ {u..v}" using p(2-3)[OF goal1(1)] unfolding uv by auto have "v \ b" using p(2-3)[OF goal1(1)] unfolding uv subset_eq by auto moreover assume "v\ b" ultimately have "v < b" by auto thus False using p(2)[OF goal1(1)] unfolding uv by(auto simp add:) @@ -4168,7 +5338,7 @@ ultimately have " ((a + ?v)/2) \ interior k \ interior k'" unfolding interior_open[OF open_interval] by auto hence *:"k = k'" apply- apply(rule ccontr) using p(5)[OF k(1-2)] by auto { assume "x\k" thus "x\k'" unfolding * . } { assume "x\k'" thus "x\k" unfolding * . } - qed + qed show "\x y. x \ ?B b \ y \ ?B b \ x = y" apply(rule,rule,rule,unfold split_paired_all) unfolding mem_Collect_eq fst_conv snd_conv apply safe proof- fix x k k' assume k:"( b, k) \ p" "( b, k') \ p" "content k \ 0" "content k' \ 0" @@ -4184,7 +5354,7 @@ let ?a = a and ?b = b (* a is something else while proofing the next theorem. *) show "\x. x \ ?B a \ norm ((\(x, k). content k *\<^sub>R f' (x) - (f ((interval_upperbound k)) - f ((interval_lowerbound k)))) x) \ e * (b - a) / 4" apply(rule,rule) unfolding mem_Collect_eq - unfolding split_paired_all fst_conv snd_conv + unfolding split_paired_all fst_conv snd_conv proof safe case goal1 guess v using pa[OF goal1(1)] .. note v = conjunctD2[OF this] have " ?a\{ ?a..v}" using v(2) by auto hence "v \ ?b" using p(3)[OF goal1(1)] unfolding subset_eq v by auto moreover have "{?a..v} \ ball ?a da" using fineD[OF as(2) goal1(1)] @@ -4195,7 +5365,7 @@ qed show "\x. x \ ?B b \ norm ((\(x, k). content k *\<^sub>R f' (x) - (f ((interval_upperbound k)) - f ((interval_lowerbound k)))) x) \ e * (b - a) / 4" - apply(rule,rule) unfolding mem_Collect_eq unfolding split_paired_all fst_conv snd_conv + apply(rule,rule) unfolding mem_Collect_eq unfolding split_paired_all fst_conv snd_conv proof safe case goal1 guess v using pb[OF goal1(1)] .. note v = conjunctD2[OF this] have " ?b\{v.. ?b}" using v(2) by auto hence "v \ ?a" using p(3)[OF goal1(1)] unfolding subset_eq v by auto @@ -4213,7 +5383,7 @@ lemma fundamental_theorem_of_calculus_interior_strong: fixes f::"real \ 'a::banach" assumes"finite s" "a \ b" "continuous_on {a..b} f" "\x\{a<..0` by auto qed then guess w .. note w = conjunctD2[OF this,rule_format] - + have *:"e / 3 > 0" using assms by auto have "f integrable_on {a..c}" apply(rule integrable_subinterval[OF assms(1)]) using assms(2-3) by auto from integrable_integral[OF this,unfolded has_integral,rule_format,OF *] guess d1 .. @@ -4281,7 +5451,7 @@ have pt:"\(x,k)\p. x \ t" proof safe case goal1 from p'(2,3)[OF this] show ?case by auto qed with p(2) have "d2 fine p" unfolding fine_def d3_def apply safe apply(erule_tac x="(a,b)" in ballE)+ by auto note d2_fin = d2(2)[OF conjI[OF p(1) this]] - + have *:"{a..c} \ {x. x \ 1 \ t} = {a..t}" "{a..c} \ {x. x \ 1 \ t} = {t..c}" using assms(2-3) as by(auto simp add:field_simps) have "p \ {(c, {t..c})} tagged_division_of {a..c} \ d1 fine p \ {(c, {t..c})}" apply rule @@ -4290,30 +5460,30 @@ proof safe fix x k y assume "(x,k)\p" "y\k" thus "y\d1 x" using p(2) pt unfolding fine_def d3_def apply- apply(erule_tac x="(x,k)" in ballE)+ by auto next fix x assume "x\{t..c}" hence "dist c x < k" unfolding dist_real_def - using as(1) by(auto simp add:field_simps) + using as(1) by(auto simp add:field_simps) thus "x \ d1 c" using k(2) unfolding d_def by auto qed(insert as(2), auto) note d1_fin = d1(2)[OF this] have *:"integral{a..c} f - integral {a..t} f = -(((c - t) *\<^sub>R f c + (\(x, k)\p. content k *\<^sub>R f x)) - - integral {a..c} f) + ((\(x, k)\p. content k *\<^sub>R f x) - integral {a..t} f) + (c - t) *\<^sub>R f c" + integral {a..c} f) + ((\(x, k)\p. content k *\<^sub>R f x) - integral {a..t} f) + (c - t) *\<^sub>R f c" "e = (e/3 + e/3) + e/3" by auto have **:"(\(x, k)\p \ {(c, {t..c})}. content k *\<^sub>R f x) = (c - t) *\<^sub>R f c + (\(x, k)\p. content k *\<^sub>R f x)" proof- have **:"\x F. F \ {x} = insert x F" by auto have "(c, {t..c}) \ p" proof safe case goal1 from p'(2-3)[OF this] have "c \ {a..t}" by auto thus False using `t t < c" proof- have "c - k < t" using `k>0` as(1) by(auto simp add:field_simps) - moreover have "k \ w" apply(rule ccontr) using k(2) + moreover have "k \ w" apply(rule ccontr) using k(2) unfolding subset_eq apply(erule_tac x="c + ((k + w)/2)" in ballE) unfolding d_def using `k>0` `w>0` by(auto simp add:field_simps not_le not_less dist_real_def) ultimately show ?thesis using `t 'a::banach" assumes "f integrable_on {a..b}" "a \ c" "c < b" "0 < e" @@ -4327,9 +5497,9 @@ "integral{a..t} f = integral{a..b} f - integral{t..b} f" unfolding algebra_simps apply(rule_tac[!] integral_combine) using assms as by auto have "(- c) - d < (- t) \ - t \ - c" using as by auto note d(2)[rule_format,OF this] - thus "norm (integral {a..c} f - integral {a..t} f) < e" unfolding * + thus "norm (integral {a..c} f - integral {a..t} f) < e" unfolding * unfolding integral_reflect apply-apply(subst norm_minus_commute) by(auto simp add:algebra_simps) qed qed - + lemma indefinite_integral_continuous: fixes f::"real \ 'a::banach" assumes "f integrable_on {a..b}" shows "continuous_on {a..b} (\x. integral {a..x} f)" proof(unfold continuous_on_iff, safe) fix x e assume as:"x\{a..b}" "0<(e::real)" @@ -4359,7 +5529,7 @@ thus "dist (integral {a..y} f) (integral {a..x} f) < e" apply-apply(subst dist_commute) apply(cases "y < x") unfolding dist_norm apply(rule d1(2)[rule_format]) defer apply(rule d2(2)[rule_format]) unfolding not_less by(auto simp add:field_simps) - qed qed qed + qed qed qed subsection {* This doesn't directly involve integration, but that gives an easy proof. *} @@ -4372,7 +5542,7 @@ have "((\x. 0\'a) has_integral f x - f a) {a..x}" apply(rule fundamental_theorem_of_calculus_interior_strong[OF assms(1) *]) apply(rule continuous_on_subset[OF assms(2)]) defer - apply safe unfolding has_vector_derivative_def apply(subst has_derivative_within_open[THEN sym]) + apply safe unfolding has_vector_derivative_def apply(subst has_derivative_within_open[symmetric]) apply assumption apply(rule open_interval) apply(rule has_derivative_within_subset[where s="{a..b}"]) using assms(4) assms(5) by auto note this[unfolded *] note has_integral_unique[OF has_integral_0 this] @@ -4385,16 +5555,16 @@ "\x\(s - k). (f has_derivative (\h. 0)) (at x within s)" "x \ s" shows "f x = y" proof- { presume *:"x \ c \ ?thesis" show ?thesis apply(cases,rule *,assumption) - unfolding assms(5)[THEN sym] by auto } assume "x\c" + unfolding assms(5)[symmetric] by auto } assume "x\c" note conv = assms(1)[unfolded convex_alt,rule_format] have as1:"continuous_on {0..1} (f \ (\t. (1 - t) *\<^sub>R c + t *\<^sub>R x))" apply(rule continuous_on_intros)+ apply(rule continuous_on_subset[OF assms(3)]) apply safe apply(rule conv) using assms(4,7) by auto have *:"\t xa. (1 - t) *\<^sub>R c + t *\<^sub>R x = (1 - xa) *\<^sub>R c + xa *\<^sub>R x \ t = xa" - proof- case goal1 hence "(t - xa) *\<^sub>R x = (t - xa) *\<^sub>R c" + proof- case goal1 hence "(t - xa) *\<^sub>R x = (t - xa) *\<^sub>R c" unfolding scaleR_simps by(auto simp add:algebra_simps) thus ?case using `x\c` by auto qed - have as2:"finite {t. ((1 - t) *\<^sub>R c + t *\<^sub>R x) \ k}" using assms(2) + have as2:"finite {t. ((1 - t) *\<^sub>R c + t *\<^sub>R x) \ k}" using assms(2) apply(rule finite_surj[where f="\z. SOME t. (1-t) *\<^sub>R c + t *\<^sub>R x = z"]) apply safe unfolding image_iff apply rule defer apply assumption apply(rule sym) apply(rule some_equality) defer apply(drule *) by auto @@ -4402,7 +5572,7 @@ apply(rule has_derivative_zero_unique_strong_interval[OF as2 as1, of ]) unfolding o_def using assms(5) defer apply-apply(rule) proof- fix t assume as:"t\{0..1} - {t. (1 - t) *\<^sub>R c + t *\<^sub>R x \ k}" - have *:"c - t *\<^sub>R c + t *\<^sub>R x \ s - k" apply safe apply(rule conv[unfolded scaleR_simps]) + have *:"c - t *\<^sub>R c + t *\<^sub>R x \ s - k" apply safe apply(rule conv[unfolded scaleR_simps]) using `x\s` `c\s` as by(auto simp add: algebra_simps) have "(f \ (\t. (1 - t) *\<^sub>R c + t *\<^sub>R x) has_derivative (\x. 0) \ (\z. (0 - z *\<^sub>R c) + z *\<^sub>R x)) (at t within {0..1})" apply(rule diff_chain_within) apply(rule has_derivative_add) @@ -4414,7 +5584,7 @@ thus "((\xa. f ((1 - xa) *\<^sub>R c + xa *\<^sub>R x)) has_derivative (\h. 0)) (at t within {0..1})" unfolding o_def . qed auto thus ?thesis by auto qed -subsection {* Also to any open connected set with finite set of exceptions. Could +subsection {* Also to any open connected set with finite set of exceptions. Could generalize to locally convex set with limpt-free set of exceptions. *} lemma has_derivative_zero_unique_strong_connected: fixes f::"'a::ordered_euclidean_space \ 'b::banach" @@ -4425,7 +5595,7 @@ apply(rule assms(1)[unfolded connected_clopen,rule_format]) apply rule defer apply(rule continuous_closed_in_preimage[OF assms(4) closed_singleton]) apply(rule open_openin_trans[OF assms(2)]) unfolding open_contains_ball - proof safe fix x assume "x\s" + proof safe fix x assume "x\s" from assms(2)[unfolded open_contains_ball,rule_format,OF this] guess e .. note e=conjunctD2[OF this] show "\e>0. ball x e \ {xa \ s. f xa \ {f x}}" apply(rule,rule,rule e) proof safe fix y assume y:"y \ ball x e" thus "y\s" using e by auto @@ -4444,12 +5614,12 @@ proof- def g \ "\x. if x \{c<..{} \ ?thesis" show ?thesis apply(cases,rule *,assumption) - proof- case goal1 hence *:"{c<..{}" from partial_division_extend_1[OF assms(2) this] guess p . note p=this - note mon = monoidal_lifted[OF monoidal_monoid] - note operat = operative_division[OF this operative_integral p(1), THEN sym] + note mon = monoidal_lifted[OF monoidal_monoid] + note operat = operative_division[OF this operative_integral p(1), symmetric] let ?P = "(if g integrable_on {a..b} then Some (integral {a..b} g) else None) = Some i" { presume "?P" hence "g integrable_on {a..b} \ integral {a..b} g = i" apply- apply(cases,subst(asm) if_P,assumption) by auto @@ -4476,13 +5646,13 @@ unfolding iterate defer apply(subst if_not_P) defer using p by auto qed lemma has_integral_restrict_closed_subinterval: fixes f::"'a::ordered_euclidean_space \ 'b::banach" - assumes "(f has_integral i) ({c..d})" "{c..d} \ {a..b}" + assumes "(f has_integral i) ({c..d})" "{c..d} \ {a..b}" shows "((\x. if x \ {c..d} then f x else 0) has_integral i) {a..b}" proof- note has_integral_restrict_open_subinterval[OF assms] note * = has_integral_spike[OF negligible_frontier_interval _ this] show ?thesis apply(rule *[of c d]) using interval_open_subset_closed[of c d] by auto qed -lemma has_integral_restrict_closed_subintervals_eq: fixes f::"'a::ordered_euclidean_space \ 'b::banach" assumes "{c..d} \ {a..b}" +lemma has_integral_restrict_closed_subintervals_eq: fixes f::"'a::ordered_euclidean_space \ 'b::banach" assumes "{c..d} \ {a..b}" shows "((\x. if x \ {c..d} then f x else 0) has_integral i) {a..b} \ (f has_integral i) {c..d}" (is "?l = ?r") proof(cases "{c..d} = {}") case False let ?g = "\x. if x \ {c..d} then f x else 0" show ?thesis apply rule defer apply(rule has_integral_restrict_closed_subinterval[OF _ assms]) @@ -4512,38 +5682,38 @@ apply safe apply(drule B(2)[rule_format]) unfolding subset_eq apply(erule_tac x=x in ballE) by(auto simp add:dist_norm) qed(insert B `e>0`, auto) - next assume as:"\e>0. ?r e" + next assume as:"\e>0. ?r e" from this[rule_format,OF zero_less_one] guess C .. note C=conjunctD2[OF this,rule_format] - def c \ "(\i\Basis. (- max B C) *\<^sub>R i)::'n::ordered_euclidean_space" + def c \ "(\i\Basis. (- max B C) *\<^sub>R i)::'n::ordered_euclidean_space" def d \ "(\i\Basis. max B C *\<^sub>R i)::'n::ordered_euclidean_space" have c_d:"{a..b} \ {c..d}" apply safe apply(drule B(2)) unfolding mem_interval proof case goal1 thus ?case using Basis_le_norm[OF `i\Basis`, of x] unfolding c_def d_def by(auto simp add:field_simps setsum_negf) qed - have "ball 0 C \ {c..d}" apply safe unfolding mem_interval mem_ball dist_norm + have "ball 0 C \ {c..d}" apply safe unfolding mem_interval mem_ball dist_norm proof case goal1 thus ?case using Basis_le_norm[OF `i\Basis`, of x] unfolding c_def d_def by (auto simp: setsum_negf) qed from C(2)[OF this] have "\y. (f has_integral y) {a..b}" - unfolding has_integral_restrict_closed_subintervals_eq[OF c_d,THEN sym] unfolding s by auto + unfolding has_integral_restrict_closed_subintervals_eq[OF c_d,symmetric] unfolding s by auto then guess y .. note y=this have "y = i" proof(rule ccontr) assume "y\i" hence "0 < norm (y - i)" by auto from as[rule_format,OF this] guess C .. note C=conjunctD2[OF this,rule_format] - def c \ "(\i\Basis. (- max B C) *\<^sub>R i)::'n::ordered_euclidean_space" + def c \ "(\i\Basis. (- max B C) *\<^sub>R i)::'n::ordered_euclidean_space" def d \ "(\i\Basis. max B C *\<^sub>R i)::'n::ordered_euclidean_space" have c_d:"{a..b} \ {c..d}" apply safe apply(drule B(2)) unfolding mem_interval proof case goal1 thus ?case using Basis_le_norm[of i x] unfolding c_def d_def by(auto simp add:field_simps setsum_negf) qed - have "ball 0 C \ {c..d}" apply safe unfolding mem_interval mem_ball dist_norm + have "ball 0 C \ {c..d}" apply safe unfolding mem_interval mem_ball dist_norm proof case goal1 thus ?case using Basis_le_norm[of i x] unfolding c_def d_def by (auto simp: setsum_negf) qed note C(2)[OF this] then guess z .. note z = conjunctD2[OF this, unfolded s] note this[unfolded has_integral_restrict_closed_subintervals_eq[OF c_d]] hence "z = y" "norm (z - i) < norm (y - i)" apply- apply(rule has_integral_unique[OF _ y(1)]) . thus False by auto qed - thus ?l using y unfolding s by auto qed qed + thus ?l using y unfolding s by auto qed qed lemma has_integral_le: fixes f::"'n::ordered_euclidean_space \ real" assumes "(f has_integral i) s" "(g has_integral j) s" "\x\s. (f x) \ (g x)" @@ -4556,12 +5726,12 @@ using has_integral_le[OF assms(1,2)[unfolded has_integral_integral] assms(3)] . lemma has_integral_nonneg: fixes f::"'n::ordered_euclidean_space \ real" - assumes "(f has_integral i) s" "\x\s. 0 \ f x" shows "0 \ i" + assumes "(f has_integral i) s" "\x\s. 0 \ f x" shows "0 \ i" using has_integral_component_nonneg[of 1 f i s] unfolding o_def using assms by auto lemma integral_nonneg: fixes f::"'n::ordered_euclidean_space \ real" - assumes "f integrable_on s" "\x\s. 0 \ f x" shows "0 \ integral s f" + assumes "f integrable_on s" "\x\s. 0 \ f x" shows "0 \ integral s f" using has_integral_nonneg[OF assms(1)[unfolded has_integral_integral] assms(2)] . subsection {* Hence a general restriction property. *} @@ -4574,20 +5744,20 @@ lemma has_integral_restrict_univ: fixes f::"'n::ordered_euclidean_space \ 'a::banach" shows "((\x. if x \ s then f x else 0) has_integral i) UNIV \ (f has_integral i) s" by auto -lemma has_integral_on_superset: fixes f::"'n::ordered_euclidean_space \ 'a::banach" +lemma has_integral_on_superset: fixes f::"'n::ordered_euclidean_space \ 'a::banach" assumes "\x. ~(x \ s) \ f x = 0" "s \ t" "(f has_integral i) s" shows "(f has_integral i) t" proof- have "(\x. if x \ s then f x else 0) = (\x. if x \ t then f x else 0)" apply(rule) using assms(1-2) by auto - thus ?thesis apply- using assms(3) apply(subst has_integral_restrict_univ[THEN sym]) - apply- apply(subst(asm) has_integral_restrict_univ[THEN sym]) by auto qed - -lemma integrable_on_superset: fixes f::"'n::ordered_euclidean_space \ 'a::banach" + thus ?thesis apply- using assms(3) apply(subst has_integral_restrict_univ[symmetric]) + apply- apply(subst(asm) has_integral_restrict_univ[symmetric]) by auto qed + +lemma integrable_on_superset: fixes f::"'n::ordered_euclidean_space \ 'a::banach" assumes "\x. ~(x \ s) \ f x = 0" "s \ t" "f integrable_on s" shows "f integrable_on t" using assms unfolding integrable_on_def by(auto intro:has_integral_on_superset) -lemma integral_restrict_univ[intro]: fixes f::"'n::ordered_euclidean_space \ 'a::banach" +lemma integral_restrict_univ[intro]: fixes f::"'n::ordered_euclidean_space \ 'a::banach" shows "f integrable_on s \ integral UNIV (\x. if x \ s then f x else 0) = integral s f" apply(rule integral_unique) unfolding has_integral_restrict_univ by auto @@ -4600,9 +5770,9 @@ proof safe case goal1 show ?case apply(rule has_integral_negligible[OF `?r`[rule_format,of a b]]) unfolding indicator_def by auto qed qed auto -lemma has_integral_spike_set_eq: fixes f::"'n::ordered_euclidean_space \ 'a::banach" +lemma has_integral_spike_set_eq: fixes f::"'n::ordered_euclidean_space \ 'a::banach" assumes "negligible((s - t) \ (t - s))" shows "((f has_integral y) s \ (f has_integral y) t)" - unfolding has_integral_restrict_univ[THEN sym,of f] apply(rule has_integral_spike_eq[OF assms]) by (auto split: split_if_asm) + unfolding has_integral_restrict_univ[symmetric,of f] apply(rule has_integral_spike_eq[OF assms]) by (auto split: split_if_asm) lemma has_integral_spike_set[dest]: fixes f::"'n::ordered_euclidean_space \ 'a::banach" assumes "negligible((s - t) \ (t - s))" "(f has_integral y) s" @@ -4611,7 +5781,7 @@ lemma integrable_spike_set[dest]: fixes f::"'n::ordered_euclidean_space \ 'a::banach" assumes "negligible((s - t) \ (t - s))" "f integrable_on s" - shows "f integrable_on t" using assms(2) unfolding integrable_on_def + shows "f integrable_on t" using assms(2) unfolding integrable_on_def unfolding has_integral_spike_set_eq[OF assms(1)] . lemma integrable_spike_set_eq: fixes f::"'n::ordered_euclidean_space \ 'a::banach" @@ -4656,7 +5826,7 @@ lemma has_integral_subset_component_le: fixes f::"'n::ordered_euclidean_space \ 'm::ordered_euclidean_space" assumes k: "k\Basis" and as: "s \ t" "(f has_integral i) s" "(f has_integral j) t" "\x\t. 0 \ f(x)\k" shows "i\k \ j\k" -proof- note has_integral_restrict_univ[THEN sym, of f] +proof- note has_integral_restrict_univ[symmetric, of f] note as(2-3)[unfolded this] note * = has_integral_component_le[OF k this] show ?thesis apply(rule *) using as(1,4) by auto qed @@ -4701,12 +5871,12 @@ show "\B>0. \a b. ball 0 B \ {a..b} \ norm (integral {a..b} (\x. if x \ s then f x else 0) - i) < e" proof(rule,rule,rule B,safe) case goal1 from B(2)[OF this] guess z .. note z=conjunctD2[OF this] - from integral_unique[OF this(1)] show ?case using z(2) by auto qed qed qed + from integral_unique[OF this(1)] show ?case using z(2) by auto qed qed qed subsection {* Continuity of the integral (for a 1-dimensional interval). *} -lemma integrable_alt: fixes f::"'n::ordered_euclidean_space \ 'a::banach" shows +lemma integrable_alt: fixes f::"'n::ordered_euclidean_space \ 'a::banach" shows "f integrable_on s \ (\a b. (\x. if x \ s then f x else 0) integrable_on {a..b}) \ (\e>0. \B>0. \a b c d. ball 0 B \ {a..b} \ ball 0 B \ {c..d} @@ -4718,7 +5888,7 @@ show ?case apply(rule,rule,rule B) proof safe case goal1 show ?case apply(rule norm_triangle_half_l) using B(2)[OF goal1(1)] B(2)[OF goal1(2)] by auto qed qed - + next assume ?r note as = conjunctD2[OF this,rule_format] let ?cube = "\n. {(\i\Basis. - real n *\<^sub>R i)::'n .. (\i\Basis. real n *\<^sub>R i)} :: 'n set" have "Cauchy (\n. integral (?cube n) (\x. if x \ s then f x else 0))" @@ -4730,7 +5900,7 @@ proof case goal1 thus ?case using Basis_le_norm[of i x] `i\Basis` using n N by(auto simp add:field_simps setsum_negf) qed } thus ?case apply-apply(rule_tac x=N in exI) apply safe unfolding dist_norm apply(rule B(2)) by auto - qed from this[unfolded convergent_eq_cauchy[THEN sym]] guess i .. + qed from this[unfolded convergent_eq_cauchy[symmetric]] guess i .. note i = this[THEN LIMSEQ_D] show ?l unfolding integrable_on_def has_integral_alt'[of f] apply(rule_tac x=i in exI) @@ -4747,7 +5917,7 @@ apply(rule N[of n]) proof safe show "N \ n" using n by auto fix x::"'n::ordered_euclidean_space" assume x:"x \ ball 0 B" hence "x\ ball 0 ?B" by auto - thus "x\{a..b}" using ab by blast + thus "x\{a..b}" using ab by blast show "x\?cube n" using x unfolding mem_interval mem_ball dist_norm apply- proof case goal1 thus ?case using Basis_le_norm[of i x] `i\Basis` using n by(auto simp add:field_simps setsum_negf) qed qed qed qed qed @@ -4777,31 +5947,31 @@ from obt(2)[unfolded has_integral[of h], rule_format, OF e] guess d2 .. note d2=conjunctD2[OF this,rule_format] show ?case apply(rule_tac x="\x. d1 x \ d2 x" in exI) apply(rule conjI gauge_inter d1 d2)+ unfolding fine_inter proof safe have **:"\i j g1 g2 h1 h2 f1 f2. g1 - h2 \ f1 - f2 \ f1 - f2 \ h1 - g2 \ - abs(i - j) < e / 3 \ abs(g2 - i) < e / 3 \ abs(g1 - i) < e / 3 \ + abs(i - j) < e / 3 \ abs(g2 - i) < e / 3 \ abs(g1 - i) < e / 3 \ abs(h2 - j) < e / 3 \ abs(h1 - j) < e / 3 \ abs(f1 - f2) < e" using `e>0` by arith case goal1 note tagged_division_ofD(2-4) note * = this[OF goal1(1)] this[OF goal1(4)] have "(\(x, k)\p1. content k *\<^sub>R f x) - (\(x, k)\p1. content k *\<^sub>R g x) \ 0" - "0 \ (\(x, k)\p2. content k *\<^sub>R h x) - (\(x, k)\p2. content k *\<^sub>R f x)" + "0 \ (\(x, k)\p2. content k *\<^sub>R h x) - (\(x, k)\p2. content k *\<^sub>R f x)" "(\(x, k)\p2. content k *\<^sub>R f x) - (\(x, k)\p2. content k *\<^sub>R g x) \ 0" - "0 \ (\(x, k)\p1. content k *\<^sub>R h x) - (\(x, k)\p1. content k *\<^sub>R f x)" - unfolding setsum_subtractf[THEN sym] apply- apply(rule_tac[!] setsum_nonneg) - apply safe unfolding real_scaleR_def right_diff_distrib[THEN sym] + "0 \ (\(x, k)\p1. content k *\<^sub>R h x) - (\(x, k)\p1. content k *\<^sub>R f x)" + unfolding setsum_subtractf[symmetric] apply- apply(rule_tac[!] setsum_nonneg) + apply safe unfolding real_scaleR_def right_diff_distrib[symmetric] apply(rule_tac[!] mult_nonneg_nonneg) proof- fix a b assume ab:"(a,b) \ p1" show "0 \ content b" using *(3)[OF ab] apply safe using content_pos_le . thus "0 \ content b" . show "0 \ f a - g a" "0 \ h a - f a" using *(1-2)[OF ab] using obt(4)[rule_format,of a] by auto next fix a b assume ab:"(a,b) \ p2" show "0 \ content b" using *(6)[OF ab] apply safe using content_pos_le . thus "0 \ content b" . - show "0 \ f a - g a" "0 \ h a - f a" using *(4-5)[OF ab] using obt(4)[rule_format,of a] by auto qed + show "0 \ f a - g a" "0 \ h a - f a" using *(4-5)[OF ab] using obt(4)[rule_format,of a] by auto qed thus ?case apply- unfolding real_norm_def apply(rule **) defer defer - unfolding real_norm_def[THEN sym] apply(rule obt(3)) + unfolding real_norm_def[symmetric] apply(rule obt(3)) apply(rule d1(2)[OF conjI[OF goal1(4,5)]]) apply(rule d1(2)[OF conjI[OF goal1(1,2)]]) apply(rule d2(2)[OF conjI[OF goal1(4,6)]]) - apply(rule d2(2)[OF conjI[OF goal1(1,3)]]) by auto qed qed - + apply(rule d2(2)[OF conjI[OF goal1(1,3)]]) by auto qed qed + lemma integrable_straddle: fixes f::"'n::ordered_euclidean_space \ real" assumes "\e>0. \g h i j. (g has_integral i) s \ (h has_integral j) s \ norm(i - j) < e \ (\x\s. (g x) \(f x) \(f x) \(h x))" @@ -4822,7 +5992,7 @@ case goal2 thus ?case using Basis_le_norm[of i x] unfolding c_def d_def by auto qed have **:"\ch cg ag ah::real. norm(ah - ag) \ norm(ch - cg) \ norm(cg - i) < e / 4 \ norm(ch - j) < e / 4 \ norm(ag - ah) < e" - using obt(3) unfolding real_norm_def by arith + using obt(3) unfolding real_norm_def by arith show ?case apply(rule_tac x="\x. if x \ s then g x else 0" in exI) apply(rule_tac x="\x. if x \ s then h x else 0" in exI) apply(rule_tac x="integral {a..b} (\x. if x \ s then g x else 0)" in exI) @@ -4836,7 +6006,7 @@ integral {a..b} (\x. if x \ s then g x else 0)) \ norm (integral {c..d} (\x. if x \ s then h x else 0) - integral {c..d} (\x. if x \ s then g x else 0))" - unfolding integral_sub[OF h g,THEN sym] real_norm_def apply(subst **) defer apply(subst **) defer + unfolding integral_sub[OF h g,symmetric] real_norm_def apply(subst **) defer apply(subst **) defer apply(rule has_integral_subset_le) defer apply(rule integrable_integral integrable_sub h g)+ proof safe fix x assume "x\{a..b}" thus "x\{c..d}" unfolding mem_interval c_def d_def apply - apply rule apply(erule_tac x=i in ballE) by auto @@ -4856,30 +6026,30 @@ abs(hc - j) < e / 3 \ abs(i - j) < e / 3 \ ga \ fa \ fa \ ha \ gc \ fc \ fc \ hc\ abs(fa - fc) < e" by (simp add: abs_real_def split: split_if_asm) show "norm (integral {a..b} (\x. if x \ s then f x else 0) - integral {c..d} (\x. if x \ s then f x else 0)) < e" - unfolding real_norm_def apply(rule *, safe) unfolding real_norm_def[THEN sym] - apply(rule B1(2),rule order_trans,rule **,rule as(1)) - apply(rule B1(2),rule order_trans,rule **,rule as(2)) - apply(rule B2(2),rule order_trans,rule **,rule as(1)) - apply(rule B2(2),rule order_trans,rule **,rule as(2)) + unfolding real_norm_def apply(rule *, safe) unfolding real_norm_def[symmetric] + apply(rule B1(2),rule order_trans,rule **,rule as(1)) + apply(rule B1(2),rule order_trans,rule **,rule as(2)) + apply(rule B2(2),rule order_trans,rule **,rule as(1)) + apply(rule B2(2),rule order_trans,rule **,rule as(2)) apply(rule obt) apply(rule_tac[!] integral_le) using obt - by(auto intro!: h g interv) qed qed qed + by(auto intro!: h g interv) qed qed qed subsection {* Adding integrals over several sets. *} lemma has_integral_union: fixes f::"'n::ordered_euclidean_space \ 'a::banach" assumes "(f has_integral i) s" "(f has_integral j) t" "negligible(s \ t)" shows "(f has_integral (i + j)) (s \ t)" -proof- note * = has_integral_restrict_univ[THEN sym, of f] +proof- note * = has_integral_restrict_univ[symmetric, of f] show ?thesis unfolding * apply(rule has_integral_spike[OF assms(3)]) defer apply(rule has_integral_add[OF assms(1-2)[unfolded *]]) by auto qed lemma has_integral_unions: fixes f::"'n::ordered_euclidean_space \ 'a::banach" assumes "finite t" "\s\t. (f has_integral (i s)) s" "\s\t. \s'\t. ~(s = s') \ negligible(s \ s')" shows "(f has_integral (setsum i t)) (\t)" -proof- note * = has_integral_restrict_univ[THEN sym, of f] +proof- note * = has_integral_restrict_univ[symmetric, of f] have **:"negligible (\((\(a,b). a \ b) ` {(a,b). a \ t \ b \ {y. y \ t \ ~(a = y)}}))" - apply(rule negligible_unions) apply(rule finite_imageI) apply(rule finite_subset[of _ "t \ t"]) defer - apply(rule finite_cartesian_product[OF assms(1,1)]) using assms(3) by auto + apply(rule negligible_unions) apply(rule finite_imageI) apply(rule finite_subset[of _ "t \ t"]) defer + apply(rule finite_cartesian_product[OF assms(1,1)]) using assms(3) by auto note assms(2)[unfolded *] note has_integral_setsum[OF assms(1) this] thus ?thesis unfolding * apply-apply(rule has_integral_spike[OF **]) defer apply assumption proof safe case goal1 thus ?case @@ -4895,7 +6065,7 @@ assumes "d division_of s" "\k\d. (f has_integral (i k)) k" shows "(f has_integral (setsum i d)) s" proof- note d = division_ofD[OF assms(1)] - show ?thesis unfolding d(6)[THEN sym] apply(rule has_integral_unions) + show ?thesis unfolding d(6)[symmetric] apply(rule has_integral_unions) apply(rule d assms)+ apply(rule,rule,rule) proof- case goal1 from d(4)[OF this(1)] d(4)[OF this(2)] guess a c b d apply-by(erule exE)+ note obt=this @@ -4913,7 +6083,7 @@ assumes "f integrable_on s" "d division_of k" "k \ s" shows "(f has_integral (setsum (\i. integral i f) d)) k" apply(rule has_integral_combine_division[OF assms(2)]) - apply safe unfolding has_integral_integral[THEN sym] + apply safe unfolding has_integral_integral[symmetric] proof- case goal1 from division_ofD(2,4)[OF assms(2) this] show ?case apply safe apply(rule integrable_on_subinterval) apply(rule assms) using assms(3) by auto qed @@ -4944,7 +6114,7 @@ shows "(f has_integral (setsum (\(x,k). i k) p)) s" proof- have *:"(f has_integral (setsum (\k. integral k f) (snd ` p))) s" apply(rule has_integral_combine_division) apply(rule division_of_tagged_division[OF assms(1)]) - using assms(2) unfolding has_integral_integral[THEN sym] by(safe,auto) + using assms(2) unfolding has_integral_integral[symmetric] by(safe,auto) thus ?thesis apply- apply(rule subst[where P="\i. (f has_integral i) s"]) defer apply assumption apply(rule trans[of _ "setsum (\(x,k). integral k f) p"]) apply(subst eq_commute) apply(rule setsum_over_tagged_division_lemma[OF assms(1)]) apply(rule integral_null,assumption) @@ -4998,22 +6168,22 @@ let ?p = "p \ \(qq ` r)" have "norm ((\(x, k)\?p. content k *\<^sub>R f x) - integral {a..b} f) < e" apply(rule assms(4)[rule_format]) - proof show "d fine ?p" apply(rule fine_union,rule p) apply(rule fine_unions) using qq by auto + proof show "d fine ?p" apply(rule fine_union,rule p) apply(rule fine_unions) using qq by auto note * = tagged_partial_division_of_union_self[OF p(1)] have "p \ \(qq ` r) tagged_division_of \(snd ` p) \ \r" proof(rule tagged_division_union[OF * tagged_division_unions]) show "finite r" by fact case goal2 thus ?case using qq by auto next case goal3 thus ?case apply(rule,rule,rule) apply(rule q'(5)) unfolding r_def by auto next case goal4 thus ?case apply(rule inter_interior_unions_intervals) apply(fact,rule) - apply(rule,rule q') defer apply(rule,subst Int_commute) + apply(rule,rule q') defer apply(rule,subst Int_commute) apply(rule inter_interior_unions_intervals) apply(rule finite_imageI,rule p',rule) defer apply(rule,rule q') using q(1) p' unfolding r_def by auto qed moreover have "\(snd ` p) \ \r = {a..b}" "{qq i |i. i \ r} = qq ` r" - unfolding Union_Un_distrib[THEN sym] r_def using q by auto + unfolding Union_Un_distrib[symmetric] r_def using q by auto ultimately show "?p tagged_division_of {a..b}" by fastforce qed hence "norm ((\(x, k)\p. content k *\<^sub>R f x) + (\(x, k)\\(qq ` r). content k *\<^sub>R f x) - - integral {a..b} f) < e" apply(subst setsum_Un_zero[THEN sym]) apply(rule p') prefer 3 + integral {a..b} f) < e" apply(subst setsum_Un_zero[symmetric]) apply(rule p') prefer 3 apply assumption apply rule apply(rule finite_imageI,rule r) apply safe apply(drule qq) proof- fix x l k assume as:"(x,l)\p" "(x,l)\qq k" "k\r" note qq[OF this(3)] note tagged_division_ofD(3,4)[OF conjunct1[OF this] as(2)] @@ -5021,7 +6191,7 @@ have "l\snd ` p" unfolding image_iff apply(rule_tac x="(x,l)" in bexI) using as by auto hence "l\q" "k\q" "l\k" using as(1,3) q(1) unfolding r_def by auto note q'(5)[OF this] hence "interior l = {}" using interior_mono[OF `l \ k`] by blast - thus "content l *\<^sub>R f x = 0" unfolding uv content_eq_0_interior[THEN sym] by auto qed auto + thus "content l *\<^sub>R f x = 0" unfolding uv content_eq_0_interior[symmetric] by auto qed auto hence "norm ((\(x, k)\p. content k *\<^sub>R f x) + setsum (setsum (\(x, k). content k *\<^sub>R f x)) (qq ` r) - integral {a..b} f) < e" apply(subst(asm) setsum_UNION_zero) @@ -5032,23 +6202,23 @@ from this(2)[OF as(4,1)] guess u v apply-by(erule exE)+ note uv=this have *:"interior (k \ l) = {}" unfolding interior_inter apply(rule q') using as unfolding r_def by auto - have "interior m = {}" unfolding subset_empty[THEN sym] unfolding *[THEN sym] + have "interior m = {}" unfolding subset_empty[symmetric] unfolding *[symmetric] apply(rule interior_mono) using kl(1)[OF as(4,1)] kl(1)[OF as(5,2)] by auto - thus "content m *\<^sub>R f x = 0" unfolding uv content_eq_0_interior[THEN sym] by auto + thus "content m *\<^sub>R f x = 0" unfolding uv content_eq_0_interior[symmetric] by auto qed(insert qq, auto) hence **:"norm ((\(x, k)\p. content k *\<^sub>R f x) + setsum (setsum (\(x, k). content k *\<^sub>R f x) \ qq) r - integral {a..b} f) < e" apply(subst(asm) setsum_reindex_nonzero) apply fact apply(rule setsum_0',rule) unfolding split_paired_all split_conv defer apply assumption proof- fix k l x m assume as:"k\r" "l\r" "k\l" "qq k = qq l" "(x,m)\qq k" - note tagged_division_ofD(6)[OF qq[THEN conjunct1]] from this[OF as(1)] this[OF as(2)] + note tagged_division_ofD(6)[OF qq[THEN conjunct1]] from this[OF as(1)] this[OF as(2)] show "content m *\<^sub>R f x = 0" using as(3) unfolding as by auto qed - - have *:"\ir ip i cr cp. norm((cp + cr) - i) < e \ norm(cr - ir) < k \ - ip + ir = i \ norm(cp - ip) \ e + k" - proof- case goal1 thus ?case using norm_triangle_le[of "cp + cr - i" "- (cr - ir)"] - unfolding goal1(3)[THEN sym] norm_minus_cancel by(auto simp add:algebra_simps) qed - + + have *:"\ir ip i cr cp. norm((cp + cr) - i) < e \ norm(cr - ir) < k \ + ip + ir = i \ norm(cp - ip) \ e + k" + proof- case goal1 thus ?case using norm_triangle_le[of "cp + cr - i" "- (cr - ir)"] + unfolding goal1(3)[symmetric] norm_minus_cancel by(auto simp add:algebra_simps) qed + have "?x = norm ((\(x, k)\p. content k *\<^sub>R f x) - (\(x, k)\p. integral k f))" unfolding split_def setsum_subtractf .. also have "... \ e + k" apply(rule *[OF **, where ir="setsum (\k. integral k f) r"]) @@ -5059,15 +6229,15 @@ from p'(4)[OF as(1)] guess u v apply-by(erule exE)+ note uv=this show "integral l f = 0" unfolding uv apply(rule integral_unique) apply(rule has_integral_null) unfolding content_eq_0_interior - using p'(5)[OF as(1-3)] unfolding uv as(4)[THEN sym] by auto - qed auto + using p'(5)[OF as(1-3)] unfolding uv as(4)[symmetric] by auto + qed auto show ?case unfolding integral_combine_division_topdown[OF assms(1) q(2)] * r_def - apply(rule setsum_Un_disjoint'[THEN sym]) using q(1) q'(1) p'(1) by auto + apply(rule setsum_Un_disjoint'[symmetric]) using q(1) q'(1) p'(1) by auto next case goal1 have *:"k * real (card r) / (1 + real (card r)) < k" using k by(auto simp add:field_simps) show ?case apply(rule le_less_trans[of _ "setsum (\x. k / (real (card r) + 1)) r"]) - unfolding setsum_subtractf[THEN sym] apply(rule setsum_norm_le) - apply rule apply(drule qq) defer unfolding divide_inverse setsum_left_distrib[THEN sym] - unfolding divide_inverse[THEN sym] using * by(auto simp add:field_simps real_eq_of_nat) + unfolding setsum_subtractf[symmetric] apply(rule setsum_norm_le) + apply rule apply(drule qq) defer unfolding divide_inverse setsum_left_distrib[symmetric] + unfolding divide_inverse[symmetric] using * by(auto simp add:field_simps real_eq_of_nat) qed finally show "?x \ e + k" . qed lemma henstock_lemma_part2: fixes f::"'m::ordered_euclidean_space \ 'n::ordered_euclidean_space" @@ -5075,12 +6245,12 @@ "\p. p tagged_division_of {a..b} \ d fine p \ norm (setsum (\(x,k). content k *\<^sub>R f x) p - integral({a..b}) f) < e" "p tagged_partial_division_of {a..b}" "d fine p" shows "setsum (\(x,k). norm(content k *\<^sub>R f x - integral k f)) p \ 2 * real (DIM('n)) * e" - unfolding split_def apply(rule setsum_norm_allsubsets_bound) defer + unfolding split_def apply(rule setsum_norm_allsubsets_bound) defer apply(rule henstock_lemma_part1[unfolded split_def,OF assms(1-3)]) apply safe apply(rule assms[rule_format,unfolded split_def]) defer apply(rule tagged_partial_division_subset,rule assms,assumption) apply(rule fine_subset,assumption,rule assms) using assms(5) by auto - + lemma henstock_lemma: fixes f::"'m::ordered_euclidean_space \ 'n::ordered_euclidean_space" assumes "f integrable_on {a..b}" "e>0" obtains d where "gauge d" @@ -5201,7 +6371,7 @@ unfolding dist_real_def using fg[rule_format,OF goal1] by (auto simp add:field_simps) qed from bchoice[OF this] guess m .. note m=conjunctD2[OF this[rule_format],rule_format] - def d \ "\x. c (m x) x" + def d \ "\x. c (m x) x" show ?case apply(rule_tac x=d in exI) proof safe show "gauge d" using c(1) unfolding gauge_def d_def by auto @@ -5211,7 +6381,7 @@ by (metis finite_imageI finite_nat_set_iff_bounded_le p'(1) rev_image_eqI) then guess s .. note s=this have *:"\a b c d. norm(a - b) \ e / 4 \ norm(b - c) < e / 2 \ - norm(c - d) < e / 4 \ norm(a - d) < e" + norm(c - d) < e / 4 \ norm(a - d) < e" proof safe case goal1 thus ?case using norm_triangle_lt[of "a - b" "b - c" "3* e/4"] norm_triangle_lt[of "a - b + (b - c)" "c - d" e] unfolding norm_minus_cancel by(auto simp add:algebra_simps) qed @@ -5219,17 +6389,17 @@ b="\(x, k)\p. content k *\<^sub>R f (m x) x" and c="\(x, k)\p. integral k (f (m x))"]) proof safe case goal1 show ?case apply(rule order_trans[of _ "\(x, k)\p. content k * (e / (4 * content {a..b}))"]) - unfolding setsum_subtractf[THEN sym] apply(rule order_trans,rule norm_setsum) + unfolding setsum_subtractf[symmetric] apply(rule order_trans,rule norm_setsum) apply(rule setsum_mono) unfolding split_paired_all split_conv - unfolding split_def setsum_left_distrib[THEN sym] scaleR_diff_right[THEN sym] + unfolding split_def setsum_left_distrib[symmetric] scaleR_diff_right[symmetric] unfolding additive_content_tagged_division[OF p(1), unfolded split_def] proof- fix x k assume xk:"(x,k) \ p" hence x:"x\{a..b}" using p'(2-3)[OF xk] by auto from p'(4)[OF xk] guess u v apply-by(erule exE)+ note uv=this show " norm (content k *\<^sub>R (g x - f (m x) x)) \ content k * (e / (4 * content {a..b}))" - unfolding norm_scaleR uv unfolding abs_of_nonneg[OF content_pos_le] + unfolding norm_scaleR uv unfolding abs_of_nonneg[OF content_pos_le] apply(rule mult_left_mono) using m(2)[OF x,of "m x"] by auto qed(insert ab,auto) - + next case goal2 show ?case apply(rule le_less_trans[of _ "norm (\j = 0..s. \(x, k)\{xk\p. m (fst xk) = j}. content k *\<^sub>R f (m x) x - integral k (f (m x)))"]) apply(subst setsum_group) apply fact apply(rule finite_atLeastAtMost) defer @@ -5240,7 +6410,7 @@ apply(rule setsum_norm_le) proof show "(\i = 0..s. e / 2 ^ (i + 2)) < e / 2" unfolding power_add divide_inverse inverse_mult_distrib - unfolding setsum_right_distrib[THEN sym] setsum_left_distrib[THEN sym] + unfolding setsum_right_distrib[symmetric] setsum_left_distrib[symmetric] unfolding power_inverse sum_gp apply(rule mult_strict_left_mono[OF _ e]) unfolding power2_eq_square by auto fix t assume "t\{0..s}" @@ -5259,22 +6429,22 @@ next case goal3 note comb = integral_combine_tagged_division_topdown[OF assms(1)[rule_format] p(1)] have *:"\sr sx ss ks kr::real. kr = sr \ ks = ss \ ks \ i \ sr \ sx \ sx \ ss \ 0 \ i\1 - kr\1 - \ i\1 - kr\1 < e/4 \ abs(sx - i) < e/4" by auto + \ i\1 - kr\1 < e/4 \ abs(sx - i) < e/4" by auto show ?case unfolding real_norm_def apply(rule *[rule_format],safe) - apply(rule comb[of r],rule comb[of s]) apply(rule i'[unfolded real_inner_1_right]) + apply(rule comb[of r],rule comb[of s]) apply(rule i'[unfolded real_inner_1_right]) apply(rule_tac[1-2] setsum_mono) unfolding split_paired_all split_conv apply(rule_tac[1-2] integral_le[OF ]) proof safe show "0 \ i\1 - (integral {a..b} (f r))\1" using r(1) by auto show "i\1 - (integral {a..b} (f r))\1 < e / 4" using r(2) by auto fix x k assume xk:"(x,k)\p" from p'(4)[OF this] guess u v apply-by(erule exE)+ note uv=this - show "f r integrable_on k" "f s integrable_on k" "f (m x) integrable_on k" "f (m x) integrable_on k" + show "f r integrable_on k" "f s integrable_on k" "f (m x) integrable_on k" "f (m x) integrable_on k" unfolding uv apply(rule_tac[!] integrable_on_subinterval[OF assms(1)[rule_format]]) - using p'(3)[OF xk] unfolding uv by auto + using p'(3)[OF xk] unfolding uv by auto fix y assume "y\k" hence "y\{a..b}" using p'(3)[OF xk] by auto hence *:"\m. \n\m. (f m y) \ (f n y)" apply-apply(rule transitive_stepwise_le) using assms(2) by auto show "(f r y) \ (f (m x) y)" "(f (m x) y) \ (f s y)" apply(rule_tac[!] *[rule_format]) using s[rule_format,OF xk] m(1)[of x] p'(2-3)[OF xk] by auto - qed qed qed qed note * = this + qed qed qed qed note * = this have "integral {a..b} g = i" apply(rule integral_unique) using * . thus ?thesis using i * by auto qed @@ -5300,13 +6470,13 @@ apply(rule i,rule trivial_limit_sequentially) unfolding eventually_sequentially apply(rule_tac x=k in exI,safe) apply(rule integral_component_le) apply simp - apply(rule goal1(2)[rule_format])+ by auto + apply(rule goal1(2)[rule_format])+ by auto note int = assms(2)[unfolded integrable_alt[of _ s],THEN conjunct1,rule_format] have ifif:"\k t. (\x. if x \ t then if x \ s then f k x else 0 else 0) = (\x. if x \ t\s then f k x else 0)" apply(rule ext) by auto - have int':"\k a b. f k integrable_on {a..b} \ s" apply(subst integrable_restrict_univ[THEN sym]) - apply(subst ifif[THEN sym]) apply(subst integrable_restrict_univ) using int . + have int':"\k a b. f k integrable_on {a..b} \ s" apply(subst integrable_restrict_univ[symmetric]) + apply(subst ifif[symmetric]) apply(subst integrable_restrict_univ) using int . have "\a b. (\x. if x \ s then g x else 0) integrable_on {a..b} \ ((\k. integral {a..b} (\x. if x \ s then f k x else 0)) ---> integral {a..b} (\x. if x \ s then g x else 0)) sequentially" @@ -5320,7 +6490,7 @@ unfolding real_norm_def apply(subst abs_of_nonneg) apply(rule *[OF int]) apply(safe,case_tac "x\s") apply(drule assms(1)) prefer 3 apply(subst abs_of_nonneg) apply(rule *[OF assms(2) goal1(1)[THEN spec]]) - apply(subst integral_restrict_univ[THEN sym,OF int]) + apply(subst integral_restrict_univ[symmetric,OF int]) unfolding ifif unfolding integral_restrict_univ[OF int'] apply(rule integral_subset_le[OF _ int' assms(2)]) using assms(1) by auto thus ?case using assms(5) unfolding bounded_iff apply safe @@ -5341,7 +6511,7 @@ apply-defer apply(subst norm_minus_commute) by auto have *:"\f1 f2 g. abs(f1 - i) < e / 2 \ abs(f2 - g) < e / 2 \ f1 \ f2 \ f2 \ i \ abs(g - i) < e" unfolding real_inner_1_right by arith - show "norm (integral {a..b} (\x. if x \ s then g x else 0) - i) < e" + show "norm (integral {a..b} (\x. if x \ s then g x else 0) - i) < e" unfolding real_norm_def apply(rule *[rule_format]) apply(rule **[unfolded real_norm_def]) apply(rule M[rule_format,of "M + N",unfolded real_norm_def]) apply(rule le_add1) @@ -5349,10 +6519,10 @@ apply(rule order_trans[OF _ i'[rule_format,of "M + N",unfolded real_inner_1_right]]) proof safe case goal2 have "\m. x\s \ \n\m. (f m x)\1 \ (f n x)\1" apply(rule transitive_stepwise_le) using assms(3) by auto thus ?case by auto - next case goal1 show ?case apply(subst integral_restrict_univ[THEN sym,OF int]) + next case goal1 show ?case apply(subst integral_restrict_univ[symmetric,OF int]) unfolding ifif integral_restrict_univ[OF int'] apply(rule integral_subset_le[OF _ int']) using assms by auto - qed qed qed + qed qed qed thus ?case apply safe defer apply(drule integral_unique) using i by auto qed have sub:"\k. integral s (\x. f k x - f 0 x) = integral s (f k) - integral s (f 0)" @@ -5364,7 +6534,7 @@ proof- case goal1 thus ?case using *[of x 0 "Suc k"] by auto next case goal2 thus ?case apply(rule integrable_sub) using assms(1) by auto next case goal3 thus ?case using *[of x "Suc k" "Suc (Suc k)"] by auto - next case goal4 thus ?case apply-apply(rule tendsto_diff) + next case goal4 thus ?case apply-apply(rule tendsto_diff) using seq_offset[OF assms(3)[rule_format],of x 1] by auto next case goal5 thus ?case using assms(4) unfolding bounded_iff apply safe apply(rule_tac x="a + norm (integral s (\x. f 0 x))" in exI) @@ -5390,7 +6560,7 @@ note * = conjunctD2[OF this] show ?thesis apply rule using integrable_neg[OF *(1)] defer using tendsto_minus[OF *(2)] apply- unfolding integral_neg[OF assm(1)] - unfolding integral_neg[OF *(1),THEN sym] by auto qed + unfolding integral_neg[OF *(1),symmetric] by auto qed subsection {* absolute integrability (this is the same as Lebesgue integrability). *} @@ -5415,9 +6585,9 @@ proof- have *:"\x y. (\e::real. 0 < e \ x < y + e) \ x \ y" apply(safe,rule ccontr) apply(erule_tac x="x - y" in allE) by auto have "\e sg dsa dia ig. norm(sg) \ dsa \ abs(dsa - dia) < e / 2 \ norm(sg - ig) < e / 2 - \ norm(ig) < dia + e" + \ norm(ig) < dia + e" proof safe case goal1 show ?case apply(rule le_less_trans[OF norm_triangle_sub[of ig sg]]) - apply(subst real_sum_of_halves[of e,THEN sym]) unfolding add_assoc[symmetric] + apply(subst real_sum_of_halves[of e,symmetric]) unfolding add_assoc[symmetric] apply(rule add_le_less_mono) defer apply(subst norm_minus_commute,rule goal1) apply(rule order_trans[OF goal1(1)]) using goal1(2) by arith qed note norm=this[rule_format] @@ -5440,7 +6610,7 @@ apply(rule mult_left_mono) using goal1(3) as by auto qed(insert p[unfolded fine_inter],auto) qed - { presume "\e. 0 < e \ norm (integral s f) < integral s g + e" + { presume "\e. 0 < e \ norm (integral s f) < integral s g + e" thus ?thesis apply-apply(rule *[rule_format]) by auto } fix e::real assume "e>0" hence e:"e/2 > 0" by auto note assms(1)[unfolded integrable_alt[of f]] note f=this[THEN conjunct1,rule_format] @@ -5505,7 +6675,7 @@ apply(drule absolutely_integrable_norm) unfolding real_norm_def . lemma absolutely_integrable_on_subinterval: fixes f::"'n::ordered_euclidean_space \ 'a::banach" shows - "f absolutely_integrable_on s \ {a..b} \ s \ f absolutely_integrable_on {a..b}" + "f absolutely_integrable_on s \ {a..b} \ s \ f absolutely_integrable_on {a..b}" unfolding absolutely_integrable_on_def by(meson integrable_on_subinterval) lemma absolutely_integrable_bounded_variation: fixes f::"'n::ordered_euclidean_space \ 'a::banach" @@ -5520,14 +6690,14 @@ apply(subst integral_combine_division_topdown[OF _ goal1(2)]) using integrable_on_subdivision[OF goal1(2)] using assms by auto also have "... \ integral UNIV (\x. norm (f x))" - apply(rule integral_subset_le) + apply(rule integral_subset_le) using integrable_on_subdivision[OF goal1(2)] using assms by auto finally show ?case . qed lemma helplemma: assumes "setsum (\x. norm(f x - g x)) s < e" "finite s" shows "abs(setsum (\x. norm(f x)) s - setsum (\x. norm(g x)) s) < e" - unfolding setsum_subtractf[THEN sym] apply(rule le_less_trans[OF setsum_abs]) + unfolding setsum_subtractf[symmetric] apply(rule le_less_trans[OF setsum_abs]) apply(rule le_less_trans[OF _ assms(1)]) apply(rule setsum_mono) using norm_triangle_ineq3 . @@ -5542,7 +6712,7 @@ show ?thesis apply(rule,rule assms) apply rule apply(subst has_integral[of _ i]) proof safe case goal1 hence "i - e / 2 \ Collect (isUb UNIV (setsum (\k. norm (integral k f)) ` {d. d division_of {a..b}}))" using isLub_ubs[OF i,rule_format] - unfolding setge_def ubs_def by auto + unfolding setge_def ubs_def by auto hence " \y. y division_of {a..b} \ i - e / 2 < (\k\y. norm (integral k f))" unfolding mem_Collect_eq isUb_def setle_def by(simp add:not_le) then guess d .. note d=conjunctD2[OF this] note d' = division_ofD[OF this(1)] @@ -5567,7 +6737,7 @@ have gp':"g fine p'" using p(2) unfolding p'_def fine_def by auto have p'':"p' tagged_division_of {a..b}" apply(rule tagged_division_ofI) proof- show "finite p'" apply(rule finite_subset[of _ "(\(k,(x,l)). (x,k \ l)) - ` {(k,xl) | k xl. k \ d \ xl \ p}"]) unfolding p'_def + ` {(k,xl) | k xl. k \ d \ xl \ p}"]) unfolding p'_def defer apply(rule finite_imageI,rule finite_product_dependent[OF d'(1) p'(1)]) apply safe unfolding image_iff apply(rule_tac x="(i,x,l)" in bexI) by auto fix x k assume "(x,k)\p'" @@ -5590,15 +6760,15 @@ show "\{k. \x. (x, k) \ p'} = {a..b}" apply rule apply(rule Union_least) unfolding mem_Collect_eq apply(erule exE) apply(drule *[rule_format]) apply safe proof- fix y assume y:"y\{a..b}" - hence "\x l. (x, l) \ p \ y\l" unfolding p'(6)[THEN sym] by auto + hence "\x l. (x, l) \ p \ y\l" unfolding p'(6)[symmetric] by auto then guess x l apply-by(erule exE)+ note xl=conjunctD2[OF this] - hence "\k. k\d \ y\k" using y unfolding d'(6)[THEN sym] by auto + hence "\k. k\d \ y\k" using y unfolding d'(6)[symmetric] by auto then guess i .. note i = conjunctD2[OF this] have "x\i" using fineD[OF p(3) xl(1)] using k(2)[OF i(1), of x] using i(2) xl(2) by auto thus "y\\{k. \x. (x, k) \ p'}" unfolding p'_def Union_iff apply(rule_tac x="i \ l" in bexI) defer unfolding mem_Collect_eq apply(rule_tac x=x in exI)+ apply(rule_tac x="i\l" in exI) - apply safe apply(rule_tac x=i in exI) apply(rule_tac x=l in exI) using i xl by auto - qed qed + apply safe apply(rule_tac x=i in exI) apply(rule_tac x=l in exI) using i xl by auto + qed qed hence "(\(x, k)\p'. norm (content k *\<^sub>R f x - integral k f)) < e / 2" apply-apply(rule g(2)[rule_format]) unfolding tagged_division_of_def apply safe using gp' . @@ -5625,7 +6795,7 @@ have *:"\sni sni' sf sf'. abs(sf' - sni') < e / 2 \ i - e / 2 < sni \ sni' \ i \ sni \ sni' \ sf' = sf \ abs(sf - i) < e" by arith - show "norm ((\(x, k)\p. content k *\<^sub>R norm (f x)) - i) < e" + show "norm ((\(x, k)\p. content k *\<^sub>R norm (f x)) - i) < e" unfolding real_norm_def apply(rule *[rule_format,OF **],safe) apply(rule d(2)) proof- case goal1 show ?case unfolding sum_p' apply(rule isLubD2[OF i]) using division_of_tagged_division[OF p''] by auto @@ -5635,7 +6805,7 @@ proof(rule setsum_mono) case goal1 note k=this from d'(4)[OF this] guess u v apply-by(erule exE)+ note uv=this def d' \ "{{u..v} \ l |l. l \ snd ` p \ ~({u..v} \ l = {})}" note uvab = d'(2)[OF k[unfolded uv]] - have "d' division_of {u..v}" apply(subst d'_def) apply(rule division_inter_1) + have "d' division_of {u..v}" apply(subst d'_def) apply(rule division_inter_1) apply(rule division_of_tagged_division[OF p(1)]) using uvab . hence "norm (integral k f) \ setsum (\k. norm (integral k f)) d'" unfolding uv apply(subst integral_combine_division_topdown[of _ _ d']) @@ -5653,18 +6823,18 @@ apply(rule Int_greatest) defer apply(subst goal1(4)) by auto hence *:"interior (k \ l) = {}" using snd_p(5)[OF goal1(1-3)] by auto from d'(4)[OF k] snd_p(4)[OF goal1(1)] guess u1 v1 u2 v2 apply-by(erule exE)+ note uv=this - show ?case using * unfolding uv inter_interval content_eq_0_interior[THEN sym] by auto + show ?case using * unfolding uv inter_interval content_eq_0_interior[symmetric] by auto qed finally show ?case . qed also have "... = (\(i,l)\{(i, l) |i l. i \ d \ l \ snd ` p}. norm (integral (i\l) f))" - apply(subst sum_sum_product[THEN sym],fact) using p'(1) by auto + apply(subst sum_sum_product[symmetric],fact) using p'(1) by auto also have "... = (\x\{(i, l) |i l. i \ d \ l \ snd ` p}. norm (integral (split op \ x) f))" unfolding split_def .. also have "... = (\k\{i \ l |i l. i \ d \ l \ snd ` p}. norm (integral k f))" - unfolding * apply(rule setsum_reindex_nonzero[THEN sym,unfolded o_def]) + unfolding * apply(rule setsum_reindex_nonzero[symmetric,unfolded o_def]) apply(rule finite_product_dependent) apply(fact,rule finite_imageI,rule p') unfolding split_paired_all mem_Collect_eq split_conv o_def proof- note * = division_ofD(4,5)[OF division_of_tagged_division,OF p(1)] - fix l1 l2 k1 k2 assume as:"(l1, k1) \ (l2, k2)" "l1 \ k1 = l2 \ k2" + fix l1 l2 k1 k2 assume as:"(l1, k1) \ (l2, k2)" "l1 \ k1 = l2 \ k2" "\i l. (l1, k1) = (i, l) \ i \ d \ l \ snd ` p" "\i l. (l2, k2) = (i, l) \ i \ d \ l \ snd ` p" hence "l1 \ d" "k1 \ snd ` p" by auto from d'(4)[OF this(1)] *(1)[OF this(2)] @@ -5676,7 +6846,7 @@ moreover have "interior(l1 \ k1) = interior(l2 \ k2)" using as(2) by auto ultimately have "interior(l1 \ k1) = {}" by auto thus "norm (integral (l1 \ k1) f) = 0" unfolding uv inter_interval - unfolding content_eq_0_interior[THEN sym] by auto + unfolding content_eq_0_interior[symmetric] by auto qed also have "... = (\(x, k)\p'. norm (integral k f))" unfolding sum_p' apply(rule setsum_mono_zero_right) apply(subst *) apply(rule finite_imageI[OF finite_product_dependent]) apply fact @@ -5684,7 +6854,7 @@ proof- case goal2 have "ia \ b = {}" using goal2 unfolding p'alt image_iff Bex_def not_ex apply(erule_tac x="(a,ia\b)" in allE) by auto thus ?case by auto next case goal1 thus ?case unfolding p'_def apply safe - apply(rule_tac x=i in exI,rule_tac x=l in exI) unfolding snd_conv image_iff + apply(rule_tac x=i in exI,rule_tac x=l in exI) unfolding snd_conv image_iff apply safe apply(rule_tac x="(a,l)" in bexI) by auto qed finally show ?case . @@ -5705,15 +6875,15 @@ "x1 = x2" "l1 \ k1 = l2 \ k2" "\ ((x1 = x2 \ l1 = l2) \ k1 = k2)" from d'(4)[OF as(3)] p'(4)[OF as(1)] guess u1 v1 u2 v2 apply-by(erule exE)+ note uv=this from as have "l1 \ l2 \ k1 \ k2" by auto - hence "(interior(k1) \ interior(k2) = {} \ interior(l1) \ interior(l2) = {})" + hence "(interior(k1) \ interior(k2) = {} \ interior(l1) \ interior(l2) = {})" apply-apply(erule disjE) apply(rule disjI2) defer apply(rule disjI1) apply(rule d'(5)[OF as(3-4)],assumption) apply(rule p'(5)[OF as(1-2)]) by auto moreover have "interior(l1 \ k1) = interior(l2 \ k2)" unfolding as .. ultimately have "interior (l1 \ k1) = {}" by auto thus "\content (l1 \ k1)\ * norm (f x1) = 0" unfolding uv inter_interval - unfolding content_eq_0_interior[THEN sym] by auto + unfolding content_eq_0_interior[symmetric] by auto qed safe also have "... = (\(x, k)\p. content k *\<^sub>R norm (f x))" unfolding Sigma_alt - apply(subst sum_sum_product[THEN sym]) apply(rule p', rule,rule d') + apply(subst sum_sum_product[symmetric]) apply(rule p', rule,rule d') apply(rule setsum_cong2) unfolding split_paired_all split_conv proof- fix x l assume as:"(x,l)\p" note xl = p'(2-4)[OF this] from this(3) guess u v apply-by(erule exE)+ note uv=this @@ -5721,7 +6891,7 @@ apply(rule setsum_cong2) apply(drule d'(4),safe) apply(subst Int_commute) unfolding inter_interval uv apply(subst abs_of_nonneg) by auto also have "... = setsum content {k\{u..v}| k. k\d}" unfolding simple_image - apply(rule setsum_reindex_nonzero[unfolded o_def,THEN sym]) apply(rule d') + apply(rule setsum_reindex_nonzero[unfolded o_def,symmetric]) apply(rule d') proof- case goal1 from d'(4)[OF this(1)] d'(4)[OF this(2)] guess u1 v1 u2 v2 apply- by(erule exE)+ note uv=this have "{} = interior ((k \ y) \ {u..v})" apply(subst interior_inter) @@ -5738,11 +6908,11 @@ unfolding ab inter_interval content_eq_0_interior by auto thus ?case using goal1(1) using interior_subset[of "k \ {u..v}"] by auto qed finally show "(\i\d. \content (l \ i)\ * norm (f x)) = content l *\<^sub>R norm (f x)" - unfolding setsum_left_distrib[THEN sym] real_scaleR_def apply - + unfolding setsum_left_distrib[symmetric] real_scaleR_def apply - apply(subst(asm) additive_content_division[OF division_inter_1[OF d(1)]]) using xl(2)[unfolded uv] unfolding uv by auto - qed finally show ?case . - qed qed qed qed + qed finally show ?case . + qed qed qed qed lemma bounded_variation_absolutely_integrable: fixes f::"'n::ordered_euclidean_space \ 'm::ordered_euclidean_space" assumes "f integrable_on UNIV" "\d. d division_of (\d) \ setsum (\k. norm(integral k f)) d \ B" @@ -5755,7 +6925,7 @@ have f_int:"\a b. f absolutely_integrable_on {a..b}" apply(rule bounded_variation_absolutely_integrable_interval[where B=B]) apply(rule integrable_on_subinterval[OF assms(1)]) defer apply safe - apply(rule assms(2)[rule_format]) by auto + apply(rule assms(2)[rule_format]) by auto show "((\x. norm (f x)) has_integral i) UNIV" apply(subst has_integral_alt',safe) proof- case goal1 show ?case using f_int[of a b] by auto next case goal2 have "\y\setsum (\k. norm (integral k f)) ` {d. d division_of \d}. \ y \ i - e" @@ -5775,11 +6945,11 @@ proof- case goal1 have "(\k\d. norm (integral k f)) \ setsum (\k. integral k (\x. norm (f x))) d" apply(rule setsum_mono) apply(rule absolutely_integrable_le) apply(drule d'(4),safe) by(rule f_int) - also have "... = integral (\d) (\x. norm(f x))" - apply(rule integral_combine_division_bottomup[THEN sym]) + also have "... = integral (\d) (\x. norm(f x))" + apply(rule integral_combine_division_bottomup[symmetric]) apply(rule d) unfolding forall_in_division[OF d(1)] using f_int by auto - also have "... \ integral {a..b} (\x. if x \ UNIV then norm (f x) else 0)" - proof- case goal1 have "\d \ {a..b}" apply rule apply(drule K(2)[rule_format]) + also have "... \ integral {a..b} (\x. if x \ UNIV then norm (f x) else 0)" + proof- case goal1 have "\d \ {a..b}" apply rule apply(drule K(2)[rule_format]) apply(rule ab[unfolded subset_eq,rule_format]) by(auto simp add:dist_norm) thus ?case apply- apply(subst if_P,rule) apply(rule integral_subset_le) defer apply(rule integrable_on_subdivision[of _ _ _ "{a..b}"]) @@ -5795,7 +6965,7 @@ have *:"\sf sf' si di. sf' = sf \ si \ i \ abs(sf - si) < e / 2 \ abs(sf' - di) < e / 2 \ di < i + e" by arith show "integral {a..b} (\x. if x \ UNIV then norm (f x) else 0) < i + e" apply(subst if_P,rule) - proof(rule *[rule_format]) + proof(rule *[rule_format]) show "\(\(x,k)\p. norm (content k *\<^sub>R f x)) - (\(x,k)\p. norm (integral k f))\ < e / 2" unfolding split_def apply(rule helplemma) using d2(2)[rule_format,of p] using p(1,3) unfolding tagged_division_of_def split_def by auto @@ -5810,7 +6980,7 @@ unfolding image_iff apply(rule_tac x="snd ` p" in bexI) unfolding mem_Collect_eq defer apply(rule partial_division_of_tagged_division[of _ "{a..b}"]) using p(1) unfolding tagged_division_of_def by auto - qed qed qed(insert K,auto) qed qed + qed qed qed(insert K,auto) qed qed lemma absolutely_integrable_restrict_univ: "(\x. if x \ s then f x else (0::'a::banach)) absolutely_integrable_on UNIV \ f absolutely_integrable_on s" @@ -5821,12 +6991,12 @@ shows "(\x. f(x) + g(x)) absolutely_integrable_on s" proof- let ?P = "\f g::'n::ordered_euclidean_space \ 'm::ordered_euclidean_space. f absolutely_integrable_on UNIV \ g absolutely_integrable_on UNIV \ (\x. f(x) + g(x)) absolutely_integrable_on UNIV" - { presume as:"PROP ?P" note a = absolutely_integrable_restrict_univ[THEN sym] + { presume as:"PROP ?P" note a = absolutely_integrable_restrict_univ[symmetric] have *:"\x. (if x \ s then f x else 0) + (if x \ s then g x else 0) = (if x \ s then f x + g x else 0)" by auto show ?thesis apply(subst a) using as[OF assms[unfolded a[of f] a[of g]]] unfolding * . } fix f g::"'n::ordered_euclidean_space \ 'm::ordered_euclidean_space" assume assms:"f absolutely_integrable_on UNIV" - "g absolutely_integrable_on UNIV" + "g absolutely_integrable_on UNIV" note absolutely_integrable_bounded_variation from this[OF assms(1)] this[OF assms(2)] guess B1 B2 . note B=this[rule_format] show "(\x. f(x) + g(x)) absolutely_integrable_on UNIV" @@ -5837,7 +7007,7 @@ apply(rule_tac[!] integrable_on_subinterval[of _ UNIV]) using assms by auto hence "(\k\d. norm (integral k (\x. f x + g x))) \ (\k\d. norm (integral k f)) + (\k\d. norm (integral k g))" apply- - unfolding setsum_addf[THEN sym] apply(rule setsum_mono) + unfolding setsum_addf[symmetric] apply(rule setsum_mono) apply(subst integral_add) prefer 3 apply(rule norm_triangle_ineq) by auto also have "... \ B1 + B2" using B(1)[OF goal1] B(2)[OF goal1] by auto finally show ?case . @@ -5852,18 +7022,18 @@ lemma absolutely_integrable_linear: fixes f::"'m::ordered_euclidean_space \ 'n::ordered_euclidean_space" and h::"'n::ordered_euclidean_space \ 'p::ordered_euclidean_space" assumes "f absolutely_integrable_on s" "bounded_linear h" shows "(h o f) absolutely_integrable_on s" -proof- { presume as:"\f::'m::ordered_euclidean_space \ 'n::ordered_euclidean_space. \h::'n::ordered_euclidean_space \ 'p::ordered_euclidean_space. +proof- { presume as:"\f::'m::ordered_euclidean_space \ 'n::ordered_euclidean_space. \h::'n::ordered_euclidean_space \ 'p::ordered_euclidean_space. f absolutely_integrable_on UNIV \ bounded_linear h \ - (h o f) absolutely_integrable_on UNIV" note a = absolutely_integrable_restrict_univ[THEN sym] + (h o f) absolutely_integrable_on UNIV" note a = absolutely_integrable_restrict_univ[symmetric] show ?thesis apply(subst a) using as[OF assms[unfolded a[of f] a[of g]]] unfolding o_def if_distrib linear_simps[OF assms(2)] . } fix f::"'m::ordered_euclidean_space \ 'n::ordered_euclidean_space" and h::"'n::ordered_euclidean_space \ 'p::ordered_euclidean_space" - assume assms:"f absolutely_integrable_on UNIV" "bounded_linear h" + assume assms:"f absolutely_integrable_on UNIV" "bounded_linear h" from absolutely_integrable_bounded_variation[OF assms(1)] guess B . note B=this from bounded_linear.pos_bounded[OF assms(2)] guess b .. note b=conjunctD2[OF this] show "(h o f) absolutely_integrable_on UNIV" apply(rule bounded_variation_absolutely_integrable[of _ "B * b"]) - apply(rule integrable_linear[OF _ assms(2)]) + apply(rule integrable_linear[OF _ assms(2)]) proof safe case goal2 have "(\k\d. norm (integral k (h \ f))) \ setsum (\k. norm(integral k f)) d * b" unfolding setsum_left_distrib apply(rule setsum_mono) @@ -5953,14 +7123,14 @@ proof assume ?l thus ?r apply-apply rule defer apply(drule absolutely_integrable_vector_abs) by auto -next +next assume ?r { presume lem:"\f::'n \ 'm. f integrable_on UNIV \ (\x. (\i\Basis. \f x\i\ *\<^sub>R i)::'m) integrable_on UNIV \ f absolutely_integrable_on UNIV" have *:"\x. (\i\Basis. \(if x \ s then f x else 0) \ i\ *\<^sub>R i) = (if x\s then (\i\Basis. \f x \ i\ *\<^sub>R i) else (0::'m))" unfolding euclidean_eq_iff[where 'a='m] by auto - show ?l apply(subst absolutely_integrable_restrict_univ[THEN sym]) apply(rule lem) + show ?l apply(subst absolutely_integrable_restrict_univ[symmetric]) apply(rule lem) unfolding integrable_restrict_univ * using `?r` by auto } fix f::"'n::ordered_euclidean_space \ 'm::ordered_euclidean_space" assume assms:"f integrable_on UNIV" "(\x. (\i\Basis. \f x\i\ *\<^sub>R i)::'m) integrable_on UNIV" @@ -5976,7 +7146,7 @@ from d'(4)[OF this(1)] guess a b apply-by(erule exE)+ note ab=this show "\integral k f \ i\ \ integral k (\x. (\i\Basis. \f x\i\ *\<^sub>R i)::'m) \ i" apply (rule abs_leI) - unfolding inner_minus_left[THEN sym] defer apply(subst integral_neg[THEN sym]) + unfolding inner_minus_left[symmetric] defer apply(subst integral_neg[symmetric]) defer apply(rule_tac[1-2] integral_component_le[OF i]) apply(rule integrable_neg) using integrable_on_subinterval[OF assms(1),of a b] integrable_on_subinterval[OF assms(2),of a b] i unfolding ab by auto @@ -6009,7 +7179,7 @@ shows "f absolutely_integrable_on s" proof- { presume *:"\f::'n::ordered_euclidean_space \ 'm::ordered_euclidean_space. \ g. \x. norm(f x) \ g x \ f integrable_on UNIV \ g integrable_on UNIV \ f absolutely_integrable_on UNIV" - show ?thesis apply(subst absolutely_integrable_restrict_univ[THEN sym]) + show ?thesis apply(subst absolutely_integrable_restrict_univ[symmetric]) apply(rule *[of _ "\x. if x\s then g x else 0"]) using assms unfolding integrable_restrict_univ by auto } fix g and f :: "'n::ordered_euclidean_space \ 'm::ordered_euclidean_space" @@ -6018,9 +7188,9 @@ apply(rule bounded_variation_absolutely_integrable[OF assms(2),where B="integral UNIV g"]) proof safe case goal1 note d=this and d'=division_ofD[OF this] have "(\k\d. norm (integral k f)) \ (\k\d. integral k g)" - apply(rule setsum_mono) apply(rule integral_norm_bound_integral) apply(drule_tac[!] d'(4),safe) + apply(rule setsum_mono) apply(rule integral_norm_bound_integral) apply(drule_tac[!] d'(4),safe) apply(rule_tac[1-2] integrable_on_subinterval) using assms by auto - also have "... = integral (\d) g" apply(rule integral_combine_division_bottomup[THEN sym]) + also have "... = integral (\d) g" apply(rule integral_combine_division_bottomup[symmetric]) apply(rule d,safe) apply(drule d'(4),safe) apply(rule integrable_on_subinterval[OF assms(3)]) by auto also have "... \ integral UNIV g" apply(rule integral_subset_le) defer @@ -6161,7 +7331,7 @@ qed then guess y .. note y=this[unfolded not_le] from this(1)[unfolded mem_Collect_eq] guess N .. note N=conjunctD2[OF this] - + show ?case apply (rule_tac x=N in exI) proof safe @@ -6247,7 +7417,7 @@ case goal1 thus ?case using assms(3)[rule_format,OF x, of j] by auto qed auto - + have "\y\?S. \ y \ i - r" proof (rule ccontr) case goal1 @@ -6262,7 +7432,7 @@ qed then guess y .. note y=this[unfolded not_le] from this(1)[unfolded mem_Collect_eq] guess N .. note N=conjunctD2[OF this] - + show ?case apply (rule_tac x=N in exI) proof safe @@ -6291,7 +7461,7 @@ have "g integrable_on s \ ((\k. integral s (\x. Inf {f j x |j. k \ j})) ---> integral s g) sequentially" apply (rule monotone_convergence_increasing,safe) - apply fact + apply fact proof - show "bounded {integral s (\x. Inf {f j x |j. k \ j}) |k. True}" unfolding bounded_iff apply(rule_tac x="integral s h" in exI) @@ -6418,7 +7588,7 @@ show "integral s (\x. Inf {f j x |j. n \ j}) \ integral s (f n)" proof (rule integral_le[OF dec1(1) assms(1)], safe) fix x - assume x: "x \ s" + assume x: "x \ s" have *: "\x y::real. x \ - y \ - x \ y" by auto show "Inf {f j x |j. n \ j} \ f n x" apply (rule cInf_lower[where z="- h x"]) diff -r d92578436d47 -r d2a7b6fe953e src/HOL/Multivariate_Analysis/Linear_Algebra.thy --- a/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Fri Sep 06 10:56:40 2013 +0200 +++ b/src/HOL/Multivariate_Analysis/Linear_Algebra.thy Fri Sep 06 10:57:27 2013 +0200 @@ -17,11 +17,15 @@ lemma square_bound_lemma: "(x::real) < (1 + x) * (1 + x)" proof - - have "(x + 1/2)\<^sup>2 + 3/4 > 0" using zero_le_power2[of "x+1/2"] by arith - then show ?thesis by (simp add: field_simps power2_eq_square) + have "(x + 1/2)\<^sup>2 + 3/4 > 0" + using zero_le_power2[of "x+1/2"] by arith + then show ?thesis + by (simp add: field_simps power2_eq_square) qed -lemma square_continuous: "0 < (e::real) ==> \d. 0 < d \ (\y. abs(y - x) < d \ abs(y * y - x * x) < e)" +lemma square_continuous: + fixes e :: real + shows "e > 0 \ \d. 0 < d \ (\y. abs (y - x) < d \ abs (y * y - x * x) < e)" using isCont_power[OF isCont_ident, of x, unfolded isCont_def LIM_eq, rule_format, of e 2] apply (auto simp add: power2_eq_square) apply (rule_tac x="s" in exI) @@ -30,7 +34,7 @@ apply auto done -lemma real_le_lsqrt: "0 <= x \ 0 <= y \ x <= y\<^sup>2 ==> sqrt x <= y" +lemma real_le_lsqrt: "0 \ x \ 0 \ y \ x \ y\<^sup>2 \ sqrt x \ y" using real_sqrt_le_iff[of x "y\<^sup>2"] by simp lemma real_le_rsqrt: "x\<^sup>2 \ y \ x \ sqrt y" @@ -41,46 +45,49 @@ lemma sqrt_even_pow2: assumes n: "even n" - shows "sqrt(2 ^ n) = 2 ^ (n div 2)" + shows "sqrt (2 ^ n) = 2 ^ (n div 2)" proof - - from n obtain m where m: "n = 2*m" unfolding even_mult_two_ex .. - from m have "sqrt(2 ^ n) = sqrt ((2 ^ m)\<^sup>2)" + from n obtain m where m: "n = 2 * m" + unfolding even_mult_two_ex .. + from m have "sqrt (2 ^ n) = sqrt ((2 ^ m)\<^sup>2)" by (simp only: power_mult[symmetric] mult_commute) - then show ?thesis using m by simp + then show ?thesis + using m by simp qed -lemma real_div_sqrt: "0 <= x ==> x / sqrt(x) = sqrt(x)" - apply (cases "x = 0", simp_all) +lemma real_div_sqrt: "0 \ x \ x / sqrt x = sqrt x" + apply (cases "x = 0") + apply simp_all using sqrt_divide_self_eq[of x] apply (simp add: inverse_eq_divide field_simps) done text{* Hence derive more interesting properties of the norm. *} -lemma norm_eq_0_dot: "(norm x = 0) \ (inner x x = (0::real))" +lemma norm_eq_0_dot: "norm x = 0 \ x \ x = (0::real)" by simp (* TODO: delete *) -lemma norm_cauchy_schwarz: "inner x y <= norm x * norm y" +lemma norm_cauchy_schwarz: "x \ y \ norm x * norm y" (* TODO: move to Inner_Product.thy *) using Cauchy_Schwarz_ineq2[of x y] by auto lemma norm_triangle_sub: fixes x y :: "'a::real_normed_vector" - shows "norm x \ norm y + norm (x - y)" + shows "norm x \ norm y + norm (x - y)" using norm_triangle_ineq[of "y" "x - y"] by (simp add: field_simps) -lemma norm_le: "norm(x) <= norm(y) \ x \ x <= y \ y" - by (simp add: norm_eq_sqrt_inner) - -lemma norm_lt: "norm(x) < norm(y) \ x \ x < y \ y" +lemma norm_le: "norm x \ norm y \ x \ x \ y \ y" by (simp add: norm_eq_sqrt_inner) -lemma norm_eq: "norm(x) = norm (y) \ x \ x = y \ y" +lemma norm_lt: "norm x < norm y \ x \ x < y \ y" + by (simp add: norm_eq_sqrt_inner) + +lemma norm_eq: "norm x = norm y \ x \ x = y \ y" apply (subst order_eq_iff) apply (auto simp: norm_le) done -lemma norm_eq_1: "norm(x) = 1 \ x \ x = 1" +lemma norm_eq_1: "norm x = 1 \ x \ x = 1" by (simp add: norm_eq_sqrt_inner) text{* Squaring equations and inequalities involving norms. *} @@ -88,7 +95,7 @@ lemma dot_square_norm: "x \ x = (norm x)\<^sup>2" by (simp only: power2_norm_eq_inner) (* TODO: move? *) -lemma norm_eq_square: "norm(x) = a \ 0 <= a \ x \ x = a\<^sup>2" +lemma norm_eq_square: "norm x = a \ 0 \ a \ x \ x = a\<^sup>2" by (auto simp add: norm_eq_sqrt_inner) lemma real_abs_le_square_iff: "\x\ \ \y\ \ (x::real)\<^sup>2 \ y\<^sup>2" @@ -102,13 +109,13 @@ then show "\x\ \ \y\" by simp qed -lemma norm_le_square: "norm(x) <= a \ 0 <= a \ x \ x <= a\<^sup>2" +lemma norm_le_square: "norm x \ a \ 0 \ a \ x \ x \ a\<^sup>2" apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric]) using norm_ge_zero[of x] apply arith done -lemma norm_ge_square: "norm(x) >= a \ a <= 0 \ x \ x >= a\<^sup>2" +lemma norm_ge_square: "norm x \ a \ a \ 0 \ x \ x \ a\<^sup>2" apply (simp add: dot_square_norm real_abs_le_square_iff[symmetric]) using norm_ge_zero[of x] apply arith @@ -116,16 +123,17 @@ lemma norm_lt_square: "norm(x) < a \ 0 < a \ x \ x < a\<^sup>2" by (metis not_le norm_ge_square) + lemma norm_gt_square: "norm(x) > a \ a < 0 \ x \ x > a\<^sup>2" by (metis norm_le_square not_less) text{* Dot product in terms of the norm rather than conversely. *} -lemmas inner_simps = inner_add_left inner_add_right inner_diff_right inner_diff_left +lemmas inner_simps = inner_add_left inner_add_right inner_diff_right inner_diff_left inner_scaleR_left inner_scaleR_right lemma dot_norm: "x \ y = ((norm (x + y))\<^sup>2 - (norm x)\<^sup>2 - (norm y)\<^sup>2) / 2" - unfolding power2_norm_eq_inner inner_simps inner_commute by auto + unfolding power2_norm_eq_inner inner_simps inner_commute by auto lemma dot_norm_neg: "x \ y = (((norm x)\<^sup>2 + (norm y)\<^sup>2) - (norm (x - y))\<^sup>2) / 2" unfolding power2_norm_eq_inner inner_simps inner_commute @@ -133,32 +141,37 @@ text{* Equality of vectors in terms of @{term "op \"} products. *} -lemma vector_eq: "x = y \ x \ x = x \ y \ y \ y = x \ x" (is "?lhs \ ?rhs") +lemma vector_eq: "x = y \ x \ x = x \ y \ y \ y = x \ x" + (is "?lhs \ ?rhs") proof assume ?lhs then show ?rhs by simp next assume ?rhs - then have "x \ x - x \ y = 0 \ x \ y - y \ y = 0" by simp - then have "x \ (x - y) = 0 \ y \ (x - y) = 0" by (simp add: inner_diff inner_commute) - then have "(x - y) \ (x - y) = 0" by (simp add: field_simps inner_diff inner_commute) - then show "x = y" by (simp) + then have "x \ x - x \ y = 0 \ x \ y - y \ y = 0" + by simp + then have "x \ (x - y) = 0 \ y \ (x - y) = 0" + by (simp add: inner_diff inner_commute) + then have "(x - y) \ (x - y) = 0" + by (simp add: field_simps inner_diff inner_commute) + then show "x = y" by simp qed lemma norm_triangle_half_r: - shows "norm (y - x1) < e / 2 \ norm (y - x2) < e / 2 \ norm (x1 - x2) < e" - using dist_triangle_half_r unfolding dist_norm[THEN sym] by auto + "norm (y - x1) < e / 2 \ norm (y - x2) < e / 2 \ norm (x1 - x2) < e" + using dist_triangle_half_r unfolding dist_norm[symmetric] by auto lemma norm_triangle_half_l: - assumes "norm (x - y) < e / 2" "norm (x' - (y)) < e / 2" + assumes "norm (x - y) < e / 2" + and "norm (x' - (y)) < e / 2" shows "norm (x - x') < e" - using dist_triangle_half_l[OF assms[unfolded dist_norm[THEN sym]]] - unfolding dist_norm[THEN sym] . - -lemma norm_triangle_le: "norm(x) + norm y <= e ==> norm(x + y) <= e" + using dist_triangle_half_l[OF assms[unfolded dist_norm[symmetric]]] + unfolding dist_norm[symmetric] . + +lemma norm_triangle_le: "norm x + norm y \ e \ norm (x + y) \ e" by (rule norm_triangle_ineq [THEN order_trans]) -lemma norm_triangle_lt: "norm(x) + norm(y) < e ==> norm(x + y) < e" +lemma norm_triangle_lt: "norm x + norm y < e \ norm (x + y) < e" by (rule norm_triangle_ineq [THEN le_less_trans]) lemma setsum_clauses: @@ -191,7 +204,8 @@ lemma vector_eq_ldot: "(\x. x \ y = x \ z) \ y = z" proof assume "\x. x \ y = x \ z" - then have "\x. x \ (y - z) = 0" by (simp add: inner_diff) + then have "\x. x \ (y - z) = 0" + by (simp add: inner_diff) then have "(y - z) \ (y - z) = 0" .. then show "y = z" by simp qed simp @@ -199,7 +213,8 @@ lemma vector_eq_rdot: "(\z. x \ z = y \ z) \ x = y" proof assume "\z. x \ z = y \ z" - then have "\z. (x - y) \ z = 0" by (simp add: inner_diff) + then have "\z. (x - y) \ z = 0" + by (simp add: inner_diff) then have "(x - y) \ (x - y) = 0" .. then show "x = y" by simp qed simp @@ -237,31 +252,35 @@ where "linear f \ (\x y. f(x + y) = f x + f y) \ (\c x. f(c *\<^sub>R x) = c *\<^sub>R f x)" lemma linearI: - assumes "\x y. f (x + y) = f x + f y" "\c x. f (c *\<^sub>R x) = c *\<^sub>R f x" + assumes "\x y. f (x + y) = f x + f y" + and "\c x. f (c *\<^sub>R x) = c *\<^sub>R f x" shows "linear f" using assms unfolding linear_def by auto -lemma linear_compose_cmul: "linear f ==> linear (\x. c *\<^sub>R f x)" +lemma linear_compose_cmul: "linear f \ linear (\x. c *\<^sub>R f x)" by (simp add: linear_def algebra_simps) -lemma linear_compose_neg: "linear f ==> linear (\x. -(f(x)))" +lemma linear_compose_neg: "linear f \ linear (\x. - f x)" by (simp add: linear_def) -lemma linear_compose_add: "linear f \ linear g ==> linear (\x. f(x) + g(x))" +lemma linear_compose_add: "linear f \ linear g \ linear (\x. f x + g x)" by (simp add: linear_def algebra_simps) -lemma linear_compose_sub: "linear f \ linear g ==> linear (\x. f x - g x)" +lemma linear_compose_sub: "linear f \ linear g \ linear (\x. f x - g x)" by (simp add: linear_def algebra_simps) -lemma linear_compose: "linear f \ linear g ==> linear (g o f)" +lemma linear_compose: "linear f \ linear g \ linear (g \ f)" by (simp add: linear_def) -lemma linear_id: "linear id" by (simp add: linear_def id_def) - -lemma linear_zero: "linear (\x. 0)" by (simp add: linear_def) +lemma linear_id: "linear id" + by (simp add: linear_def id_def) + +lemma linear_zero: "linear (\x. 0)" + by (simp add: linear_def) lemma linear_compose_setsum: - assumes fS: "finite S" and lS: "\a \ S. linear (f a)" + assumes fS: "finite S" + and lS: "\a \ S. linear (f a)" shows "linear(\x. setsum (\a. f a x) S)" using lS apply (induct rule: finite_induct[OF fS]) @@ -275,88 +294,100 @@ apply simp done -lemma linear_cmul: "linear f ==> f(c *\<^sub>R x) = c *\<^sub>R f x" +lemma linear_cmul: "linear f \ f (c *\<^sub>R x) = c *\<^sub>R f x" by (simp add: linear_def) -lemma linear_neg: "linear f ==> f (-x) = - f x" +lemma linear_neg: "linear f \ f (- x) = - f x" using linear_cmul [where c="-1"] by simp -lemma linear_add: "linear f ==> f(x + y) = f x + f y" +lemma linear_add: "linear f \ f(x + y) = f x + f y" by (metis linear_def) -lemma linear_sub: "linear f ==> f(x - y) = f x - f y" +lemma linear_sub: "linear f \ f(x - y) = f x - f y" by (simp add: diff_minus linear_add linear_neg) lemma linear_setsum: - assumes lf: "linear f" and fS: "finite S" - shows "f (setsum g S) = setsum (f o g) S" - using fS -proof (induct rule: finite_induct) + assumes lin: "linear f" + and fin: "finite S" + shows "f (setsum g S) = setsum (f \ g) S" + using fin +proof induct case empty - then show ?case by (simp add: linear_0[OF lf]) + then show ?case + by (simp add: linear_0[OF lin]) next case (insert x F) - have "f (setsum g (insert x F)) = f (g x + setsum g F)" using insert.hyps - by simp - also have "\ = f (g x) + f (setsum g F)" using linear_add[OF lf] by simp - also have "\ = setsum (f o g) (insert x F)" using insert.hyps by simp + have "f (setsum g (insert x F)) = f (g x + setsum g F)" + using insert.hyps by simp + also have "\ = f (g x) + f (setsum g F)" + using linear_add[OF lin] by simp + also have "\ = setsum (f \ g) (insert x F)" + using insert.hyps by simp finally show ?case . qed lemma linear_setsum_mul: - assumes lf: "linear f" and fS: "finite S" + assumes lin: "linear f" + and fin: "finite S" shows "f (setsum (\i. c i *\<^sub>R v i) S) = setsum (\i. c i *\<^sub>R f (v i)) S" - using linear_setsum[OF lf fS, of "\i. c i *\<^sub>R v i" , unfolded o_def] linear_cmul[OF lf] + using linear_setsum[OF lin fin, of "\i. c i *\<^sub>R v i" , unfolded o_def] linear_cmul[OF lin] by simp lemma linear_injective_0: - assumes lf: "linear f" + assumes lin: "linear f" shows "inj f \ (\x. f x = 0 \ x = 0)" proof - - have "inj f \ (\ x y. f x = f y \ x = y)" by (simp add: inj_on_def) - also have "\ \ (\ x y. f x - f y = 0 \ x - y = 0)" by simp + have "inj f \ (\ x y. f x = f y \ x = y)" + by (simp add: inj_on_def) + also have "\ \ (\ x y. f x - f y = 0 \ x - y = 0)" + by simp also have "\ \ (\ x y. f (x - y) = 0 \ x - y = 0)" - by (simp add: linear_sub[OF lf]) - also have "\ \ (\ x. f x = 0 \ x = 0)" by auto + by (simp add: linear_sub[OF lin]) + also have "\ \ (\ x. f x = 0 \ x = 0)" + by auto finally show ?thesis . qed subsection {* Bilinear functions. *} -definition "bilinear f \ (\x. linear(\y. f x y)) \ (\y. linear(\x. f x y))" - -lemma bilinear_ladd: "bilinear h ==> h (x + y) z = (h x z) + (h y z)" +definition "bilinear f \ (\x. linear (\y. f x y)) \ (\y. linear (\x. f x y))" + +lemma bilinear_ladd: "bilinear h \ h (x + y) z = h x z + h y z" by (simp add: bilinear_def linear_def) -lemma bilinear_radd: "bilinear h ==> h x (y + z) = (h x y) + (h x z)" +lemma bilinear_radd: "bilinear h \ h x (y + z) = h x y + h x z" by (simp add: bilinear_def linear_def) -lemma bilinear_lmul: "bilinear h ==> h (c *\<^sub>R x) y = c *\<^sub>R (h x y)" +lemma bilinear_lmul: "bilinear h \ h (c *\<^sub>R x) y = c *\<^sub>R h x y" by (simp add: bilinear_def linear_def) -lemma bilinear_rmul: "bilinear h ==> h x (c *\<^sub>R y) = c *\<^sub>R (h x y)" +lemma bilinear_rmul: "bilinear h \ h x (c *\<^sub>R y) = c *\<^sub>R h x y" by (simp add: bilinear_def linear_def) -lemma bilinear_lneg: "bilinear h ==> h (- x) y = -(h x y)" +lemma bilinear_lneg: "bilinear h \ h (- x) y = - h x y" by (simp only: scaleR_minus1_left [symmetric] bilinear_lmul) -lemma bilinear_rneg: "bilinear h ==> h x (- y) = - h x y" +lemma bilinear_rneg: "bilinear h \ h x (- y) = - h x y" by (simp only: scaleR_minus1_left [symmetric] bilinear_rmul) -lemma (in ab_group_add) eq_add_iff: "x = x + y \ y = 0" +lemma (in ab_group_add) eq_add_iff: "x = x + y \ y = 0" using add_imp_eq[of x y 0] by auto -lemma bilinear_lzero: assumes "bilinear h" shows "h 0 x = 0" +lemma bilinear_lzero: + assumes "bilinear h" + shows "h 0 x = 0" using bilinear_ladd [OF assms, of 0 0 x] by (simp add: eq_add_iff field_simps) -lemma bilinear_rzero: assumes "bilinear h" shows "h x 0 = 0" +lemma bilinear_rzero: + assumes "bilinear h" + shows "h x 0 = 0" using bilinear_radd [OF assms, of x 0 0 ] by (simp add: eq_add_iff field_simps) -lemma bilinear_lsub: "bilinear h ==> h (x - y) z = h x z - h y z" +lemma bilinear_lsub: "bilinear h \ h (x - y) z = h x z - h y z" by (simp add: diff_minus bilinear_ladd bilinear_lneg) -lemma bilinear_rsub: "bilinear h ==> h z (x - y) = h z x - h z y" +lemma bilinear_rsub: "bilinear h \ h z (x - y) = h z x - h z y" by (simp add: diff_minus bilinear_radd bilinear_rneg) lemma bilinear_setsum: @@ -367,7 +398,8 @@ proof - have "h (setsum f S) (setsum g T) = setsum (\x. h (f x) (setsum g T)) S" apply (rule linear_setsum[unfolded o_def]) - using bh fS apply (auto simp add: bilinear_def) + using bh fS + apply (auto simp add: bilinear_def) done also have "\ = setsum (\x. setsum (\y. h (f x) (g y)) T) S" apply (rule setsum_cong, simp) @@ -375,7 +407,8 @@ using bh fT apply (auto simp add: bilinear_def) done - finally show ?thesis unfolding setsum_cartesian_product . + finally show ?thesis + unfolding setsum_cartesian_product . qed @@ -388,13 +421,19 @@ shows "adjoint f = g" unfolding adjoint_def proof (rule some_equality) - show "\x y. inner (f x) y = inner x (g y)" using assms . + show "\x y. inner (f x) y = inner x (g y)" + by (rule assms) next - fix h assume "\x y. inner (f x) y = inner x (h y)" - then have "\x y. inner x (g y) = inner x (h y)" using assms by simp - then have "\x y. inner x (g y - h y) = 0" by (simp add: inner_diff_right) - then have "\y. inner (g y - h y) (g y - h y) = 0" by simp - then have "\y. h y = g y" by simp + fix h + assume "\x y. inner (f x) y = inner x (h y)" + then have "\x y. inner x (g y) = inner x (h y)" + using assms by simp + then have "\x y. inner x (g y - h y) = 0" + by (simp add: inner_diff_right) + then have "\y. inner (g y - h y) (g y - h y) = 0" + by simp + then have "\y. h y = g y" + by simp then show "h = g" by (simp add: ext) qed @@ -418,7 +457,7 @@ unfolding linear_setsum[OF lf finite_Basis] by (simp add: linear_cmul[OF lf]) finally show "f x \ y = x \ ?w" - by (simp add: inner_setsum_left inner_setsum_right mult_commute) + by (simp add: inner_setsum_left inner_setsum_right mult_commute) qed then show ?thesis unfolding adjoint_def choice_iff @@ -445,18 +484,22 @@ shows "adjoint (adjoint f) = f" by (rule adjoint_unique, simp add: adjoint_clauses [OF lf]) + subsection {* Interlude: Some properties of real sets *} -lemma seq_mono_lemma: assumes "\(n::nat) \ m. (d n :: real) < e n" and "\n \ m. e n <= e m" +lemma seq_mono_lemma: + assumes "\(n::nat) \ m. (d n :: real) < e n" + and "\n \ m. e n \ e m" shows "\n \ m. d n < e m" - using assms apply auto + using assms + apply auto apply (erule_tac x="n" in allE) apply (erule_tac x="n" in allE) apply auto done - -lemma infinite_enumerate: assumes fS: "infinite S" +lemma infinite_enumerate: + assumes fS: "infinite S" shows "\r. subseq r \ (\n. r n \ S)" unfolding subseq_def using enumerate_in_set[OF fS] enumerate_mono[of _ _ S] fS by auto @@ -467,53 +510,57 @@ apply auto done - lemma triangle_lemma: - assumes x: "0 <= (x::real)" and y:"0 <= y" and z: "0 <= z" and xy: "x\<^sup>2 <= y\<^sup>2 + z\<^sup>2" - shows "x <= y + z" + fixes x y z :: real + assumes x: "0 \ x" + and y: "0 \ y" + and z: "0 \ z" + and xy: "x\<^sup>2 \ y\<^sup>2 + z\<^sup>2" + shows "x \ y + z" proof - - have "y\<^sup>2 + z\<^sup>2 \ y\<^sup>2 + 2*y*z + z\<^sup>2" using z y by (simp add: mult_nonneg_nonneg) - with xy have th: "x\<^sup>2 \ (y+z)\<^sup>2" by (simp add: power2_eq_square field_simps) - from y z have yz: "y + z \ 0" by arith + have "y\<^sup>2 + z\<^sup>2 \ y\<^sup>2 + 2 *y * z + z\<^sup>2" + using z y by (simp add: mult_nonneg_nonneg) + with xy have th: "x\<^sup>2 \ (y + z)\<^sup>2" + by (simp add: power2_eq_square field_simps) + from y z have yz: "y + z \ 0" + by arith from power2_le_imp_le[OF th yz] show ?thesis . qed subsection {* A generic notion of "hull" (convex, affine, conic hull and closure). *} -definition hull :: "('a set \ bool) \ 'a set \ 'a set" (infixl "hull" 75) - where "S hull s = Inter {t. S t \ s \ t}" +definition hull :: "('a set \ bool) \ 'a set \ 'a set" (infixl "hull" 75) + where "S hull s = \{t. S t \ s \ t}" lemma hull_same: "S s \ S hull s = s" unfolding hull_def by auto -lemma hull_in: "(\T. Ball T S ==> S (Inter T)) ==> S (S hull s)" +lemma hull_in: "(\T. Ball T S \ S (\T)) \ S (S hull s)" unfolding hull_def Ball_def by auto -lemma hull_eq: "(\T. Ball T S ==> S (Inter T)) ==> (S hull s) = s \ S s" +lemma hull_eq: "(\T. Ball T S \ S (\T)) \ (S hull s) = s \ S s" using hull_same[of S s] hull_in[of S s] by metis - lemma hull_hull: "S hull (S hull s) = S hull s" unfolding hull_def by blast lemma hull_subset[intro]: "s \ (S hull s)" unfolding hull_def by blast -lemma hull_mono: " s \ t ==> (S hull s) \ (S hull t)" +lemma hull_mono: "s \ t \ (S hull s) \ (S hull t)" unfolding hull_def by blast -lemma hull_antimono: "\x. S x \ T x ==> (T hull s) \ (S hull s)" +lemma hull_antimono: "\x. S x \ T x \ (T hull s) \ (S hull s)" unfolding hull_def by blast -lemma hull_minimal: "s \ t \ S t ==> (S hull s) \ t" +lemma hull_minimal: "s \ t \ S t \ (S hull s) \ t" unfolding hull_def by blast -lemma subset_hull: "S t ==> S hull s \ t \ s \ t" +lemma subset_hull: "S t \ S hull s \ t \ s \ t" unfolding hull_def by blast -lemma hull_unique: "s \ t \ S t \ - (\t'. s \ t' \ S t' \ t \ t') \ (S hull s = t)" +lemma hull_unique: "s \ t \ S t \ (\t'. s \ t' \ S t' \ t \ t') \ (S hull s = t)" unfolding hull_def by auto lemma hull_induct: "(\x. x\ S \ P x) \ Q {x. P x} \ \x\ Q hull S. P x" @@ -527,7 +574,7 @@ unfolding Un_subset_iff by (metis hull_mono Un_upper1 Un_upper2) lemma hull_union: - assumes T: "\T. Ball T S ==> S (Inter T)" + assumes T: "\T. Ball T S \ S (\T)" shows "S hull (s \ t) = S hull (S hull s \ S hull t)" apply rule apply (rule hull_mono) @@ -541,13 +588,13 @@ lemma hull_redundant_eq: "a \ (S hull s) \ (S hull (insert a s) = S hull s)" unfolding hull_def by blast -lemma hull_redundant: "a \ (S hull s) ==> (S hull (insert a s) = S hull s)" +lemma hull_redundant: "a \ (S hull s) \ (S hull (insert a s) = S hull s)" by (metis hull_redundant_eq) subsection {* Archimedean properties and useful consequences *} -lemma real_arch_simple: "\n. x <= real (n::nat)" +lemma real_arch_simple: "\n. x \ real (n::nat)" unfolding real_of_nat_def by (rule ex_le_of_nat) lemma real_arch_inv: "0 < e \ (\n::nat. n \ 0 \ 0 < inverse (real n) \ inverse (real n) < e)" @@ -558,60 +605,77 @@ apply simp done -lemma real_pow_lbound: "0 <= x ==> 1 + real n * x <= (1 + x) ^ n" +lemma real_pow_lbound: "0 \ x \ 1 + real n * x \ (1 + x) ^ n" proof (induct n) case 0 then show ?case by simp next case (Suc n) - then have h: "1 + real n * x \ (1 + x) ^ n" by simp - from h have p: "1 \ (1 + x) ^ n" using Suc.prems by simp - from h have "1 + real n * x + x \ (1 + x) ^ n + x" by simp - also have "\ \ (1 + x) ^ Suc n" apply (subst diff_le_0_iff_le[symmetric]) + then have h: "1 + real n * x \ (1 + x) ^ n" + by simp + from h have p: "1 \ (1 + x) ^ n" + using Suc.prems by simp + from h have "1 + real n * x + x \ (1 + x) ^ n + x" + by simp + also have "\ \ (1 + x) ^ Suc n" + apply (subst diff_le_0_iff_le[symmetric]) apply (simp add: field_simps) - using mult_left_mono[OF p Suc.prems] apply simp + using mult_left_mono[OF p Suc.prems] + apply simp done - finally show ?case by (simp add: real_of_nat_Suc field_simps) + finally show ?case + by (simp add: real_of_nat_Suc field_simps) qed -lemma real_arch_pow: assumes x: "1 < (x::real)" shows "\n. y < x^n" +lemma real_arch_pow: + fixes x :: real + assumes x: "1 < x" + shows "\n. y < x^n" proof - - from x have x0: "x - 1 > 0" by arith + from x have x0: "x - 1 > 0" + by arith from reals_Archimedean3[OF x0, rule_format, of y] - obtain n::nat where n:"y < real n * (x - 1)" by metis + obtain n :: nat where n: "y < real n * (x - 1)" by metis from x0 have x00: "x- 1 \ 0" by arith from real_pow_lbound[OF x00, of n] n have "y < x^n" by auto then show ?thesis by metis qed -lemma real_arch_pow2: "\n. (x::real) < 2^ n" +lemma real_arch_pow2: + fixes x :: real + shows "\n. x < 2^ n" using real_arch_pow[of 2 x] by simp lemma real_arch_pow_inv: - assumes y: "(y::real) > 0" and x1: "x < 1" + fixes x y :: real + assumes y: "y > 0" + and x1: "x < 1" shows "\n. x^n < y" -proof - - { assume x0: "x > 0" - from x0 x1 have ix: "1 < 1/x" by (simp add: field_simps) - from real_arch_pow[OF ix, of "1/y"] - obtain n where n: "1/y < (1/x)^n" by blast - then have ?thesis using y x0 - by (auto simp add: field_simps power_divide) } - moreover - { assume "\ x > 0" - with y x1 have ?thesis apply auto by (rule exI[where x=1], auto) } - ultimately show ?thesis by metis +proof (cases "x > 0") + case True + with x1 have ix: "1 < 1/x" by (simp add: field_simps) + from real_arch_pow[OF ix, of "1/y"] + obtain n where n: "1/y < (1/x)^n" by blast + then show ?thesis using y `x > 0` + by (auto simp add: field_simps power_divide) +next + case False + with y x1 show ?thesis + apply auto + apply (rule exI[where x=1]) + apply auto + done qed lemma forall_pos_mono: - "(\d e::real. d < e \ P d ==> P e) \ - (\n::nat. n \ 0 ==> P(inverse(real n))) \ (\e. 0 < e ==> P e)" + "(\d e::real. d < e \ P d \ P e) \ + (\n::nat. n \ 0 \ P (inverse (real n))) \ (\e. 0 < e \ P e)" by (metis real_arch_inv) lemma forall_pos_mono_1: - "(\d e::real. d < e \ P d ==> P e) \ - (\n. P(inverse(real (Suc n)))) ==> 0 < e ==> P e" + "(\d e::real. d < e \ P d \ P e) \ + (\n. P(inverse(real (Suc n)))) \ 0 < e \ P e" apply (rule forall_pos_mono) apply auto apply (atomize) @@ -620,15 +684,20 @@ done lemma real_archimedian_rdiv_eq_0: - assumes x0: "x \ 0" and c: "c \ 0" and xc: "\(m::nat)>0. real m * x \ c" + assumes x0: "x \ 0" + and c: "c \ 0" + and xc: "\(m::nat)>0. real m * x \ c" shows "x = 0" -proof - - { assume "x \ 0" with x0 have xp: "x > 0" by arith - from reals_Archimedean3[OF xp, rule_format, of c] - obtain n::nat where n: "c < real n * x" by blast - with xc[rule_format, of n] have "n = 0" by arith - with n c have False by simp } - then show ?thesis by blast +proof (rule ccontr) + assume "x \ 0" + with x0 have xp: "x > 0" by arith + from reals_Archimedean3[OF xp, rule_format, of c] + obtain n :: nat where n: "c < real n * x" + by blast + with xc[rule_format, of n] have "n = 0" + by arith + with n c show False + by simp qed @@ -639,15 +708,17 @@ definition (in real_vector) "span S = (subspace hull S)" definition (in real_vector) "dependent S \ (\a \ S. a \ span(S - {a}))" -abbreviation (in real_vector) "independent s == ~(dependent s)" +abbreviation (in real_vector) "independent s \ \ dependent s" text {* Closure properties of subspaces. *} -lemma subspace_UNIV[simp]: "subspace(UNIV)" by (simp add: subspace_def) - -lemma (in real_vector) subspace_0: "subspace S ==> 0 \ S" by (metis subspace_def) - -lemma (in real_vector) subspace_add: "subspace S \ x \ S \ y \ S ==> x + y \ S" +lemma subspace_UNIV[simp]: "subspace UNIV" + by (simp add: subspace_def) + +lemma (in real_vector) subspace_0: "subspace S \ 0 \ S" + by (metis subspace_def) + +lemma (in real_vector) subspace_add: "subspace S \ x \ S \ y \ S \ x + y \ S" by (metis subspace_def) lemma (in real_vector) subspace_mul: "subspace S \ x \ S \ c *\<^sub>R x \ S" @@ -660,7 +731,8 @@ by (metis diff_minus subspace_add subspace_neg) lemma (in real_vector) subspace_setsum: - assumes sA: "subspace A" and fB: "finite B" + assumes sA: "subspace A" + and fB: "finite B" and f: "\x\ B. f x \ A" shows "setsum f B \ A" using fB f sA @@ -668,36 +740,39 @@ (simp add: subspace_def sA, auto simp add: sA subspace_add) lemma subspace_linear_image: - assumes lf: "linear f" and sS: "subspace S" - shows "subspace(f ` S)" + assumes lf: "linear f" + and sS: "subspace S" + shows "subspace (f ` S)" using lf sS linear_0[OF lf] unfolding linear_def subspace_def apply (auto simp add: image_iff) - apply (rule_tac x="x + y" in bexI, auto) - apply (rule_tac x="c *\<^sub>R x" in bexI, auto) + apply (rule_tac x="x + y" in bexI) + apply auto + apply (rule_tac x="c *\<^sub>R x" in bexI) + apply auto done lemma subspace_linear_vimage: "linear f \ subspace S \ subspace (f -` S)" by (auto simp add: subspace_def linear_def linear_0[of f]) -lemma subspace_linear_preimage: "linear f ==> subspace S ==> subspace {x. f x \ S}" +lemma subspace_linear_preimage: "linear f \ subspace S \ subspace {x. f x \ S}" by (auto simp add: subspace_def linear_def linear_0[of f]) lemma subspace_trivial: "subspace {0}" by (simp add: subspace_def) -lemma (in real_vector) subspace_inter: "subspace A \ subspace B ==> subspace (A \ B)" +lemma (in real_vector) subspace_inter: "subspace A \ subspace B \ subspace (A \ B)" by (simp add: subspace_def) -lemma subspace_Times: "\subspace A; subspace B\ \ subspace (A \ B)" +lemma subspace_Times: "subspace A \ subspace B \ subspace (A \ B)" unfolding subspace_def zero_prod_def by simp text {* Properties of span. *} -lemma (in real_vector) span_mono: "A \ B ==> span A \ span B" +lemma (in real_vector) span_mono: "A \ B \ span A \ span B" by (metis span_def hull_mono) -lemma (in real_vector) subspace_span: "subspace(span S)" +lemma (in real_vector) subspace_span: "subspace (span S)" unfolding span_def apply (rule hull_in) apply (simp only: subspace_def Inter_iff Int_iff subset_eq) @@ -705,12 +780,11 @@ done lemma (in real_vector) span_clauses: - "a \ S ==> a \ span S" + "a \ S \ a \ span S" "0 \ span S" - "x\ span S \ y \ span S ==> x + y \ span S" + "x\ span S \ y \ span S \ x + y \ span S" "x \ span S \ c *\<^sub>R x \ span S" - by (metis span_def hull_subset subset_eq) - (metis subspace_span subspace_def)+ + by (metis span_def hull_subset subset_eq) (metis subspace_span subspace_def)+ lemma span_unique: "S \ T \ subspace T \ (\T'. S \ T' \ subspace T' \ T \ T') \ span S = T" @@ -722,12 +796,14 @@ lemma (in real_vector) span_induct: assumes x: "x \ span S" and P: "subspace P" - and SP: "\x. x \ S ==> x \ P" + and SP: "\x. x \ S \ x \ P" shows "x \ P" proof - - from SP have SP': "S \ P" by (simp add: subset_eq) + from SP have SP': "S \ P" + by (simp add: subset_eq) from x hull_minimal[where S=subspace, OF SP' P, unfolded span_def[symmetric]] - show "x \ P" by (metis subset_eq) + show "x \ P" + by (metis subset_eq) qed lemma span_empty[simp]: "span {} = {0}" @@ -742,7 +818,7 @@ lemma dependent_single[simp]: "dependent {x} \ x = 0" unfolding dependent_def by auto -lemma (in real_vector) independent_mono: "independent A \ B \ A ==> independent B" +lemma (in real_vector) independent_mono: "independent A \ B \ A \ independent B" apply (clarsimp simp add: dependent_def span_mono) apply (subgoal_tac "span (B - {a}) \ span (A - {a})") apply force @@ -760,34 +836,46 @@ using span_induct SP P by blast inductive_set (in real_vector) span_induct_alt_help for S:: "'a set" - where +where span_induct_alt_help_0: "0 \ span_induct_alt_help S" | span_induct_alt_help_S: - "x \ S \ z \ span_induct_alt_help S \ (c *\<^sub>R x + z) \ span_induct_alt_help S" + "x \ S \ z \ span_induct_alt_help S \ + (c *\<^sub>R x + z) \ span_induct_alt_help S" lemma span_induct_alt': - assumes h0: "h 0" and hS: "\c x y. x \ S \ h y \ h (c *\<^sub>R x + y)" + assumes h0: "h 0" + and hS: "\c x y. x \ S \ h y \ h (c *\<^sub>R x + y)" shows "\x \ span S. h x" proof - - { fix x:: "'a" assume x: "x \ span_induct_alt_help S" + { + fix x :: 'a + assume x: "x \ span_induct_alt_help S" have "h x" apply (rule span_induct_alt_help.induct[OF x]) apply (rule h0) - apply (rule hS, assumption, assumption) - done } + apply (rule hS) + apply assumption + apply assumption + done + } note th0 = this - { fix x assume x: "x \ span S" + { + fix x + assume x: "x \ span S" have "x \ span_induct_alt_help S" proof (rule span_induct[where x=x and S=S]) - show "x \ span S" using x . + show "x \ span S" by (rule x) next - fix x assume xS : "x \ S" - from span_induct_alt_help_S[OF xS span_induct_alt_help_0, of 1] - show "x \ span_induct_alt_help S" by simp + fix x + assume xS: "x \ S" + from span_induct_alt_help_S[OF xS span_induct_alt_help_0, of 1] + show "x \ span_induct_alt_help S" + by simp next have "0 \ span_induct_alt_help S" by (rule span_induct_alt_help_0) moreover - { fix x y + { + fix x y assume h: "x \ span_induct_alt_help S" "y \ span_induct_alt_help S" from h have "(x + y) \ span_induct_alt_help S" apply (induct rule: span_induct_alt_help.induct) @@ -796,9 +884,11 @@ apply (rule span_induct_alt_help_S) apply assumption apply simp - done } + done + } moreover - { fix c x + { + fix c x assume xt: "x \ span_induct_alt_help S" then have "(c *\<^sub>R x) \ span_induct_alt_help S" apply (induct rule: span_induct_alt_help.induct) @@ -808,15 +898,17 @@ apply assumption apply simp done } - ultimately - show "subspace (span_induct_alt_help S)" + ultimately show "subspace (span_induct_alt_help S)" unfolding subspace_def Ball_def by blast - qed } + qed + } with th0 show ?thesis by blast qed lemma span_induct_alt: - assumes h0: "h 0" and hS: "\c x y. x \ S \ h y \ h (c *\<^sub>R x + y)" and x: "x \ span S" + assumes h0: "h 0" + and hS: "\c x y. x \ S \ h y \ h (c *\<^sub>R x + y)" + and x: "x \ span S" shows "h x" using span_induct_alt'[of h S] h0 hS x by blast @@ -825,35 +917,43 @@ lemma span_span: "span (span A) = span A" unfolding span_def hull_hull .. -lemma (in real_vector) span_superset: "x \ S ==> x \ span S" by (metis span_clauses(1)) - -lemma (in real_vector) span_0: "0 \ span S" by (metis subspace_span subspace_0) +lemma (in real_vector) span_superset: "x \ S \ x \ span S" + by (metis span_clauses(1)) + +lemma (in real_vector) span_0: "0 \ span S" + by (metis subspace_span subspace_0) lemma span_inc: "S \ span S" by (metis subset_eq span_superset) -lemma (in real_vector) dependent_0: assumes "0\A" shows "dependent A" - unfolding dependent_def apply(rule_tac x=0 in bexI) - using assms span_0 by auto - -lemma (in real_vector) span_add: "x \ span S \ y \ span S ==> x + y \ span S" +lemma (in real_vector) dependent_0: + assumes "0 \ A" + shows "dependent A" + unfolding dependent_def + apply (rule_tac x=0 in bexI) + using assms span_0 + apply auto + done + +lemma (in real_vector) span_add: "x \ span S \ y \ span S \ x + y \ span S" by (metis subspace_add subspace_span) -lemma (in real_vector) span_mul: "x \ span S ==> (c *\<^sub>R x) \ span S" +lemma (in real_vector) span_mul: "x \ span S \ c *\<^sub>R x \ span S" by (metis subspace_span subspace_mul) -lemma span_neg: "x \ span S ==> - x \ span S" +lemma span_neg: "x \ span S \ - x \ span S" by (metis subspace_neg subspace_span) -lemma span_sub: "x \ span S \ y \ span S ==> x - y \ span S" +lemma span_sub: "x \ span S \ y \ span S \ x - y \ span S" by (metis subspace_span subspace_sub) -lemma (in real_vector) span_setsum: "finite A \ \x \ A. f x \ span S ==> setsum f A \ span S" +lemma (in real_vector) span_setsum: "finite A \ \x \ A. f x \ span S \ setsum f A \ span S" by (rule subspace_setsum, rule subspace_span) lemma span_add_eq: "x \ span S \ x + y \ span S \ y \ span S" apply (auto simp only: span_add span_sub) - apply (subgoal_tac "(x + y) - x \ span S", simp) + apply (subgoal_tac "(x + y) - x \ span S") + apply simp apply (simp only: span_add span_sub) done @@ -871,7 +971,8 @@ show "subspace (f ` span S)" using lf subspace_span by (rule subspace_linear_image) next - fix T assume "f ` S \ T" and "subspace T" + fix T + assume "f ` S \ T" and "subspace T" then show "f ` span S \ T" unfolding image_subset_iff_subset_vimage by (intro span_minimal subspace_linear_vimage lf) @@ -904,7 +1005,10 @@ show "subspace (range (\k. k *\<^sub>R x))" unfolding subspace_def by (auto intro: scaleR_add_left [symmetric]) - fix T assume "{x} \ T" and "subspace T" then show "range (\k. k *\<^sub>R x) \ T" +next + fix T + assume "{x} \ T" and "subspace T" + then show "range (\k. k *\<^sub>R x) \ T" unfolding subspace_def by auto qed @@ -922,12 +1026,13 @@ qed lemma span_breakdown: - assumes bS: "b \ S" and aS: "a \ span S" + assumes bS: "b \ S" + and aS: "a \ span S" shows "\k. a - k *\<^sub>R b \ span (S - {b})" using assms span_insert [of b "S - {b}"] by (simp add: insert_absorb) -lemma span_breakdown_eq: "x \ span (insert a S) \ (\k. (x - k *\<^sub>R a) \ span S)" +lemma span_breakdown_eq: "x \ span (insert a S) \ (\k. x - k *\<^sub>R a \ span S)" by (simp add: span_insert) text {* Hence some "reversal" results. *} @@ -939,7 +1044,9 @@ proof - from span_breakdown[of b "insert b S" a, OF insertI1 a] obtain k where k: "a - k*\<^sub>R b \ span (S - {b})" by auto - { assume k0: "k = 0" + show ?thesis + proof (cases "k = 0") + case True with k have "a \ span S" apply (simp) apply (rule set_rev_mp) @@ -947,19 +1054,17 @@ apply (rule span_mono) apply blast done - with na have ?thesis by blast } - moreover - { assume k0: "k \ 0" + with na show ?thesis by blast + next + case False have eq: "b = (1/k) *\<^sub>R a - ((1/k) *\<^sub>R a - b)" by simp - from k0 have eq': "(1/k) *\<^sub>R (a - k*\<^sub>R b) = (1/k) *\<^sub>R a - b" + from False have eq': "(1/k) *\<^sub>R (a - k*\<^sub>R b) = (1/k) *\<^sub>R a - b" by (simp add: algebra_simps) from k have "(1/k) *\<^sub>R (a - k*\<^sub>R b) \ span (S - {b})" by (rule span_mul) then have th: "(1/k) *\<^sub>R a - b \ span (S - {b})" unfolding eq' . - - from k - have ?thesis + from k show ?thesis apply (subst eq) apply (rule span_sub) apply (rule span_mul) @@ -968,8 +1073,10 @@ apply (rule set_rev_mp) apply (rule th) apply (rule span_mono) - using na by blast } - ultimately show ?thesis by blast + using na + apply blast + done + qed qed lemma in_span_delete: @@ -990,7 +1097,8 @@ unfolding span_def by (rule hull_redundant) lemma span_trans: - assumes x: "x \ span S" and y: "y \ span (insert x S)" + assumes x: "x \ span S" + and y: "y \ span (insert x S)" shows "y \ span S" using assms by (simp only: span_redundant) @@ -1003,7 +1111,9 @@ "span P = {y. \S u. finite S \ S \ P \ setsum (\v. u v *\<^sub>R v) S = y}" (is "_ = ?E" is "_ = {y. ?h y}" is "_ = {y. \S u. ?Q S u y}") proof - - { fix x assume x: "x \ ?E" + { + fix x + assume x: "x \ ?E" then obtain S u where fS: "finite S" and SP: "S\P" and u: "setsum (\v. u v *\<^sub>R v) S = x" by blast have "x \ span P" @@ -1011,7 +1121,8 @@ apply (rule span_setsum[OF fS]) using span_mono[OF SP] apply (auto intro: span_superset span_mul) - done } + done + } moreover have "\x \ span P. x \ ?E" proof (rule span_induct_alt') @@ -1022,15 +1133,20 @@ done next fix c x y - assume x: "x \ P" and hy: "y \ Collect ?h" + assume x: "x \ P" + assume hy: "y \ Collect ?h" from hy obtain S u where fS: "finite S" and SP: "S\P" and u: "setsum (\v. u v *\<^sub>R v) S = y" by blast let ?S = "insert x S" let ?u = "\y. if y = x then (if x \ S then u y + c else c) else u y" - from fS SP x have th0: "finite (insert x S)" "insert x S \ P" by blast+ - { assume xS: "x \ S" + from fS SP x have th0: "finite (insert x S)" "insert x S \ P" + by blast+ + have "?Q ?S ?u (c*\<^sub>R x + y)" + proof cases + assume xS: "x \ S" have S1: "S = (S - {x}) \ {x}" - and Sss:"finite (S - {x})" "finite {x}" "(S -{x}) \ {x} = {}" using xS fS by auto + and Sss:"finite (S - {x})" "finite {x}" "(S -{x}) \ {x} = {}" + using xS fS by auto have "setsum (\v. ?u v *\<^sub>R v) ?S =(\v\S - {x}. u v *\<^sub>R v) + (u x + c) *\<^sub>R x" using xS by (simp add: setsum_Un_disjoint[OF Sss, unfolded S1[symmetric]] @@ -1042,17 +1158,18 @@ also have "\ = c*\<^sub>R x + y" by (simp add: add_commute u) finally have "setsum (\v. ?u v *\<^sub>R v) ?S = c*\<^sub>R x + y" . - then have "?Q ?S ?u (c*\<^sub>R x + y)" using th0 by blast } - moreover - { assume xS: "x \ S" + then show ?thesis using th0 by blast + next + assume xS: "x \ S" have th00: "(\v\S. (if v = x then c else u v) *\<^sub>R v) = y" unfolding u[symmetric] apply (rule setsum_cong2) - using xS apply auto + using xS + apply auto done - have "?Q ?S ?u (c*\<^sub>R x + y)" using fS xS th0 - by (simp add: th00 setsum_clauses add_commute cong del: if_weak_cong) } - ultimately have "?Q ?S ?u (c*\<^sub>R x + y)" by (cases "x \ S") simp_all + show ?thesis using fS xS th0 + by (simp add: th00 setsum_clauses add_commute cong del: if_weak_cong) + qed then show "(c*\<^sub>R x + y) \ Collect ?h" unfolding mem_Collect_eq apply - @@ -1068,15 +1185,18 @@ "dependent P \ (\S u. finite S \ S \ P \ (\v\S. u v \ 0 \ setsum (\v. u v *\<^sub>R v) S = 0))" (is "?lhs = ?rhs") proof - - { assume dP: "dependent P" + { + assume dP: "dependent P" then obtain a S u where aP: "a \ P" and fS: "finite S" and SP: "S \ P - {a}" and ua: "setsum (\v. u v *\<^sub>R v) S = a" unfolding dependent_def span_explicit by blast let ?S = "insert a S" let ?u = "\y. if y = a then - 1 else u y" let ?v = a - from aP SP have aS: "a \ S" by blast - from fS SP aP have th0: "finite ?S" "?S \ P" "?v \ ?S" "?u ?v \ 0" by auto + from aP SP have aS: "a \ S" + by blast + from fS SP aP have th0: "finite ?S" "?S \ P" "?v \ ?S" "?u ?v \ 0" + by auto have s0: "setsum (\v. ?u v *\<^sub>R v) ?S = 0" using fS aS apply (simp add: setsum_clauses field_simps) @@ -1092,18 +1212,24 @@ done } moreover - { fix S u v + { + fix S u v assume fS: "finite S" - and SP: "S \ P" and vS: "v \ S" and uv: "u v \ 0" + and SP: "S \ P" + and vS: "v \ S" + and uv: "u v \ 0" and u: "setsum (\v. u v *\<^sub>R v) S = 0" let ?a = v let ?S = "S - {v}" let ?u = "\i. (- u i) / u v" - have th0: "?a \ P" "finite ?S" "?S \ P" using fS SP vS by auto - have "setsum (\v. ?u v *\<^sub>R v) ?S = setsum (\v. (- (inverse (u ?a))) *\<^sub>R (u v *\<^sub>R v)) S - ?u v *\<^sub>R v" + have th0: "?a \ P" "finite ?S" "?S \ P" + using fS SP vS by auto + have "setsum (\v. ?u v *\<^sub>R v) ?S = + setsum (\v. (- (inverse (u ?a))) *\<^sub>R (u v *\<^sub>R v)) S - ?u v *\<^sub>R v" using fS vS uv by (simp add: setsum_diff1 divide_inverse field_simps) - also have "\ = ?a" unfolding scaleR_right.setsum [symmetric] u using uv by simp - finally have "setsum (\v. ?u v *\<^sub>R v) ?S = ?a" . + also have "\ = ?a" + unfolding scaleR_right.setsum [symmetric] u using uv by simp + finally have "setsum (\v. ?u v *\<^sub>R v) ?S = ?a" . with th0 have ?lhs unfolding dependent_def span_explicit apply - @@ -1122,61 +1248,72 @@ shows "span S = {y. \u. setsum (\v. u v *\<^sub>R v) S = y}" (is "_ = ?rhs") proof - - { fix y + { + fix y assume y: "y \ span S" - from y obtain S' u where fS': "finite S'" and SS': "S' \ S" and - u: "setsum (\v. u v *\<^sub>R v) S' = y" unfolding span_explicit by blast + from y obtain S' u where fS': "finite S'" + and SS': "S' \ S" + and u: "setsum (\v. u v *\<^sub>R v) S' = y" + unfolding span_explicit by blast let ?u = "\x. if x \ S' then u x else 0" have "setsum (\v. ?u v *\<^sub>R v) S = setsum (\v. u v *\<^sub>R v) S'" using SS' fS by (auto intro!: setsum_mono_zero_cong_right) then have "setsum (\v. ?u v *\<^sub>R v) S = y" by (metis u) - then have "y \ ?rhs" by auto } + then have "y \ ?rhs" by auto + } moreover - { fix y u + { + fix y u assume u: "setsum (\v. u v *\<^sub>R v) S = y" - then have "y \ span S" using fS unfolding span_explicit by auto } + then have "y \ span S" using fS unfolding span_explicit by auto + } ultimately show ?thesis by blast qed text {* This is useful for building a basis step-by-step. *} lemma independent_insert: - "independent(insert a S) \ - (if a \ S then independent S - else independent S \ a \ span S)" (is "?lhs \ ?rhs") -proof - - { assume aS: "a \ S" - then have ?thesis using insert_absorb[OF aS] by simp } - moreover - { assume aS: "a \ S" - { assume i: ?lhs - then have ?rhs using aS - apply simp - apply (rule conjI) - apply (rule independent_mono) - apply assumption - apply blast - apply (simp add: dependent_def) - done } - moreover - { assume i: ?rhs - have ?lhs using i aS - apply simp - apply (auto simp add: dependent_def) - apply (case_tac "aa = a", auto) - apply (subgoal_tac "insert a S - {aa} = insert a (S - {aa})") - apply simp - apply (subgoal_tac "a \ span (insert aa (S - {aa}))") - apply (subgoal_tac "insert aa (S - {aa}) = S") - apply simp - apply blast - apply (rule in_span_insert) - apply assumption - apply blast - apply blast - done } - ultimately have ?thesis by blast } - ultimately show ?thesis by blast + "independent (insert a S) \ + (if a \ S then independent S else independent S \ a \ span S)" + (is "?lhs \ ?rhs") +proof (cases "a \ S") + case True + then show ?thesis + using insert_absorb[OF True] by simp +next + case False + show ?thesis + proof + assume i: ?lhs + then show ?rhs + using False + apply simp + apply (rule conjI) + apply (rule independent_mono) + apply assumption + apply blast + apply (simp add: dependent_def) + done + next + assume i: ?rhs + show ?lhs + using i False + apply simp + apply (auto simp add: dependent_def) + apply (case_tac "aa = a") + apply auto + apply (subgoal_tac "insert a S - {aa} = insert a (S - {aa})") + apply simp + apply (subgoal_tac "a \ span (insert aa (S - {aa}))") + apply (subgoal_tac "insert aa (S - {aa}) = S") + apply simp + apply blast + apply (rule in_span_insert) + apply assumption + apply blast + apply blast + done + qed qed text {* The degenerate case of the Exchange Lemma. *} @@ -1195,18 +1332,29 @@ from span_mono[OF BA] span_mono[OF AsB] have sAB: "span A = span B" unfolding span_span by blast - { fix x assume x: "x \ A" + { + fix x + assume x: "x \ A" from iA have th0: "x \ span (A - {x})" unfolding dependent_def using x by blast - from x have xsA: "x \ span A" by (blast intro: span_superset) + from x have xsA: "x \ span A" + by (blast intro: span_superset) have "A - {x} \ A" by blast - then have th1:"span (A - {x}) \ span A" by (metis span_mono) - { assume xB: "x \ B" - from xB BA have "B \ A -{x}" by blast - then have "span B \ span (A - {x})" by (metis span_mono) - with th1 th0 sAB have "x \ span A" by blast - with x have False by (metis span_superset) } - then have "x \ B" by blast } + then have th1: "span (A - {x}) \ span A" + by (metis span_mono) + { + assume xB: "x \ B" + from xB BA have "B \ A - {x}" + by blast + then have "span B \ span (A - {x})" + by (metis span_mono) + with th1 th0 sAB have "x \ span A" + by blast + with x have False + by (metis span_superset) + } + then have "x \ B" by blast + } then show "A \ B" by blast qed @@ -1216,75 +1364,110 @@ assumes f:"finite t" and i: "independent s" and sp: "s \ span t" - shows "\t'. (card t' = card t) \ finite t' \ s \ t' \ t' \ s \ t \ s \ span t'" + shows "\t'. card t' = card t \ finite t' \ s \ t' \ t' \ s \ t \ s \ span t'" using f i sp proof (induct "card (t - s)" arbitrary: s t rule: less_induct) case less note ft = `finite t` and s = `independent s` and sp = `s \ span t` - let ?P = "\t'. (card t' = card t) \ finite t' \ s \ t' \ t' \ s \ t \ s \ span t'" + let ?P = "\t'. card t' = card t \ finite t' \ s \ t' \ t' \ s \ t \ s \ span t'" let ?ths = "\t'. ?P t'" - { assume st: "s \ t" - from st ft span_mono[OF st] have ?ths apply - apply (rule exI[where x=t]) + { + assume st: "s \ t" + from st ft span_mono[OF st] + have ?ths + apply - + apply (rule exI[where x=t]) apply (auto intro: span_superset) - done } + done + } moreover - { assume st: "t \ s" - from spanning_subset_independent[OF st s sp] - st ft span_mono[OF st] have ?ths - apply - - apply (rule exI[where x=t]) - apply (auto intro: span_superset) - done } + { + assume st: "t \ s" + from spanning_subset_independent[OF st s sp] st ft span_mono[OF st] + have ?ths + apply - + apply (rule exI[where x=t]) + apply (auto intro: span_superset) + done + } moreover - { assume st: "\ s \ t" "\ t \ s" - from st(2) obtain b where b: "b \ t" "b \ s" by blast - from b have "t - {b} - s \ t - s" by blast - then have cardlt: "card (t - {b} - s) < card (t - s)" using ft - by (auto intro: psubset_card_mono) - from b ft have ct0: "card t \ 0" by auto - { assume stb: "s \ span(t -{b})" - from ft have ftb: "finite (t -{b})" by auto + { + assume st: "\ s \ t" "\ t \ s" + from st(2) obtain b where b: "b \ t" "b \ s" + by blast + from b have "t - {b} - s \ t - s" + by blast + then have cardlt: "card (t - {b} - s) < card (t - s)" + using ft by (auto intro: psubset_card_mono) + from b ft have ct0: "card t \ 0" + by auto + have ?ths + proof cases + assume stb: "s \ span(t - {b})" + from ft have ftb: "finite (t -{b})" + by auto from less(1)[OF cardlt ftb s stb] obtain u where u: "card u = card (t-{b})" "s \ u" "u \ s \ (t - {b})" "s \ span u" and fu: "finite u" by blast let ?w = "insert b u" - have th0: "s \ insert b u" using u by blast - from u(3) b have "u \ s \ t" by blast - then have th1: "insert b u \ s \ t" using u b by blast - have bu: "b \ u" using b u by blast - from u(1) ft b have "card u = (card t - 1)" by auto + have th0: "s \ insert b u" + using u by blast + from u(3) b have "u \ s \ t" + by blast + then have th1: "insert b u \ s \ t" + using u b by blast + have bu: "b \ u" + using b u by blast + from u(1) ft b have "card u = (card t - 1)" + by auto then have th2: "card (insert b u) = card t" using card_insert_disjoint[OF fu bu] ct0 by auto from u(4) have "s \ span u" . - also have "\ \ span (insert b u)" apply (rule span_mono) by blast + also have "\ \ span (insert b u)" + by (rule span_mono) blast finally have th3: "s \ span (insert b u)" . - from th0 th1 th2 th3 fu have th: "?P ?w" by blast - from th have ?ths by blast } - moreover - { assume stb: "\ s \ span(t -{b})" - from stb obtain a where a: "a \ s" "a \ span (t - {b})" by blast - have ab: "a \ b" using a b by blast - have at: "a \ t" using a ab span_superset[of a "t- {b}"] by auto + from th0 th1 th2 th3 fu have th: "?P ?w" + by blast + from th show ?thesis by blast + next + assume stb: "\ s \ span(t - {b})" + from stb obtain a where a: "a \ s" "a \ span (t - {b})" + by blast + have ab: "a \ b" + using a b by blast + have at: "a \ t" + using a ab span_superset[of a "t- {b}"] by auto have mlt: "card ((insert a (t - {b})) - s) < card (t - s)" using cardlt ft a b by auto - have ft': "finite (insert a (t - {b}))" using ft by auto - { fix x assume xs: "x \ s" - have t: "t \ (insert b (insert a (t -{b})))" using b by auto - from b(1) have "b \ span t" by (simp add: span_superset) - have bs: "b \ span (insert a (t - {b}))" apply(rule in_span_delete) - using a sp unfolding subset_eq apply auto done - from xs sp have "x \ span t" by blast - with span_mono[OF t] - have x: "x \ span (insert b (insert a (t - {b})))" .. - from span_trans[OF bs x] have "x \ span (insert a (t - {b}))" . } - then have sp': "s \ span (insert a (t - {b}))" by blast - - from less(1)[OF mlt ft' s sp'] obtain u where - u: "card u = card (insert a (t -{b}))" "finite u" "s \ u" "u \ s \ insert a (t -{b})" - "s \ span u" by blast - from u a b ft at ct0 have "?P u" by auto - then have ?ths by blast } - ultimately have ?ths by blast + have ft': "finite (insert a (t - {b}))" + using ft by auto + { + fix x + assume xs: "x \ s" + have t: "t \ insert b (insert a (t - {b}))" + using b by auto + from b(1) have "b \ span t" + by (simp add: span_superset) + have bs: "b \ span (insert a (t - {b}))" + apply (rule in_span_delete) + using a sp unfolding subset_eq + apply auto + done + from xs sp have "x \ span t" + by blast + with span_mono[OF t] have x: "x \ span (insert b (insert a (t - {b})))" .. + from span_trans[OF bs x] have "x \ span (insert a (t - {b}))" . + } + then have sp': "s \ span (insert a (t - {b}))" + by blast + from less(1)[OF mlt ft' s sp'] obtain u where u: + "card u = card (insert a (t -{b}))" + "finite u" "s \ u" "u \ s \ insert a (t -{b})" + "s \ span u" by blast + from u a b ft at ct0 have "?P u" + by auto + then show ?thesis by blast + qed } ultimately show ?ths by blast qed @@ -1292,21 +1475,24 @@ text {* This implies corresponding size bounds. *} lemma independent_span_bound: - assumes f: "finite t" and i: "independent s" and sp:"s \ span t" + assumes f: "finite t" + and i: "independent s" + and sp: "s \ span t" shows "finite s \ card s \ card t" by (metis exchange_lemma[OF f i sp] finite_subset card_mono) - lemma finite_Atleast_Atmost_nat[simp]: "finite {f x |x. x\ (UNIV::'a::finite set)}" proof - - have eq: "{f x |x. x\ UNIV} = f ` UNIV" by auto + have eq: "{f x |x. x\ UNIV} = f ` UNIV" + by auto show ?thesis unfolding eq apply (rule finite_imageI) apply (rule finite) done qed -subsection{* Euclidean Spaces as Typeclass*} + +subsection {* Euclidean Spaces as Typeclass *} lemma independent_Basis: "independent Basis" unfolding dependent_def @@ -1345,7 +1531,8 @@ lemma setsum_norm_allsubsets_bound: fixes f:: "'a \ 'n::euclidean_space" - assumes fP: "finite P" and fPs: "\Q. Q \ P \ norm (setsum f Q) \ e" + assumes fP: "finite P" + and fPs: "\Q. Q \ P \ norm (setsum f Q) \ e" shows "(\x\P. norm (f x)) \ 2 * real DIM('n) * e" proof - have "(\x\P. norm (f x)) \ (\x\P. \b\Basis. \f x \ b\)" @@ -1354,13 +1541,14 @@ by (rule setsum_commute) also have "\ \ of_nat (card (Basis :: 'n set)) * (2 * e)" proof (rule setsum_bounded) - fix i :: 'n assume i: "i \ Basis" - have "norm (\x\P. \f x \ i\) \ + fix i :: 'n + assume i: "i \ Basis" + have "norm (\x\P. \f x \ i\) \ norm ((\x\P \ - {x. f x \ i < 0}. f x) \ i) + norm ((\x\P \ {x. f x \ i < 0}. f x) \ i)" by (simp add: abs_real_def setsum_cases[OF fP] setsum_negf uminus_add_conv_diff - norm_triangle_ineq4 inner_setsum_left - del: real_norm_def) - also have "\ \ e + e" unfolding real_norm_def + norm_triangle_ineq4 inner_setsum_left del: real_norm_def) + also have "\ \ e + e" + unfolding real_norm_def by (intro add_mono norm_bound_Basis_le i fPs) auto finally show "(\x\P. \f x \ i\) \ 2*e" by simp qed @@ -1369,6 +1557,7 @@ finally show ?thesis . qed + subsection {* Linearity and Bilinearity continued *} lemma linear_bounded: @@ -1377,25 +1566,32 @@ shows "\B. \x. norm (f x) \ B * norm x" proof - let ?B = "\b\Basis. norm (f b)" - { fix x:: "'a" + { + fix x :: 'a let ?g = "\b. (x \ b) *\<^sub>R f b" have "norm (f x) = norm (f (\b\Basis. (x \ b) *\<^sub>R b))" unfolding euclidean_representation .. also have "\ = norm (setsum ?g Basis)" - using linear_setsum[OF lf finite_Basis, of "\b. (x \ b) *\<^sub>R b", unfolded o_def] linear_cmul[OF lf] by auto + using linear_setsum[OF lf finite_Basis, of "\b. (x \ b) *\<^sub>R b", unfolded o_def] linear_cmul[OF lf] + by auto finally have th0: "norm (f x) = norm (setsum ?g Basis)" . - { fix i :: 'a assume i: "i \ Basis" + { + fix i :: 'a + assume i: "i \ Basis" from Basis_le_norm[OF i, of x] have "norm (?g i) \ norm (f i) * norm x" unfolding norm_scaleR apply (subst mult_commute) apply (rule mult_mono) apply (auto simp add: field_simps) - done } + done + } then have th: "\b\Basis. norm (?g b) \ norm (f b) * norm x" by metis from setsum_norm_le[of _ ?g, OF th] - have "norm (f x) \ ?B * norm x" unfolding th0 setsum_left_distrib by metis} + have "norm (f x) \ ?B * norm x" + unfolding th0 setsum_left_distrib by metis + } then show ?thesis by blast qed @@ -1408,7 +1604,8 @@ B: "\x. norm (f x) \ B * norm x" by blast let ?K = "\B\ + 1" have Kp: "?K > 0" by arith - { assume C: "B < 0" + { + assume C: "B < 0" def One \ "\Basis ::'a" then have "One \ 0" unfolding euclidean_eq_iff[where 'a='a] @@ -1419,14 +1616,18 @@ with B[rule_format, of One] norm_ge_zero[of "f One"] have False by simp } - then have Bp: "B \ 0" by (metis not_leE) - { fix x::"'a" + then have Bp: "B \ 0" + by (metis not_leE) + { + fix x::"'a" have "norm (f x) \ ?K * norm x" using B[rule_format, of x] norm_ge_zero[of x] norm_ge_zero[of "f x"] Bp apply (auto simp add: field_simps split add: abs_split) apply (erule order_trans, simp) done - } then show ?thesis using Kp by blast + } + then show ?thesis + using Kp by blast qed lemma linear_conv_bounded_linear: @@ -1436,10 +1637,12 @@ assume "linear f" show "bounded_linear f" proof - fix x y show "f (x + y) = f x + f y" + fix x y + show "f (x + y) = f x + f y" using `linear f` unfolding linear_def by simp next - fix r x show "f (scaleR r x) = scaleR r (f x)" + fix r x + show "f (scaleR r x) = scaleR r (f x)" using `linear f` unfolding linear_def by simp next have "\B. \x. norm (f x) \ B * norm x" @@ -1450,43 +1653,43 @@ next assume "bounded_linear f" then interpret f: bounded_linear f . - show "linear f" - by (simp add: f.add f.scaleR linear_def) + show "linear f" by (simp add: f.add f.scaleR linear_def) qed lemma bounded_linearI': fixes f::"'a::euclidean_space \ 'b::real_normed_vector" - assumes "\x y. f (x + y) = f x + f y" "\c x. f (c *\<^sub>R x) = c *\<^sub>R f x" + assumes "\x y. f (x + y) = f x + f y" + and "\c x. f (c *\<^sub>R x) = c *\<^sub>R f x" shows "bounded_linear f" - unfolding linear_conv_bounded_linear[THEN sym] + unfolding linear_conv_bounded_linear[symmetric] by (rule linearI[OF assms]) - lemma bilinear_bounded: fixes h:: "'m::euclidean_space \ 'n::euclidean_space \ 'k::real_normed_vector" assumes bh: "bilinear h" shows "\B. \x y. norm (h x y) \ B * norm x * norm y" proof (clarify intro!: exI[of _ "\i\Basis. \j\Basis. norm (h i j)"]) - fix x:: "'m" and y :: "'n" - have "norm (h x y) = norm (h (setsum (\i. (x \ i) *\<^sub>R i) Basis) (setsum (\i. (y \ i) *\<^sub>R i) Basis))" - apply(subst euclidean_representation[where 'a='m]) - apply(subst euclidean_representation[where 'a='n]) + fix x :: 'm + fix y :: 'n + have "norm (h x y) = norm (h (setsum (\i. (x \ i) *\<^sub>R i) Basis) (setsum (\i. (y \ i) *\<^sub>R i) Basis))" + apply (subst euclidean_representation[where 'a='m]) + apply (subst euclidean_representation[where 'a='n]) apply rule done - also have "\ = norm (setsum (\ (i,j). h ((x \ i) *\<^sub>R i) ((y \ j) *\<^sub>R j)) (Basis \ Basis))" + also have "\ = norm (setsum (\ (i,j). h ((x \ i) *\<^sub>R i) ((y \ j) *\<^sub>R j)) (Basis \ Basis))" unfolding bilinear_setsum[OF bh finite_Basis finite_Basis] .. finally have th: "norm (h x y) = \" . show "norm (h x y) \ (\i\Basis. \j\Basis. norm (h i j)) * norm x * norm y" - apply (auto simp add: setsum_left_distrib th setsum_cartesian_product) - apply (rule setsum_norm_le) - apply simp - apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh] - field_simps simp del: scaleR_scaleR) - apply (rule mult_mono) - apply (auto simp add: zero_le_mult_iff Basis_le_norm) - apply (rule mult_mono) - apply (auto simp add: zero_le_mult_iff Basis_le_norm) - done + apply (auto simp add: setsum_left_distrib th setsum_cartesian_product) + apply (rule setsum_norm_le) + apply simp + apply (auto simp add: bilinear_rmul[OF bh] bilinear_lmul[OF bh] + field_simps simp del: scaleR_scaleR) + apply (rule mult_mono) + apply (auto simp add: zero_le_mult_iff Basis_le_norm) + apply (rule mult_mono) + apply (auto simp add: zero_le_mult_iff Basis_le_norm) + done qed lemma bilinear_bounded_pos: @@ -1499,15 +1702,17 @@ let ?K = "\B\ + 1" have Kp: "?K > 0" by arith have KB: "B < ?K" by arith - { fix x::'a and y::'b - from KB Kp - have "B * norm x * norm y \ ?K * norm x * norm y" + { + fix x :: 'a + fix y :: 'b + from KB Kp have "B * norm x * norm y \ ?K * norm x * norm y" apply - apply (rule mult_right_mono, rule mult_right_mono) apply auto done then have "norm (h x y) \ ?K * norm x * norm y" - using B[rule_format, of x y] by simp } + using B[rule_format, of x y] by simp + } with Kp show ?thesis by blast qed @@ -1518,17 +1723,21 @@ assume "bilinear h" show "bounded_bilinear h" proof - fix x y z show "h (x + y) z = h x z + h y z" + fix x y z + show "h (x + y) z = h x z + h y z" using `bilinear h` unfolding bilinear_def linear_def by simp next - fix x y z show "h x (y + z) = h x y + h x z" + fix x y z + show "h x (y + z) = h x y + h x z" using `bilinear h` unfolding bilinear_def linear_def by simp next - fix r x y show "h (scaleR r x) y = scaleR r (h x y)" + fix r x y + show "h (scaleR r x) y = scaleR r (h x y)" using `bilinear h` unfolding bilinear_def linear_def by simp next - fix r x y show "h x (scaleR r y) = scaleR r (h x y)" + fix r x y + show "h x (scaleR r y) = scaleR r (h x y)" using `bilinear h` unfolding bilinear_def linear_def by simp next @@ -1554,13 +1763,14 @@ using independent_span_bound[OF finite_Basis, of S] by auto lemma dependent_biggerset: - "(finite (S::('a::euclidean_space) set) ==> card S > DIM('a)) ==> dependent S" + "(finite (S::('a::euclidean_space) set) \ card S > DIM('a)) \ dependent S" by (metis independent_bound not_less) text {* Hence we can create a maximal independent subset. *} lemma maximal_independent_subset_extend: - assumes sv: "(S::('a::euclidean_space) set) \ V" + fixes S :: "'a::euclidean_space set" + assumes sv: "S \ V" and iS: "independent S" shows "\B. S \ B \ B \ V \ independent B \ V \ span B" using sv iS @@ -1570,15 +1780,22 @@ let ?P = "\B. S \ B \ B \ V \ independent B \ V \ span B" let ?ths = "\x. ?P x" let ?d = "DIM('a)" - { assume "V \ span S" - then have ?ths using sv i by blast } - moreover - { assume VS: "\ V \ span S" - from VS obtain a where a: "a \ V" "a \ span S" by blast - from a have aS: "a \ S" by (auto simp add: span_superset) - have th0: "insert a S \ V" using a sv by blast + show ?ths + proof (cases "V \ span S") + case True + then show ?thesis + using sv i by blast + next + case False + then obtain a where a: "a \ V" "a \ span S" + by blast + from a have aS: "a \ S" + by (auto simp add: span_superset) + have th0: "insert a S \ V" + using a sv by blast from independent_insert[of a S] i a - have th1: "independent (insert a S)" by auto + have th1: "independent (insert a S)" + by auto have mlt: "?d - card (insert a S) < ?d - card S" using aS a independent_bound[OF th1] by auto @@ -1586,8 +1803,8 @@ obtain B where B: "insert a S \ B" "B \ V" "independent B" " V \ span B" by blast from B have "?P B" by auto - then have ?ths by blast } - ultimately show ?ths by blast + then show ?thesis by blast + qed qed lemma maximal_independent_subset: @@ -1598,7 +1815,7 @@ text {* Notion of dimension. *} -definition "dim V = (SOME n. \B. B \ V \ independent B \ V \ span B \ (card B = n))" +definition "dim V = (SOME n. \B. B \ V \ independent B \ V \ span B \ card B = n)" lemma basis_exists: "\B. (B :: ('a::euclidean_space) set) \ V \ independent B \ V \ span B \ (card B = dim V)" @@ -1608,58 +1825,76 @@ text {* Consequences of independence or spanning for cardinality. *} -lemma independent_card_le_dim: - assumes "(B::('a::euclidean_space) set) \ V" and "independent B" +lemma independent_card_le_dim: + fixes B :: "'a::euclidean_space set" + assumes "B \ V" + and "independent B" shows "card B \ dim V" proof - from basis_exists[of V] `B \ V` - obtain B' where "independent B'" and "B \ span B'" and "card B' = dim V" by blast + obtain B' where "independent B'" + and "B \ span B'" + and "card B' = dim V" + by blast with independent_span_bound[OF _ `independent B` `B \ span B'`] independent_bound[of B'] show ?thesis by auto qed lemma span_card_ge_dim: - "(B::('a::euclidean_space) set) \ V \ V \ span B \ finite B \ dim V \ card B" + fixes B :: "'a::euclidean_space set" + shows "B \ V \ V \ span B \ finite B \ dim V \ card B" by (metis basis_exists[of V] independent_span_bound subset_trans) lemma basis_card_eq_dim: - "B \ (V:: ('a::euclidean_space) set) \ V \ span B \ - independent B \ finite B \ card B = dim V" + fixes V :: "'a::euclidean_space set" + shows "B \ V \ V \ span B \ independent B \ finite B \ card B = dim V" by (metis order_eq_iff independent_card_le_dim span_card_ge_dim independent_bound) -lemma dim_unique: "(B::('a::euclidean_space) set) \ V \ V \ span B \ - independent B \ card B = n \ dim V = n" +lemma dim_unique: + fixes B :: "'a::euclidean_space set" + shows "B \ V \ V \ span B \ independent B \ card B = n \ dim V = n" by (metis basis_card_eq_dim) text {* More lemmas about dimension. *} -lemma dim_UNIV: "dim (UNIV :: ('a::euclidean_space) set) = DIM('a)" +lemma dim_UNIV: "dim (UNIV :: 'a::euclidean_space set) = DIM('a)" using independent_Basis by (intro dim_unique[of Basis]) auto lemma dim_subset: - "(S:: ('a::euclidean_space) set) \ T \ dim S \ dim T" + fixes S :: "'a::euclidean_space set" + shows "S \ T \ dim S \ dim T" using basis_exists[of T] basis_exists[of S] by (metis independent_card_le_dim subset_trans) -lemma dim_subset_UNIV: "dim (S:: ('a::euclidean_space) set) \ DIM('a)" +lemma dim_subset_UNIV: + fixes S :: "'a::euclidean_space set" + shows "dim S \ DIM('a)" by (metis dim_subset subset_UNIV dim_UNIV) text {* Converses to those. *} lemma card_ge_dim_independent: - assumes BV:"(B::('a::euclidean_space) set) \ V" - and iB:"independent B" and dVB:"dim V \ card B" + fixes B :: "'a::euclidean_space set" + assumes BV: "B \ V" + and iB: "independent B" + and dVB: "dim V \ card B" shows "V \ span B" -proof - - { fix a assume aV: "a \ V" - { assume aB: "a \ span B" - then have iaB: "independent (insert a B)" using iB aV BV by (simp add: independent_insert) - from aV BV have th0: "insert a B \ V" by blast - from aB have "a \B" by (auto simp add: span_superset) - with independent_card_le_dim[OF th0 iaB] dVB independent_bound[OF iB] have False by auto } - then have "a \ span B" by blast } - then show ?thesis by blast +proof + fix a + assume aV: "a \ V" + { + assume aB: "a \ span B" + then have iaB: "independent (insert a B)" + using iB aV BV by (simp add: independent_insert) + from aV BV have th0: "insert a B \ V" + by blast + from aB have "a \B" + by (auto simp add: span_superset) + with independent_card_le_dim[OF th0 iaB] dVB independent_bound[OF iB] + have False by auto + } + then show "a \ span B" by blast qed lemma card_le_dim_spanning: @@ -1669,54 +1904,81 @@ and dVB: "dim V \ card B" shows "independent B" proof - - { fix a assume a: "a \ B" "a \ span (B -{a})" - from a fB have c0: "card B \ 0" by auto - from a fB have cb: "card (B -{a}) = card B - 1" by auto - from BV a have th0: "B -{a} \ V" by blast - { fix x assume x: "x \ V" - from a have eq: "insert a (B -{a}) = B" by blast - from x VB have x': "x \ span B" by blast + { + fix a + assume a: "a \ B" "a \ span (B -{a})" + from a fB have c0: "card B \ 0" + by auto + from a fB have cb: "card (B -{a}) = card B - 1" + by auto + from BV a have th0: "B -{a} \ V" + by blast + { + fix x + assume x: "x \ V" + from a have eq: "insert a (B -{a}) = B" + by blast + from x VB have x': "x \ span B" + by blast from span_trans[OF a(2), unfolded eq, OF x'] - have "x \ span (B -{a})" . } - then have th1: "V \ span (B -{a})" by blast - have th2: "finite (B -{a})" using fB by auto + have "x \ span (B -{a})" . + } + then have th1: "V \ span (B -{a})" + by blast + have th2: "finite (B -{a})" + using fB by auto from span_card_ge_dim[OF th0 th1 th2] have c: "dim V \ card (B -{a})" . - from c c0 dVB cb have False by simp } - then show ?thesis unfolding dependent_def by blast + from c c0 dVB cb have False by simp + } + then show ?thesis + unfolding dependent_def by blast qed -lemma card_eq_dim: "(B:: ('a::euclidean_space) set) \ V \ - card B = dim V \ finite B \ independent B \ V \ span B" +lemma card_eq_dim: + fixes B :: "'a::euclidean_space set" + shows "B \ V \ card B = dim V \ finite B \ independent B \ V \ span B" by (metis order_eq_iff card_le_dim_spanning card_ge_dim_independent) text {* More general size bound lemmas. *} lemma independent_bound_general: - "independent (S:: ('a::euclidean_space) set) \ finite S \ card S \ dim S" + fixes S :: "'a::euclidean_space set" + shows "independent S \ finite S \ card S \ dim S" by (metis independent_card_le_dim independent_bound subset_refl) lemma dependent_biggerset_general: - "(finite (S:: ('a::euclidean_space) set) \ card S > dim S) \ dependent S" + fixes S :: "'a::euclidean_space set" + shows "(finite S \ card S > dim S) \ dependent S" using independent_bound_general[of S] by (metis linorder_not_le) -lemma dim_span: "dim (span (S:: ('a::euclidean_space) set)) = dim S" +lemma dim_span: + fixes S :: "'a::euclidean_space set" + shows "dim (span S) = dim S" proof - have th0: "dim S \ dim (span S)" by (auto simp add: subset_eq intro: dim_subset span_superset) from basis_exists[of S] - obtain B where B: "B \ S" "independent B" "S \ span B" "card B = dim S" by blast - from B have fB: "finite B" "card B = dim S" using independent_bound by blast+ - have bSS: "B \ span S" using B(1) by (metis subset_eq span_inc) - have sssB: "span S \ span B" using span_mono[OF B(3)] by (simp add: span_span) + obtain B where B: "B \ S" "independent B" "S \ span B" "card B = dim S" + by blast + from B have fB: "finite B" "card B = dim S" + using independent_bound by blast+ + have bSS: "B \ span S" + using B(1) by (metis subset_eq span_inc) + have sssB: "span S \ span B" + using span_mono[OF B(3)] by (simp add: span_span) from span_card_ge_dim[OF bSS sssB fB(1)] th0 show ?thesis using fB(2) by arith qed -lemma subset_le_dim: "(S:: ('a::euclidean_space) set) \ span T \ dim S \ dim T" +lemma subset_le_dim: + fixes S :: "'a::euclidean_space set" + shows "S \ span T \ dim S \ dim T" by (metis dim_span dim_subset) -lemma span_eq_dim: "span (S:: ('a::euclidean_space) set) = span T ==> dim S = dim T" +lemma span_eq_dim: + fixes S:: "'a::euclidean_space set" + shows "span S = span T \ dim S = dim T" by (metis dim_span) lemma spans_image: @@ -1732,12 +1994,15 @@ proof - from basis_exists[of S] obtain B where B: "B \ S" "independent B" "S \ span B" "card B = dim S" by blast - from B have fB: "finite B" "card B = dim S" using independent_bound by blast+ + from B have fB: "finite B" "card B = dim S" + using independent_bound by blast+ have "dim (f ` S) \ card (f ` B)" apply (rule span_card_ge_dim) - using lf B fB apply (auto simp add: span_linear_image spans_image subset_image_iff) + using lf B fB + apply (auto simp add: span_linear_image spans_image subset_image_iff) done - also have "\ \ dim S" using card_image_le[OF fB(1)] fB by simp + also have "\ \ dim S" + using card_image_le[OF fB(1)] fB by simp finally show ?thesis . qed @@ -1745,12 +2010,15 @@ lemma spanning_surjective_image: assumes us: "UNIV \ span S" - and lf: "linear f" and sf: "surj f" + and lf: "linear f" + and sf: "surj f" shows "UNIV \ span (f ` S)" proof - - have "UNIV \ f ` UNIV" using sf by (auto simp add: surj_def) - also have " \ \ span (f ` S)" using spans_image[OF lf us] . -finally show ?thesis . + have "UNIV \ f ` UNIV" + using sf by (auto simp add: surj_def) + also have " \ \ span (f ` S)" + using spans_image[OF lf us] . + finally show ?thesis . qed lemma independent_injective_image: @@ -1759,23 +2027,30 @@ and fi: "inj f" shows "independent (f ` S)" proof - - { fix a + { + fix a assume a: "a \ S" "f a \ span (f ` S - {f a})" - have eq: "f ` S - {f a} = f ` (S - {a})" using fi - by (auto simp add: inj_on_def) + have eq: "f ` S - {f a} = f ` (S - {a})" + using fi by (auto simp add: inj_on_def) from a have "f a \ f ` span (S -{a})" - unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast - then have "a \ span (S -{a})" using fi by (auto simp add: inj_on_def) - with a(1) iS have False by (simp add: dependent_def) } - then show ?thesis unfolding dependent_def by blast + unfolding eq span_linear_image[OF lf, of "S - {a}"] by blast + then have "a \ span (S -{a})" + using fi by (auto simp add: inj_on_def) + with a(1) iS have False + by (simp add: dependent_def) + } + then show ?thesis + unfolding dependent_def by blast qed text {* Picking an orthogonal replacement for a spanning set. *} - (* FIXME : Move to some general theory ?*) +(* FIXME : Move to some general theory ?*) definition "pairwise R S \ (\x \ S. \y\ S. x\y \ R x y)" -lemma vector_sub_project_orthogonal: "(b::'a::euclidean_space) \ (x - ((b \ x) / (b \ b)) *\<^sub>R b) = 0" +lemma vector_sub_project_orthogonal: + fixes b x :: "'a::euclidean_space" + shows "b \ (x - ((b \ x) / (b \ b)) *\<^sub>R b) = 0" unfolding inner_simps by auto lemma pairwise_orthogonal_insert: @@ -1786,14 +2061,17 @@ by (auto simp add: orthogonal_commute) lemma basis_orthogonal: - fixes B :: "('a::real_inner) set" + fixes B :: "'a::real_inner set" assumes fB: "finite B" shows "\C. finite C \ card C \ card B \ span C = span B \ pairwise orthogonal C" (is " \C. ?P B C") using fB proof (induct rule: finite_induct) case empty - then show ?case apply (rule exI[where x="{}"]) by (auto simp add: pairwise_def) + then show ?case + apply (rule exI[where x="{}"]) + apply (auto simp add: pairwise_def) + done next case (insert a B) note fB = `finite B` and aB = `a \ B` @@ -1802,10 +2080,12 @@ "span C = span B" "pairwise orthogonal C" by blast let ?a = "a - setsum (\x. (x \ a / (x \ x)) *\<^sub>R x) C" let ?C = "insert ?a C" - from C(1) have fC: "finite ?C" by simp + from C(1) have fC: "finite ?C" + by simp from fB aB C(1,2) have cC: "card ?C \ card (insert a B)" by (simp add: card_insert_if) - { fix x k + { + fix x k have th0: "\(a::'a) b c. a - (b - c) = c + (a - b)" by (simp add: field_simps) have "x - k *\<^sub>R (a - (\x\C. (x \ a / (x \ x)) *\<^sub>R x)) \ span C \ x - k *\<^sub>R a \ span C" @@ -1817,12 +2097,17 @@ apply (rule span_mul) apply (rule span_superset) apply assumption - done } + done + } then have SC: "span ?C = span (insert a B)" unfolding set_eq_iff span_breakdown_eq C(3)[symmetric] by auto - { fix y assume yC: "y \ C" - then have Cy: "C = insert y (C - {y})" by blast - have fth: "finite (C - {y})" using C by simp + { + fix y + assume yC: "y \ C" + then have Cy: "C = insert y (C - {y})" + by blast + have fth: "finite (C - {y})" + using C by simp have "orthogonal ?a y" unfolding orthogonal_def unfolding inner_diff inner_setsum_left diff_eq_0_iff_eq @@ -1831,10 +2116,12 @@ apply (rule setsum_0') apply clarsimp apply (rule C(4)[unfolded pairwise_def orthogonal_def, rule_format]) - using `y \ C` by auto } + using `y \ C` by auto + } with `pairwise orthogonal C` have CPO: "pairwise orthogonal ?C" by (rule pairwise_orthogonal_insert) - from fC cC SC CPO have "?P (insert a B) ?C" by blast + from fC cC SC CPO have "?P (insert a B) ?C" + by blast then show ?case by blast qed @@ -1843,19 +2130,29 @@ shows "\B. independent B \ B \ span V \ V \ span B \ (card B = dim V) \ pairwise orthogonal B" proof - from basis_exists[of V] obtain B where - B: "B \ V" "independent B" "V \ span B" "card B = dim V" by blast - from B have fB: "finite B" "card B = dim V" using independent_bound by auto + B: "B \ V" "independent B" "V \ span B" "card B = dim V" + by blast + from B have fB: "finite B" "card B = dim V" + using independent_bound by auto from basis_orthogonal[OF fB(1)] obtain C where - C: "finite C" "card C \ card B" "span C = span B" "pairwise orthogonal C" by blast - from C B have CSV: "C \ span V" by (metis span_inc span_mono subset_trans) - from span_mono[OF B(3)] C have SVC: "span V \ span C" by (simp add: span_span) + C: "finite C" "card C \ card B" "span C = span B" "pairwise orthogonal C" + by blast + from C B have CSV: "C \ span V" + by (metis span_inc span_mono subset_trans) + from span_mono[OF B(3)] C have SVC: "span V \ span C" + by (simp add: span_span) from card_le_dim_spanning[OF CSV SVC C(1)] C(2,3) fB - have iC: "independent C" by (simp add: dim_span) - from C fB have "card C \ dim V" by simp - moreover have "dim V \ card C" using span_card_ge_dim[OF CSV SVC C(1)] + have iC: "independent C" by (simp add: dim_span) - ultimately have CdV: "card C = dim V" using C(1) by simp - from C B CSV CdV iC show ?thesis by auto + from C fB have "card C \ dim V" + by simp + moreover have "dim V \ card C" + using span_card_ge_dim[OF CSV SVC C(1)] + by (simp add: dim_span) + ultimately have CdV: "card C = dim V" + using C(1) by simp + from C B CSV CdV iC show ?thesis + by auto qed lemma span_eq: "span S = span T \ S \ span T \ T \ span S" @@ -1865,17 +2162,20 @@ text {* Low-dimensional subset is in a hyperplane (weak orthogonal complement). *} lemma span_not_univ_orthogonal: - fixes S::"('a::euclidean_space) set" + fixes S :: "'a::euclidean_space set" assumes sU: "span S \ UNIV" shows "\(a::'a). a \0 \ (\x \ span S. a \ x = 0)" proof - - from sU obtain a where a: "a \ span S" by blast + from sU obtain a where a: "a \ span S" + by blast from orthogonal_basis_exists obtain B where B: "independent B" "B \ span S" "S \ span B" "card B = dim S" "pairwise orthogonal B" by blast - from B have fB: "finite B" "card B = dim S" using independent_bound by auto + from B have fB: "finite B" "card B = dim S" + using independent_bound by auto from span_mono[OF B(2)] span_mono[OF B(3)] - have sSB: "span S = span B" by (simp add: span_span) + have sSB: "span S = span B" + by (simp add: span_span) let ?a = "a - setsum (\b. (a \ b / (b \ b)) *\<^sub>R b) B" have "setsum (\b. (a \ b / (b \ b)) *\<^sub>R b) B \ span S" unfolding sSB @@ -1885,17 +2185,23 @@ apply (rule span_superset) apply assumption done - with a have a0:"?a \ 0" by auto + with a have a0:"?a \ 0" + by auto have "\x\span B. ?a \ x = 0" proof (rule span_induct') show "subspace {x. ?a \ x = 0}" by (auto simp add: subspace_def inner_add) next - { fix x assume x: "x \ B" - from x have B': "B = insert x (B - {x})" by blast - have fth: "finite (B - {x})" using fB by simp + { + fix x + assume x: "x \ B" + from x have B': "B = insert x (B - {x})" + by blast + have fth: "finite (B - {x})" + using fB by simp have "?a \ x = 0" - apply (subst B') using fB fth + apply (subst B') + using fB fth unfolding setsum_clauses(2)[OF fth] apply simp unfolding inner_simps apply (clarsimp simp add: inner_add inner_setsum_left) @@ -1903,27 +2209,36 @@ unfolding inner_commute apply (auto simp add: x field_simps intro: B(5)[unfolded pairwise_def orthogonal_def, rule_format]) - done } - then show "\x \ B. ?a \ x = 0" by blast + done + } + then show "\x \ B. ?a \ x = 0" + by blast qed - with a0 show ?thesis unfolding sSB by (auto intro: exI[where x="?a"]) + with a0 show ?thesis + unfolding sSB by (auto intro: exI[where x="?a"]) qed lemma span_not_univ_subset_hyperplane: - assumes SU: "span S \ (UNIV ::('a::euclidean_space) set)" + fixes S :: "'a::euclidean_space set" + assumes SU: "span S \ UNIV" shows "\ a. a \0 \ span S \ {x. a \ x = 0}" using span_not_univ_orthogonal[OF SU] by auto lemma lowdim_subset_hyperplane: - fixes S::"('a::euclidean_space) set" + fixes S :: "'a::euclidean_space set" assumes d: "dim S < DIM('a)" shows "\(a::'a). a \ 0 \ span S \ {x. a \ x = 0}" proof - - { assume "span S = UNIV" - then have "dim (span S) = dim (UNIV :: ('a) set)" by simp - then have "dim S = DIM('a)" by (simp add: dim_span dim_UNIV) - with d have False by arith } - then have th: "span S \ UNIV" by blast + { + assume "span S = UNIV" + then have "dim (span S) = dim (UNIV :: ('a) set)" + by simp + then have "dim S = DIM('a)" + by (simp add: dim_span dim_UNIV) + with d have False by arith + } + then have th: "span S \ UNIV" + by blast from span_not_univ_subset_hyperplane[OF th] show ?thesis . qed @@ -1945,7 +2260,9 @@ case (2 a b x) have fb: "finite b" using "2.prems" by simp have th0: "f ` b \ f ` (insert a b)" - apply (rule image_mono) by blast + apply (rule image_mono) + apply blast + done from independent_mono[ OF "2.prems"(2) th0] have ifb: "independent (f ` b)" . have fib: "inj_on f b" @@ -1953,23 +2270,27 @@ apply blast done from span_breakdown[of a "insert a b", simplified, OF "2.prems"(4)] - obtain k where k: "x - k*\<^sub>R a \ span (b -{a})" by blast + obtain k where k: "x - k*\<^sub>R a \ span (b - {a})" + by blast have "f (x - k*\<^sub>R a) \ span (f ` b)" unfolding span_linear_image[OF lf] apply (rule imageI) - using k span_mono[of "b-{a}" b] apply blast + using k span_mono[of "b-{a}" b] + apply blast done then have "f x - k*\<^sub>R f a \ span (f ` b)" by (simp add: linear_sub[OF lf] linear_cmul[OF lf]) then have th: "-k *\<^sub>R f a \ span (f ` b)" using "2.prems"(5) by simp - { assume k0: "k = 0" - from k0 k have "x \ span (b -{a})" by simp - then have "x \ span b" using span_mono[of "b-{a}" b] - by blast } - moreover - { assume k0: "k \ 0" - from span_mul[OF th, of "- 1/ k"] k0 + have xsb: "x \ span b" + proof (cases "k = 0") + case True + with k have "x \ span (b -{a})" by simp + then show ?thesis using span_mono[of "b-{a}" b] + by blast + next + case False + with span_mul[OF th, of "- 1/ k"] have th1: "f a \ span (f ` b)" by auto from inj_on_image_set_diff[OF "2.prems"(3), of "insert a b " "{a}", symmetric] @@ -1979,20 +2300,21 @@ using "2.hyps"(2) "2.prems"(3) by auto with th1 have False by blast - then have "x \ span b" by blast } - ultimately have xsb: "x \ span b" by blast - from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)] - show "x = 0" . + then show ?thesis by blast + qed + from "2.hyps"(3)[OF fb ifb fib xsb "2.prems"(5)] show "x = 0" . qed text {* We can extend a linear mapping from basis. *} lemma linear_independent_extend_lemma: fixes f :: "'a::real_vector \ 'b::real_vector" - assumes fi: "finite B" and ib: "independent B" - shows "\g. (\x\ span B. \y\ span B. g (x + y) = g x + g y) - \ (\x\ span B. \c. g (c*\<^sub>R x) = c *\<^sub>R g x) - \ (\x\ B. g x = f x)" + assumes fi: "finite B" + and ib: "independent B" + shows "\g. + (\x\ span B. \y\ span B. g (x + y) = g x + g y) \ + (\x\ span B. \c. g (c*\<^sub>R x) = c *\<^sub>R g x) \ + (\x\ B. g x = f x)" using ib fi proof (induct rule: finite_induct[OF fi]) case 1 @@ -2005,39 +2327,56 @@ g: "\x\span b. \y\span b. g (x + y) = g x + g y" "\x\span b. \c. g (c *\<^sub>R x) = c *\<^sub>R g x" "\x\b. g x = f x" by blast let ?h = "\z. SOME k. (z - k *\<^sub>R a) \ span b" - { fix z assume z: "z \ span (insert a b)" + { + fix z + assume z: "z \ span (insert a b)" have th0: "z - ?h z *\<^sub>R a \ span b" apply (rule someI_ex) unfolding span_breakdown_eq[symmetric] - using z . - { fix k assume k: "z - k *\<^sub>R a \ span b" + apply (rule z) + done + { + fix k + assume k: "z - k *\<^sub>R a \ span b" have eq: "z - ?h z *\<^sub>R a - (z - k*\<^sub>R a) = (k - ?h z) *\<^sub>R a" by (simp add: field_simps scaleR_left_distrib [symmetric]) - from span_sub[OF th0 k] - have khz: "(k - ?h z) *\<^sub>R a \ span b" by (simp add: eq) - { assume "k \ ?h z" then have k0: "k - ?h z \ 0" by simp + from span_sub[OF th0 k] have khz: "(k - ?h z) *\<^sub>R a \ span b" + by (simp add: eq) + { + assume "k \ ?h z" + then have k0: "k - ?h z \ 0" by simp from k0 span_mul[OF khz, of "1 /(k - ?h z)"] have "a \ span b" by simp with "2.prems"(1) "2.hyps"(2) have False - by (auto simp add: dependent_def)} - then have "k = ?h z" by blast} - with th0 have "z - ?h z *\<^sub>R a \ span b \ (\k. z - k *\<^sub>R a \ span b \ k = ?h z)" by blast} + by (auto simp add: dependent_def) + } + then have "k = ?h z" by blast + } + with th0 have "z - ?h z *\<^sub>R a \ span b \ (\k. z - k *\<^sub>R a \ span b \ k = ?h z)" + by blast + } note h = this let ?g = "\z. ?h z *\<^sub>R f a + g (z - ?h z *\<^sub>R a)" - { fix x y assume x: "x \ span (insert a b)" and y: "y \ span (insert a b)" + { + fix x y + assume x: "x \ span (insert a b)" + and y: "y \ span (insert a b)" have tha: "\(x::'a) y a k l. (x + y) - (k + l) *\<^sub>R a = (x - k *\<^sub>R a) + (y - l *\<^sub>R a)" by (simp add: algebra_simps) have addh: "?h (x + y) = ?h x + ?h y" apply (rule conjunct2[OF h, rule_format, symmetric]) apply (rule span_add[OF x y]) unfolding tha - by (metis span_add x y conjunct1[OF h, rule_format]) + apply (metis span_add x y conjunct1[OF h, rule_format]) + done have "?g (x + y) = ?g x + ?g y" unfolding addh tha g(1)[rule_format,OF conjunct1[OF h, OF x] conjunct1[OF h, OF y]] by (simp add: scaleR_left_distrib)} moreover - { fix x:: "'a" and c:: real + { + fix x :: "'a" + fix c :: real assume x: "x \ span (insert a b)" have tha: "\(x::'a) c k a. c *\<^sub>R x - (c * k) *\<^sub>R a = c *\<^sub>R (x - k *\<^sub>R a)" by (simp add: algebra_simps) @@ -2048,24 +2387,29 @@ done have "?g (c *\<^sub>R x) = c*\<^sub>R ?g x" unfolding hc tha g(2)[rule_format, OF conjunct1[OF h, OF x]] - by (simp add: algebra_simps) } + by (simp add: algebra_simps) + } moreover - { fix x assume x: "x \ (insert a b)" - { assume xa: "x = a" + { + fix x + assume x: "x \ insert a b" + { + assume xa: "x = a" have ha1: "1 = ?h a" apply (rule conjunct2[OF h, rule_format]) apply (metis span_superset insertI1) using conjunct1[OF h, OF span_superset, OF insertI1] apply (auto simp add: span_0) done - from xa ha1[symmetric] have "?g x = f x" apply simp using g(2)[rule_format, OF span_0, of 0] apply simp - done } + done + } moreover - { assume xb: "x \ b" + { + assume xb: "x \ b" have h0: "0 = ?h x" apply (rule conjunct2[OF h, rule_format]) apply (metis span_superset x) @@ -2073,8 +2417,11 @@ apply (metis span_superset xb) done have "?g x = f x" - by (simp add: h0[symmetric] g(3)[rule_format, OF xb]) } - ultimately have "?g x = f x" using x by blast } + by (simp add: h0[symmetric] g(3)[rule_format, OF xb]) + } + ultimately have "?g x = f x" + using x by blast + } ultimately show ?case apply - apply (rule exI[where x="?g"]) @@ -2083,17 +2430,22 @@ qed lemma linear_independent_extend: - assumes iB: "independent (B:: ('a::euclidean_space) set)" + fixes B :: "'a::euclidean_space set" + assumes iB: "independent B" shows "\g. linear g \ (\x\B. g x = f x)" proof - from maximal_independent_subset_extend[of B UNIV] iB - obtain C where C: "B \ C" "independent C" "\x. x \ span C" by auto + obtain C where C: "B \ C" "independent C" "\x. x \ span C" + by auto from C(2) independent_bound[of C] linear_independent_extend_lemma[of C f] - obtain g where g: "(\x\ span C. \y\ span C. g (x + y) = g x + g y) - \ (\x\ span C. \c. g (c*\<^sub>R x) = c *\<^sub>R g x) - \ (\x\ C. g x = f x)" by blast - from g show ?thesis unfolding linear_def using C + obtain g where g: + "(\x\ span C. \y\ span C. g (x + y) = g x + g y) \ + (\x\ span C. \c. g (c*\<^sub>R x) = c *\<^sub>R g x) \ + (\x\ C. g x = f x)" by blast + from g show ?thesis + unfolding linear_def + using C apply clarsimp apply blast done @@ -2118,10 +2470,12 @@ then show ?case by simp next case (2 y t) - from "2.prems"(1,2,5) "2.hyps"(1,2) have cst:"card s \ card t" by simp - from "2.prems"(3) [OF "2.hyps"(1) cst] obtain f where - f: "f ` s \ t \ inj_on f s" by blast - from f "2.prems"(2) "2.hyps"(2) show ?case + from "2.prems"(1,2,5) "2.hyps"(1,2) have cst: "card s \ card t" + by simp + from "2.prems"(3) [OF "2.hyps"(1) cst] + obtain f where "f ` s \ t" "inj_on f s" + by blast + with "2.prems"(2) "2.hyps"(2) show ?case apply - apply (rule exI[where x = "\z. if z = x then y else f z"]) apply (auto simp add: inj_on_def) @@ -2135,54 +2489,74 @@ and c: "card A = card B" shows "A = B" proof - - from fB AB have fA: "finite A" by (auto intro: finite_subset) - from fA fB have fBA: "finite (B - A)" by auto - have e: "A \ (B - A) = {}" by blast - have eq: "A \ (B - A) = B" using AB by blast - from card_Un_disjoint[OF fA fBA e, unfolded eq c] - have "card (B - A) = 0" by arith - then have "B - A = {}" unfolding card_eq_0_iff using fA fB by simp - with AB show "A = B" by blast + from fB AB have fA: "finite A" + by (auto intro: finite_subset) + from fA fB have fBA: "finite (B - A)" + by auto + have e: "A \ (B - A) = {}" + by blast + have eq: "A \ (B - A) = B" + using AB by blast + from card_Un_disjoint[OF fA fBA e, unfolded eq c] have "card (B - A) = 0" + by arith + then have "B - A = {}" + unfolding card_eq_0_iff using fA fB by simp + with AB show "A = B" + by blast qed lemma subspace_isomorphism: - assumes s: "subspace (S:: ('a::euclidean_space) set)" - and t: "subspace (T :: ('b::euclidean_space) set)" + fixes S :: "'a::euclidean_space set" + and T :: "'b::euclidean_space set" + assumes s: "subspace S" + and t: "subspace T" and d: "dim S = dim T" shows "\f. linear f \ f ` S = T \ inj_on f S" proof - - from basis_exists[of S] independent_bound obtain B where - B: "B \ S" "independent B" "S \ span B" "card B = dim S" and fB: "finite B" by blast - from basis_exists[of T] independent_bound obtain C where - C: "C \ T" "independent C" "T \ span C" "card C = dim T" and fC: "finite C" by blast - from B(4) C(4) card_le_inj[of B C] d obtain f where - f: "f ` B \ C" "inj_on f B" using `finite B` `finite C` by auto - from linear_independent_extend[OF B(2)] obtain g where - g: "linear g" "\x\ B. g x = f x" by blast - from inj_on_iff_eq_card[OF fB, of f] f(2) - have "card (f ` B) = card B" by simp - with B(4) C(4) have ceq: "card (f ` B) = card C" using d + from basis_exists[of S] independent_bound + obtain B where B: "B \ S" "independent B" "S \ span B" "card B = dim S" and fB: "finite B" + by blast + from basis_exists[of T] independent_bound + obtain C where C: "C \ T" "independent C" "T \ span C" "card C = dim T" and fC: "finite C" + by blast + from B(4) C(4) card_le_inj[of B C] d + obtain f where f: "f ` B \ C" "inj_on f B" using `finite B` `finite C` + by auto + from linear_independent_extend[OF B(2)] + obtain g where g: "linear g" "\x\ B. g x = f x" + by blast + from inj_on_iff_eq_card[OF fB, of f] f(2) have "card (f ` B) = card B" by simp - have "g ` B = f ` B" using g(2) - by (auto simp add: image_iff) + with B(4) C(4) have ceq: "card (f ` B) = card C" + using d by simp + have "g ` B = f ` B" + using g(2) by (auto simp add: image_iff) also have "\ = C" using card_subset_eq[OF fC f(1) ceq] . finally have gBC: "g ` B = C" . - have gi: "inj_on g B" using f(2) g(2) - by (auto simp add: inj_on_def) + have gi: "inj_on g B" + using f(2) g(2) by (auto simp add: inj_on_def) note g0 = linear_indep_image_lemma[OF g(1) fB, unfolded gBC, OF C(2) gi] - { fix x y assume x: "x \ S" and y: "y \ S" and gxy: "g x = g y" - from B(3) x y have x': "x \ span B" and y': "y \ span B" by blast+ - from gxy have th0: "g (x - y) = 0" by (simp add: linear_sub[OF g(1)]) - have th1: "x - y \ span B" using x' y' by (metis span_sub) - have "x=y" using g0[OF th1 th0] by simp } + { + fix x y + assume x: "x \ S" and y: "y \ S" and gxy: "g x = g y" + from B(3) x y have x': "x \ span B" and y': "y \ span B" + by blast+ + from gxy have th0: "g (x - y) = 0" + by (simp add: linear_sub[OF g(1)]) + have th1: "x - y \ span B" + using x' y' by (metis span_sub) + have "x = y" + using g0[OF th1 th0] by simp + } then have giS: "inj_on g S" unfolding inj_on_def by blast - from span_subspace[OF B(1,3) s] - have "g ` S = span (g ` B)" by (simp add: span_linear_image[OF g(1)]) + from span_subspace[OF B(1,3) s] have "g ` S = span (g ` B)" + by (simp add: span_linear_image[OF g(1)]) also have "\ = span C" unfolding gBC .. also have "\ = T" using span_subspace[OF C(1,3) t] . finally have gS: "g ` S = T" . - from g(1) gS giS show ?thesis by blast + from g(1) gS giS show ?thesis + by blast qed text {* Linear functions are equal on a subspace if they are on a spanning set. *} @@ -2232,7 +2606,8 @@ lemma bilinear_eq: assumes bf: "bilinear f" and bg: "bilinear g" - and SB: "S \ span B" and TC: "T \ span C" + and SB: "S \ span B" + and TC: "T \ span C" and fg: "\x\ B. \y\ C. f x y = g x y" shows "\x\S. \y\T. f x y = g x y " proof - @@ -2252,11 +2627,12 @@ apply (auto simp add: span_0 bilinear_rzero[OF bf] bilinear_rzero[OF bg] span_add Ball_def intro: bilinear_ladd[OF bf]) done - then show ?thesis using SB TC by auto + then show ?thesis + using SB TC by auto qed lemma bilinear_eq_stdbasis: - fixes f::"'a::euclidean_space \ 'b::euclidean_space \ _" + fixes f :: "'a::euclidean_space \ 'b::euclidean_space \ _" assumes bf: "bilinear f" and bg: "bilinear g" and fg: "\i\Basis. \j\Basis. f i j = g i j" @@ -2266,50 +2642,53 @@ text {* Detailed theorems about left and right invertibility in general case. *} lemma linear_injective_left_inverse: - fixes f::"'a::euclidean_space => 'b::euclidean_space" + fixes f::"'a::euclidean_space \ 'b::euclidean_space" assumes lf: "linear f" and fi: "inj f" shows "\g. linear g \ g o f = id" proof - from linear_independent_extend[OF independent_injective_image, OF independent_Basis, OF lf fi] - obtain h:: "'b => 'a" where - h: "linear h" "\x \ f ` Basis. h x = inv f x" by blast + obtain h:: "'b \ 'a" where h: "linear h" "\x \ f ` Basis. h x = inv f x" + by blast from h(2) have th: "\i\Basis. (h \ f) i = id i" using inv_o_cancel[OF fi, unfolded fun_eq_iff id_def o_def] by auto - from linear_eq_stdbasis[OF linear_compose[OF lf h(1)] linear_id th] have "h o f = id" . - then show ?thesis using h(1) by blast + then show ?thesis + using h(1) by blast qed lemma linear_surjective_right_inverse: - fixes f::"'a::euclidean_space => 'b::euclidean_space" - assumes lf: "linear f" and sf: "surj f" + fixes f :: "'a::euclidean_space \ 'b::euclidean_space" + assumes lf: "linear f" + and sf: "surj f" shows "\g. linear g \ f o g = id" proof - from linear_independent_extend[OF independent_Basis[where 'a='b],of "inv f"] - obtain h:: "'b \ 'a" where - h: "linear h" "\x\Basis. h x = inv f x" by blast - from h(2) - have th: "\i\Basis. (f o h) i = id i" + obtain h:: "'b \ 'a" where h: "linear h" "\x\Basis. h x = inv f x" + by blast + from h(2) have th: "\i\Basis. (f o h) i = id i" using sf by (auto simp add: surj_iff_all) from linear_eq_stdbasis[OF linear_compose[OF h(1) lf] linear_id th] have "f o h = id" . - then show ?thesis using h(1) by blast + then show ?thesis + using h(1) by blast qed text {* An injective map @{typ "'a::euclidean_space \ 'b::euclidean_space"} is also surjective. *} lemma linear_injective_imp_surjective: - fixes f::"'a::euclidean_space => 'a::euclidean_space" - assumes lf: "linear f" and fi: "inj f" + fixes f::"'a::euclidean_space \ 'a::euclidean_space" + assumes lf: "linear f" + and fi: "inj f" shows "surj f" proof - let ?U = "UNIV :: 'a set" from basis_exists[of ?U] obtain B where B: "B \ ?U" "independent B" "?U \ span B" "card B = dim ?U" by blast - from B(4) have d: "dim ?U = card B" by simp + from B(4) have d: "dim ?U = card B" + by simp have th: "?U \ span (f ` B)" apply (rule card_ge_dim_independent) apply blast @@ -2333,51 +2712,66 @@ and fT: "finite T" and c: "card S = card T" and ST: "f ` S \ T" - shows "(\y \ T. \x \ S. f x = y) \ inj_on f S" (is "?lhs \ ?rhs") -proof - - { assume h: "?lhs" - { fix x y - assume x: "x \ S" and y: "y \ S" and f: "f x = f y" - from x fS have S0: "card S \ 0" by auto - { assume xy: "x \ y" - have th: "card S \ card (f ` (S - {y}))" - unfolding c - apply (rule card_mono) - apply (rule finite_imageI) - using fS apply simp - using h xy x y f unfolding subset_eq image_iff - apply auto - apply (case_tac "xa = f x") - apply (rule bexI[where x=x]) - apply auto - done - also have " \ \ card (S -{y})" - apply (rule card_image_le) - using fS by simp - also have "\ \ card S - 1" using y fS by simp - finally have False using S0 by arith } - then have "x = y" by blast} - then have ?rhs unfolding inj_on_def by blast} - moreover - { assume h: ?rhs - have "f ` S = T" - apply (rule card_subset_eq[OF fT ST]) - unfolding card_image[OF h] using c . - then have ?lhs by blast} - ultimately show ?thesis by blast + shows "(\y \ T. \x \ S. f x = y) \ inj_on f S" + (is "?lhs \ ?rhs") +proof + assume h: "?lhs" + { + fix x y + assume x: "x \ S" + assume y: "y \ S" + assume f: "f x = f y" + from x fS have S0: "card S \ 0" + by auto + have "x = y" + proof (rule ccontr) + assume xy: "x \ y" + have th: "card S \ card (f ` (S - {y}))" + unfolding c + apply (rule card_mono) + apply (rule finite_imageI) + using fS apply simp + using h xy x y f unfolding subset_eq image_iff + apply auto + apply (case_tac "xa = f x") + apply (rule bexI[where x=x]) + apply auto + done + also have " \ \ card (S -{y})" + apply (rule card_image_le) + using fS by simp + also have "\ \ card S - 1" using y fS by simp + finally show False using S0 by arith + qed + } + then show ?rhs + unfolding inj_on_def by blast +next + assume h: ?rhs + have "f ` S = T" + apply (rule card_subset_eq[OF fT ST]) + unfolding card_image[OF h] + apply (rule c) + done + then show ?lhs by blast qed lemma linear_surjective_imp_injective: - fixes f::"'a::euclidean_space => 'a::euclidean_space" - assumes lf: "linear f" and sf: "surj f" + fixes f :: "'a::euclidean_space \ 'a::euclidean_space" + assumes lf: "linear f" + and sf: "surj f" shows "inj f" proof - let ?U = "UNIV :: 'a set" from basis_exists[of ?U] obtain B where B: "B \ ?U" "independent B" "?U \ span B" and d: "card B = dim ?U" by blast - { fix x assume x: "x \ span B" and fx: "f x = 0" - from B(2) have fB: "finite B" using independent_bound by auto + { + fix x + assume x: "x \ span B" + assume fx: "f x = 0" + from B(2) have fB: "finite B" + using independent_bound by auto have fBi: "independent (f ` B)" apply (rule card_le_dim_spanning[of "f ` B" ?U]) apply blast @@ -2394,81 +2788,98 @@ apply blast unfolding span_linear_image[OF lf] apply (rule subset_trans[where B = "f ` UNIV"]) - using sf unfolding surj_def apply blast + using sf unfolding surj_def + apply blast apply (rule image_mono) apply (rule B(3)) apply (metis finite_imageI fB) done - moreover have "card (f ` B) \ card B" by (rule card_image_le, rule fB) - ultimately have th1: "card B = card (f ` B)" unfolding d by arith + ultimately have th1: "card B = card (f ` B)" + unfolding d by arith have fiB: "inj_on f B" unfolding surjective_iff_injective_gen[OF fB finite_imageI[OF fB] th1 subset_refl, symmetric] by blast from linear_indep_image_lemma[OF lf fB fBi fiB x] fx - have "x = 0" by blast} - note th = this - from th show ?thesis unfolding linear_injective_0[OF lf] - using B(3) by blast + have "x = 0" by blast + } + then show ?thesis + unfolding linear_injective_0[OF lf] + using B(3) + by blast qed text {* Hence either is enough for isomorphism. *} lemma left_right_inverse_eq: - assumes fg: "f o g = id" and gh: "g o h = id" + assumes fg: "f \ g = id" + and gh: "g \ h = id" shows "f = h" proof - - have "f = f o (g o h)" unfolding gh by simp - also have "\ = (f o g) o h" by (simp add: o_assoc) - finally show "f = h" unfolding fg by simp + have "f = f \ (g \ h)" + unfolding gh by simp + also have "\ = (f \ g) \ h" + by (simp add: o_assoc) + finally show "f = h" + unfolding fg by simp qed lemma isomorphism_expand: - "f o g = id \ g o f = id \ (\x. f(g x) = x) \ (\x. g(f x) = x)" + "f \ g = id \ g \ f = id \ (\x. f (g x) = x) \ (\x. g (f x) = x)" by (simp add: fun_eq_iff o_def id_def) lemma linear_injective_isomorphism: - fixes f::"'a::euclidean_space => 'a::euclidean_space" - assumes lf: "linear f" and fi: "inj f" + fixes f::"'a::euclidean_space \ 'a::euclidean_space" + assumes lf: "linear f" + and fi: "inj f" shows "\f'. linear f' \ (\x. f' (f x) = x) \ (\x. f (f' x) = x)" unfolding isomorphism_expand[symmetric] using linear_surjective_right_inverse[OF lf linear_injective_imp_surjective[OF lf fi]] linear_injective_left_inverse[OF lf fi] by (metis left_right_inverse_eq) -lemma linear_surjective_isomorphism: fixes f::"'a::euclidean_space => 'a::euclidean_space" - assumes lf: "linear f" and sf: "surj f" +lemma linear_surjective_isomorphism: + fixes f :: "'a::euclidean_space \ 'a::euclidean_space" + assumes lf: "linear f" + and sf: "surj f" shows "\f'. linear f' \ (\x. f' (f x) = x) \ (\x. f (f' x) = x)" unfolding isomorphism_expand[symmetric] using linear_surjective_right_inverse[OF lf sf] linear_injective_left_inverse[OF lf linear_surjective_imp_injective[OF lf sf]] by (metis left_right_inverse_eq) -text {* Left and right inverses are the same for @{typ "'a::euclidean_space => 'a::euclidean_space"}. *} +text {* Left and right inverses are the same for + @{typ "'a::euclidean_space \ 'a::euclidean_space"}. *} lemma linear_inverse_left: - fixes f::"'a::euclidean_space => 'a::euclidean_space" - assumes lf: "linear f" and lf': "linear f'" - shows "f o f' = id \ f' o f = id" + fixes f :: "'a::euclidean_space \ 'a::euclidean_space" + assumes lf: "linear f" + and lf': "linear f'" + shows "f \ f' = id \ f' \ f = id" proof - - { fix f f':: "'a => 'a" - assume lf: "linear f" "linear f'" and f: "f o f' = id" + { + fix f f':: "'a \ 'a" + assume lf: "linear f" "linear f'" + assume f: "f \ f' = id" from f have sf: "surj f" apply (auto simp add: o_def id_def surj_def) apply metis done from linear_surjective_isomorphism[OF lf(1) sf] lf f - have "f' o f = id" unfolding fun_eq_iff o_def id_def - by metis } - then show ?thesis using lf lf' by metis + have "f' \ f = id" + unfolding fun_eq_iff o_def id_def by metis + } + then show ?thesis + using lf lf' by metis qed text {* Moreover, a one-sided inverse is automatically linear. *} lemma left_inverse_linear: - fixes f::"'a::euclidean_space => 'a::euclidean_space" - assumes lf: "linear f" and gf: "g o f = id" + fixes f :: "'a::euclidean_space \ 'a::euclidean_space" + assumes lf: "linear f" + and gf: "g \ f = id" shows "linear g" proof - from gf have fi: "inj f" @@ -2476,8 +2887,8 @@ apply metis done from linear_injective_isomorphism[OF lf fi] - obtain h:: "'a \ 'a" where - h: "linear h" "\x. h (f x) = x" "\x. f (h x) = x" by blast + obtain h :: "'a \ 'a" where h: "linear h" "\x. h (f x) = x" "\x. f (h x) = x" + by blast have "h = g" apply (rule ext) using gf h(2,3) apply (simp add: o_def id_def fun_eq_iff) @@ -2495,22 +2906,26 @@ by auto lemma infnorm_set_image: - "{ abs ((x::'a::euclidean_space) \ i) |i. i \ Basis} = (\i. abs(x \ i)) ` Basis" + "{abs ((x::'a::euclidean_space) \ i) |i. i \ Basis} = (\i. abs(x \ i)) ` Basis" by blast lemma infnorm_Max: "infnorm (x::'a::euclidean_space) = Max ((\i. abs(x \ i)) ` Basis)" by (simp add: infnorm_def infnorm_set_image cSup_eq_Max) lemma infnorm_set_lemma: - shows "finite {abs((x::'a::euclidean_space) \ i) |i. i \ Basis}" - and "{abs(x \ i) |i. i \ Basis} \ {}" + "finite {abs((x::'a::euclidean_space) \ i) |i. i \ Basis}" + "{abs(x \ i) |i. i \ Basis} \ {}" unfolding infnorm_set_image by auto -lemma infnorm_pos_le: "0 \ infnorm (x::'a::euclidean_space)" +lemma infnorm_pos_le: + fixes x :: "'a::euclidean_space" + shows "0 \ infnorm x" by (simp add: infnorm_Max Max_ge_iff ex_in_conv) -lemma infnorm_triangle: "infnorm ((x::'a::euclidean_space) + y) \ infnorm x + infnorm y" +lemma infnorm_triangle: + fixes x :: "'a::euclidean_space" + shows "infnorm (x + y) \ infnorm x + infnorm y" proof - have *: "\a b c d :: real. \a\ \ c \ \b\ \ d \ \a + b\ \ c + d" by simp @@ -2518,7 +2933,9 @@ by (auto simp: infnorm_Max inner_add_left intro!: *) qed -lemma infnorm_eq_0: "infnorm x = 0 \ (x::_::euclidean_space) = 0" +lemma infnorm_eq_0: + fixes x :: "'a::euclidean_space" + shows "infnorm x = 0 \ x = 0" proof - have "infnorm x \ 0 \ x = 0" unfolding infnorm_Max by (simp add: euclidean_all_zero_iff) @@ -2539,41 +2956,47 @@ lemma infnorm_sub: "infnorm (x - y) = infnorm (y - x)" proof - have "y - x = - (x - y)" by simp - then show ?thesis by (metis infnorm_neg) + then show ?thesis + by (metis infnorm_neg) qed -lemma real_abs_sub_infnorm: "\ infnorm x - infnorm y\ \ infnorm (x - y)" +lemma real_abs_sub_infnorm: "\infnorm x - infnorm y\ \ infnorm (x - y)" proof - - have th: "\(nx::real) n ny. nx <= n + ny \ ny <= n + nx ==> \nx - ny\ <= n" + have th: "\(nx::real) n ny. nx \ n + ny \ ny <= n + nx \ \nx - ny\ \ n" by arith from infnorm_triangle[of "x - y" " y"] infnorm_triangle[of "x - y" "-x"] have ths: "infnorm x \ infnorm (x - y) + infnorm y" "infnorm y \ infnorm (x - y) + infnorm x" by (simp_all add: field_simps infnorm_neg) - from th[OF ths] show ?thesis . + from th[OF ths] show ?thesis . qed -lemma real_abs_infnorm: " \infnorm x\ = infnorm x" +lemma real_abs_infnorm: "\infnorm x\ = infnorm x" using infnorm_pos_le[of x] by arith lemma Basis_le_infnorm: - "b \ Basis \ \x \ b\ \ infnorm (x::'a::euclidean_space)" + fixes x :: "'a::euclidean_space" + shows "b \ Basis \ \x \ b\ \ infnorm x" by (simp add: infnorm_Max) lemma infnorm_mul: "infnorm(a *\<^sub>R x) = abs a * infnorm x" unfolding infnorm_Max proof (safe intro!: Max_eqI) let ?B = "(\i. \x \ i\) ` Basis" - show "\b :: 'a. b \ Basis \ \a *\<^sub>R x \ b\ \ \a\ * Max ?B" - by (simp add: abs_mult mult_left_mono) - - from Max_in[of ?B] obtain b where "b \ Basis" "Max ?B = \x \ b\" - by (auto simp del: Max_in) - then show "\a\ * Max ((\i. \x \ i\) ` Basis) \ (\i. \a *\<^sub>R x \ i\) ` Basis" - by (intro image_eqI[where x=b]) (auto simp: abs_mult) + { + fix b :: 'a + assume "b \ Basis" + then show "\a *\<^sub>R x \ b\ \ \a\ * Max ?B" + by (simp add: abs_mult mult_left_mono) + next + from Max_in[of ?B] obtain b where "b \ Basis" "Max ?B = \x \ b\" + by (auto simp del: Max_in) + then show "\a\ * Max ((\i. \x \ i\) ` Basis) \ (\i. \a *\<^sub>R x \ i\) ` Basis" + by (intro image_eqI[where x=b]) (auto simp: abs_mult) + } qed simp -lemma infnorm_mul_lemma: "infnorm(a *\<^sub>R x) \ \a\ * infnorm x" +lemma infnorm_mul_lemma: "infnorm (a *\<^sub>R x) \ \a\ * infnorm x" unfolding infnorm_mul .. lemma infnorm_pos_lt: "infnorm x > 0 \ x \ 0" @@ -2591,7 +3014,8 @@ lemma norm_le_infnorm: "norm x \ sqrt DIM('a) * infnorm(x::'a::euclidean_space)" proof - let ?d = "DIM('a)" - have "real ?d \ 0" by simp + have "real ?d \ 0" + by simp then have d2: "(sqrt (real ?d))\<^sup>2 = real ?d" by (auto intro: real_sqrt_pow2) have th: "sqrt (real ?d) * infnorm x \ 0" @@ -2608,29 +3032,37 @@ apply (auto simp: infnorm_Max) done from real_le_lsqrt[OF inner_ge_zero th th1] - show ?thesis unfolding norm_eq_sqrt_inner id_def . + show ?thesis + unfolding norm_eq_sqrt_inner id_def . qed lemma tendsto_infnorm [tendsto_intros]: assumes "(f ---> a) F" shows "((\x. infnorm (f x)) ---> infnorm a) F" proof (rule tendsto_compose [OF LIM_I assms]) - fix r :: real assume "0 < r" + fix r :: real + assume "r > 0" then show "\s>0. \x. x \ a \ norm (x - a) < s \ norm (infnorm x - infnorm a) < r" by (metis real_norm_def le_less_trans real_abs_sub_infnorm infnorm_le_norm) qed text {* Equality in Cauchy-Schwarz and triangle inequalities. *} -lemma norm_cauchy_schwarz_eq: "x \ y = norm x * norm y \ norm x *\<^sub>R y = norm y *\<^sub>R x" (is "?lhs \ ?rhs") +lemma norm_cauchy_schwarz_eq: "x \ y = norm x * norm y \ norm x *\<^sub>R y = norm y *\<^sub>R x" + (is "?lhs \ ?rhs") proof - - { assume h: "x = 0" - then have ?thesis by simp } + { + assume h: "x = 0" + then have ?thesis by simp + } moreover - { assume h: "y = 0" - then have ?thesis by simp } + { + assume h: "y = 0" + then have ?thesis by simp + } moreover - { assume x: "x \ 0" and y: "y \ 0" + { + assume x: "x \ 0" and y: "y \ 0" from inner_eq_zero_iff[of "norm y *\<^sub>R x - norm x *\<^sub>R y"] have "?rhs \ (norm y * (norm y * norm x * norm x - norm x * (x \ y)) - @@ -2648,49 +3080,58 @@ apply simp apply metis done - finally have ?thesis by blast } + finally have ?thesis by blast + } ultimately show ?thesis by blast qed lemma norm_cauchy_schwarz_abs_eq: "abs(x \ y) = norm x * norm y \ - norm x *\<^sub>R y = norm y *\<^sub>R x \ norm(x) *\<^sub>R y = - norm y *\<^sub>R x" (is "?lhs \ ?rhs") + norm x *\<^sub>R y = norm y *\<^sub>R x \ norm(x) *\<^sub>R y = - norm y *\<^sub>R x" + (is "?lhs \ ?rhs") proof - - have th: "\(x::real) a. a \ 0 \ abs x = a \ x = a \ x = - a" by arith + have th: "\(x::real) a. a \ 0 \ abs x = a \ x = a \ x = - a" + by arith have "?rhs \ norm x *\<^sub>R y = norm y *\<^sub>R x \ norm (- x) *\<^sub>R y = norm y *\<^sub>R (- x)" by simp - also have "\ \(x \ y = norm x * norm y \ - (-x) \ y = norm x * norm y)" + also have "\ \(x \ y = norm x * norm y \ (- x) \ y = norm x * norm y)" unfolding norm_cauchy_schwarz_eq[symmetric] unfolding norm_minus_cancel norm_scaleR .. also have "\ \ ?lhs" - unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] inner_simps by auto + unfolding th[OF mult_nonneg_nonneg, OF norm_ge_zero[of x] norm_ge_zero[of y]] inner_simps + by auto finally show ?thesis .. qed lemma norm_triangle_eq: fixes x y :: "'a::real_inner" - shows "norm(x + y) = norm x + norm y \ norm x *\<^sub>R y = norm y *\<^sub>R x" + shows "norm (x + y) = norm x + norm y \ norm x *\<^sub>R y = norm y *\<^sub>R x" proof - - { assume x: "x = 0 \ y = 0" - then have ?thesis by (cases "x = 0") simp_all } + { + assume x: "x = 0 \ y = 0" + then have ?thesis + by (cases "x = 0") simp_all + } moreover - { assume x: "x \ 0" and y: "y \ 0" + { + assume x: "x \ 0" and y: "y \ 0" then have "norm x \ 0" "norm y \ 0" by simp_all then have n: "norm x > 0" "norm y > 0" using norm_ge_zero[of x] norm_ge_zero[of y] by arith+ - have th: "\(a::real) b c. a + b + c \ 0 ==> (a = b + c \ a\<^sup>2 = (b + c)\<^sup>2)" + have th: "\(a::real) b c. a + b + c \ 0 \ a = b + c \ a\<^sup>2 = (b + c)\<^sup>2" by algebra have "norm (x + y) = norm x + norm y \ (norm (x + y))\<^sup>2 = (norm x + norm y)\<^sup>2" - apply (rule th) using n norm_ge_zero[of "x + y"] + apply (rule th) + using n norm_ge_zero[of "x + y"] apply arith done also have "\ \ norm x *\<^sub>R y = norm y *\<^sub>R x" unfolding norm_cauchy_schwarz_eq[symmetric] unfolding power2_norm_eq_inner inner_simps by (simp add: power2_norm_eq_inner[symmetric] power2_eq_square inner_commute field_simps) - finally have ?thesis .} + finally have ?thesis . + } ultimately show ?thesis by blast qed @@ -2700,7 +3141,8 @@ definition collinear :: "'a::real_vector set \ bool" where "collinear S \ (\u. \x \ S. \ y \ S. \c. x - y = c *\<^sub>R u)" -lemma collinear_empty: "collinear {}" by (simp add: collinear_def) +lemma collinear_empty: "collinear {}" + by (simp add: collinear_def) lemma collinear_sing: "collinear {x}" by (simp add: collinear_def) @@ -2713,14 +3155,20 @@ apply (rule exI[where x="- 1"], simp) done -lemma collinear_lemma: - "collinear {0,x,y} \ x = 0 \ y = 0 \ (\c. y = c *\<^sub>R x)" (is "?lhs \ ?rhs") +lemma collinear_lemma: "collinear {0,x,y} \ x = 0 \ y = 0 \ (\c. y = c *\<^sub>R x)" + (is "?lhs \ ?rhs") proof - - { assume "x=0 \ y = 0" - then have ?thesis by (cases "x = 0") (simp_all add: collinear_2 insert_commute) } + { + assume "x = 0 \ y = 0" + then have ?thesis + by (cases "x = 0") (simp_all add: collinear_2 insert_commute) + } moreover - { assume x: "x \ 0" and y: "y \ 0" - { assume h: "?lhs" + { + assume x: "x \ 0" and y: "y \ 0" + have ?thesis + proof + assume h: "?lhs" then obtain u where u: "\ x\ {0,x,y}. \y\ {0,x,y}. \c. x - y = c *\<^sub>R u" unfolding collinear_def by blast from u[rule_format, of x 0] u[rule_format, of y 0] @@ -2732,11 +3180,13 @@ let ?d = "cy / cx" from cx cy cx0 have "y = ?d *\<^sub>R x" by simp - then have ?rhs using x y by blast } - moreover - { assume h: "?rhs" - then obtain c where c: "y = c *\<^sub>R x" using x y by blast - have ?lhs unfolding collinear_def c + then show ?rhs using x y by blast + next + assume h: "?rhs" + then obtain c where c: "y = c *\<^sub>R x" + using x y by blast + show ?lhs + unfolding collinear_def c apply (rule exI[where x=x]) apply auto apply (rule exI[where x="- 1"], simp) @@ -2744,12 +3194,13 @@ apply (rule exI[where x=1], simp) apply (rule exI[where x="1 - c"], simp add: scaleR_left_diff_distrib) apply (rule exI[where x="c - 1"], simp add: scaleR_left_diff_distrib) - done } - ultimately have ?thesis by blast } + done + qed + } ultimately show ?thesis by blast qed -lemma norm_cauchy_schwarz_equal: "abs(x \ y) = norm x * norm y \ collinear {0,x,y}" +lemma norm_cauchy_schwarz_equal: "abs (x \ y) = norm x * norm y \ collinear {0, x, y}" unfolding norm_cauchy_schwarz_abs_eq apply (cases "x=0", simp_all add: collinear_2) apply (cases "y=0", simp_all add: collinear_2 insert_commute) @@ -2773,9 +3224,9 @@ unfolding scaleR_scaleR unfolding norm_scaleR apply (subgoal_tac "norm x * c = \c\ * norm x \ norm x * c = - \c\ * norm x") - apply (case_tac "c <= 0", simp add: field_simps) + apply (case_tac "c \ 0", simp add: field_simps) apply (simp add: field_simps) - apply (case_tac "c <= 0", simp add: field_simps) + apply (case_tac "c \ 0", simp add: field_simps) apply (simp add: field_simps) apply simp apply simp @@ -2801,11 +3252,12 @@ fast intro: order_trans) lemma atLeastAtMost_singleton_euclidean[simp]: - fixes a :: "'a::ordered_euclidean_space" shows "{a .. a} = {a}" + fixes a :: "'a::ordered_euclidean_space" + shows "{a .. a} = {a}" by (force simp: eucl_le[where 'a='a] euclidean_eq_iff[where 'a='a]) instance real :: ordered_euclidean_space - by default (auto simp add: Basis_real_def) + by default auto instantiation prod :: (ordered_euclidean_space, ordered_euclidean_space) ordered_euclidean_space begin diff -r d92578436d47 -r d2a7b6fe953e src/HOL/Tools/Sledgehammer/async_manager.ML --- a/src/HOL/Tools/Sledgehammer/async_manager.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/HOL/Tools/Sledgehammer/async_manager.ML Fri Sep 06 10:57:27 2013 +0200 @@ -6,6 +6,8 @@ Central manager for asynchronous diagnosis tool threads. *) +(*Proof General legacy*) + signature ASYNC_MANAGER = sig val break_into_chunks : string -> string list diff -r d92578436d47 -r d2a7b6fe953e src/Pure/General/output.ML --- a/src/Pure/General/output.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Pure/General/output.ML Fri Sep 06 10:57:27 2013 +0200 @@ -95,7 +95,7 @@ structure Internal = struct val writeln_fn = Unsynchronized.ref physical_writeln; - val urgent_message_fn = Unsynchronized.ref (fn s => ! writeln_fn s); + val urgent_message_fn = Unsynchronized.ref (fn s => ! writeln_fn s); (*Proof General legacy*) val tracing_fn = Unsynchronized.ref (fn s => ! writeln_fn s); val warning_fn = Unsynchronized.ref (physical_writeln o prefix_lines "### "); val error_fn = Unsynchronized.ref (fn (_: serial, s) => physical_writeln (prefix_lines "*** " s)); @@ -108,7 +108,7 @@ end; fun writeln s = ! Internal.writeln_fn (output s); -fun urgent_message s = ! Internal.urgent_message_fn (output s); +fun urgent_message s = ! Internal.urgent_message_fn (output s); (*Proof General legacy*) fun tracing s = ! Internal.tracing_fn (output s); fun warning s = ! Internal.warning_fn (output s); fun error_msg' (i, s) = ! Internal.error_fn (i, output s); diff -r d92578436d47 -r d2a7b6fe953e src/Pure/General/symbol.ML --- a/src/Pure/General/symbol.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Pure/General/symbol.ML Fri Sep 06 10:57:27 2013 +0200 @@ -113,6 +113,7 @@ fun not_eof s = s <> eof; val stopper = Scan.stopper (K eof) is_eof; +(*Proof General legacy*) val sync = "\\<^sync>"; fun is_sync s = s = sync; @@ -424,7 +425,7 @@ val scan_encoded_newline = $$ "\^M" -- $$ "\n" >> K "\n" || $$ "\^M" >> K "\n" || - Scan.this_string "\\<^newline>" >> K "\n"; + Scan.this_string "\\<^newline>" >> K "\n"; (*Proof General legacy*) val scan_raw = Scan.this_string "raw:" ^^ (Scan.many raw_chr >> implode) || diff -r d92578436d47 -r d2a7b6fe953e src/Pure/General/symbol.scala --- a/src/Pure/General/symbol.scala Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Pure/General/symbol.scala Fri Sep 06 10:57:27 2013 +0200 @@ -247,7 +247,9 @@ })._1 - /* misc properties */ + /* basic properties */ + + val properties: Map[Symbol, Properties.T] = Map(symbols: _*) val names: Map[Symbol, String] = { @@ -381,6 +383,7 @@ /* tables */ + def properties: Map[Symbol, Properties.T] = symbols.properties def names: Map[Symbol, String] = symbols.names def groups: List[(String, List[Symbol])] = symbols.groups def abbrevs: Multi_Map[Symbol, String] = symbols.abbrevs diff -r d92578436d47 -r d2a7b6fe953e src/Pure/Isar/isar_syn.ML --- a/src/Pure/Isar/isar_syn.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Pure/Isar/isar_syn.ML Fri Sep 06 10:57:27 2013 +0200 @@ -743,6 +743,7 @@ val opt_bang = Scan.optional (@{keyword "!"} >> K true) false; +(*Proof General legacy*) val _ = Outer_Syntax.improper_command @{command_spec "pretty_setmargin"} "change default margin for pretty printing" @@ -958,7 +959,7 @@ "kill theory -- try to remove from loader database" (Parse.name >> (fn name => Toplevel.imperative (fn () => Thy_Info.kill_thy name))); -val _ = +val _ = (*partial Proof General legacy*) Outer_Syntax.improper_command @{command_spec "display_drafts"} "display raw source files with symbols" (Scan.repeat1 Parse.path >> (fn names => @@ -971,7 +972,7 @@ Toplevel.keep (fn state => Print_Mode.with_modes modes (Toplevel.print_state true) state))); -val _ = (*historical, e.g. for ProofGeneral-3.7.x*) +val _ = (*Proof General legacy, e.g. for ProofGeneral-3.7.x*) Outer_Syntax.improper_command @{command_spec "pr"} "print current proof state (if present)" (opt_modes -- Scan.option Parse.nat >> (fn (modes, limit) => Toplevel.keep (fn state => @@ -980,12 +981,12 @@ Toplevel.quiet := false; Print_Mode.with_modes modes (Toplevel.print_state true) state)))); -val _ = +val _ = (*Proof General legacy*) Outer_Syntax.improper_command @{command_spec "disable_pr"} "disable printing of toplevel state" (Scan.succeed (Toplevel.imperative (fn () => Toplevel.quiet := true))); -val _ = +val _ = (*Proof General legacy*) Outer_Syntax.improper_command @{command_spec "enable_pr"} "enable printing of toplevel state" (Scan.succeed (Toplevel.imperative (fn () => Toplevel.quiet := false))); diff -r d92578436d47 -r d2a7b6fe953e src/Pure/Isar/toplevel.ML --- a/src/Pure/Isar/toplevel.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Pure/Isar/toplevel.ML Fri Sep 06 10:57:27 2013 +0200 @@ -225,10 +225,10 @@ (** toplevel transitions **) -val quiet = Unsynchronized.ref false; +val quiet = Unsynchronized.ref false; (*Proof General legacy*) val debug = Runtime.debug; -val interact = Unsynchronized.ref false; -val timing = Unsynchronized.ref false; +val interact = Unsynchronized.ref false; (*Proof General legacy*) +val timing = Unsynchronized.ref false; (*Proof General legacy*) val profiling = Unsynchronized.ref 0; fun program body = @@ -327,7 +327,7 @@ datatype transition = Transition of {name: string, (*command name*) pos: Position.T, (*source position*) - int_only: bool, (*interactive-only*) + int_only: bool, (*interactive-only*) (* TTY / Proof General legacy*) print: bool, (*print result state*) timing: Time.time option, (*prescient timing information*) trans: trans list}; (*primitive transitions (union)*) @@ -556,10 +556,12 @@ (fn Proof (prf, x) => Proof (f prf, x) | _ => raise UNDEF)); +(*Proof General legacy*) fun skip_proof f = transaction (fn _ => (fn Skipped_Proof (h, x) => Skipped_Proof (f h, x) | _ => raise UNDEF)); +(*Proof General legacy*) fun skip_proof_to_theory pred = transaction (fn _ => (fn Skipped_Proof (d, (gthy, _)) => if pred d then Theory (gthy, NONE) else raise UNDEF | _ => raise UNDEF)); diff -r d92578436d47 -r d2a7b6fe953e src/Pure/PIDE/command.ML --- a/src/Pure/PIDE/command.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Pure/PIDE/command.ML Fri Sep 06 10:57:27 2013 +0200 @@ -294,7 +294,7 @@ val _ = print_function "print_state" (fn {command_name, ...} => - SOME {delay = NONE, pri = 1, persistent = true, strict = true, + SOME {delay = NONE, pri = 1, persistent = false, strict = true, print_fn = fn tr => fn st' => let val is_init = Keyword.is_theory_begin command_name; diff -r d92578436d47 -r d2a7b6fe953e src/Pure/System/cygwin_init.scala --- a/src/Pure/System/cygwin_init.scala Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Pure/System/cygwin_init.scala Fri Sep 06 10:57:27 2013 +0200 @@ -7,7 +7,6 @@ package isabelle -import java.lang.System import java.io.{File => JFile, BufferedReader, InputStreamReader} import java.nio.file.{Paths, Files} import java.awt.{GraphicsEnvironment, Point, Font} @@ -21,33 +20,9 @@ object Cygwin_Init { - /* command-line entry point */ - - def main(args: Array[String]) = - { - GUI.init_laf() - try { - require(Platform.is_windows) - - val isabelle_home = System.getProperty("isabelle.home") - if (isabelle_home == null || isabelle_home == "") - error("Unknown Isabelle home directory") - if (!(new JFile(isabelle_home)).isDirectory) - error("Bad Isabelle home directory: " + quote(isabelle_home)) + /* main GUI entry point */ - Swing_Thread.later { main_frame(isabelle_home) } - } - catch { - case exn: Throwable => - GUI.error_dialog(null, "Isabelle init failure", GUI.scrollable_text(Exn.message(exn))) - sys.exit(2) - } - } - - - /* main window */ - - private def main_frame(isabelle_home: String) = new MainFrame + def main_frame(isabelle_home: String, start: => Unit) = new MainFrame { title = "Isabelle system initialization" iconImage = new ImageIcon(isabelle_home + "\\lib\\logo\\isabelle.gif").getImage @@ -73,7 +48,17 @@ /* exit button */ var _return_code: Option[Int] = None - def maybe_exit(): Unit = _return_code.foreach(sys.exit(_)) + def maybe_exit() + { + _return_code match { + case None => + case Some(0) => + visible = false + default_thread_pool.submit(() => start) + case Some(rc) => + sys.exit(rc) + } + } def return_code(rc: Int): Unit = Swing_Thread.later { @@ -102,7 +87,7 @@ default_thread_pool.submit(() => try { - init(isabelle_home, echo) + init_filesystem(isabelle_home, echo) return_code(0) } catch { @@ -116,13 +101,10 @@ /* init Cygwin file-system */ - private def init(isabelle_home: String, echo: String => Unit) + private def init_filesystem(isabelle_home: String, echo: String => Unit) { val cygwin_root = isabelle_home + "\\contrib\\cygwin" - if (!(new JFile(cygwin_root)).isDirectory) - error("Bad Isabelle Cygwin directory: " + quote(cygwin_root)) - def execute(args: String*): Int = { val cwd = new JFile(isabelle_home) @@ -148,7 +130,7 @@ echo("symlinks ...") val symlinks = { - val path = (new JFile(cygwin_root, "isabelle\\symlinks")).toPath + val path = (new JFile(cygwin_root + "\\isabelle\\symlinks")).toPath Files.readAllLines(path, UTF8.charset).toArray.toList.asInstanceOf[List[String]] } @tailrec def recover_symlinks(list: List[String]): Unit = @@ -177,7 +159,6 @@ execute(cygwin_root + "\\bin\\bash.exe", "/isabelle/postinstall") echo("init ...") - System.setProperty("cygwin.root", cygwin_root) Isabelle_System.init() echo("OK") } diff -r d92578436d47 -r d2a7b6fe953e src/Pure/Thy/thy_load.ML --- a/src/Pure/Thy/thy_load.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Pure/Thy/thy_load.ML Fri Sep 06 10:57:27 2013 +0200 @@ -292,7 +292,7 @@ end)); -(* global master path *) +(* global master path *) (*Proof General legacy*) local val master_path = Unsynchronized.ref Path.current; diff -r d92578436d47 -r d2a7b6fe953e src/Pure/Tools/main.scala --- a/src/Pure/Tools/main.scala Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Pure/Tools/main.scala Fri Sep 06 10:57:27 2013 +0200 @@ -1,37 +1,74 @@ /* Title: Pure/Tools/main.scala Author: Makarius -Default Isabelle application wrapper. +Main Isabelle application entry point. */ package isabelle -import scala.swing.TextArea + +import java.lang.System +import java.io.{File => JFile} object Main { def main(args: Array[String]) { - args.toList match { - case "-i" :: rest => - if (Platform.is_windows) Cygwin_Init.main(rest.toArray) + def start: Unit = + { + val (out, rc) = + try { + GUI.init_laf() + Isabelle_System.init() + Isabelle_System.isabelle_tool("jedit", ("-s" :: "--" :: args.toList): _*) + } + catch { case exn: Throwable => (Exn.message(exn), 2) } + + if (rc != 0) + GUI.dialog(null, "Isabelle", "Isabelle output", + GUI.scrollable_text(out + "\nReturn code: " + rc)) + + sys.exit(rc) + } + + if (Platform.is_windows) { + val init_isabelle_home = + try { + GUI.init_laf() + + val isabelle_home0 = System.getenv("ISABELLE_HOME_WINDOWS") + val isabelle_home = System.getProperty("isabelle.home") - case _ => - val (out, rc) = - try { - GUI.init_laf() - Isabelle_System.init() - Isabelle_System.isabelle_tool("jedit", ("-s" :: "--" :: args.toList): _*) + if (isabelle_home0 != null && isabelle_home0 != "") None + else { + if (isabelle_home == null || isabelle_home == "") + error("Unknown Isabelle home directory") + if (!(new JFile(isabelle_home)).isDirectory) + error("Bad Isabelle home directory: " + quote(isabelle_home)) + + val cygwin_root = isabelle_home + "\\contrib\\cygwin" + if ((new JFile(cygwin_root)).isDirectory) + System.setProperty("cygwin.root", cygwin_root) + + val uninitialized_file = new JFile(cygwin_root, "isabelle\\uninitialized") + val uninitialized = uninitialized_file.isFile && uninitialized_file.delete + + if (uninitialized) Some(isabelle_home) else None } - catch { case exn: Throwable => (Exn.message(exn), 2) } - - if (rc != 0) - GUI.dialog(null, "Isabelle", "Isabelle output", - GUI.scrollable_text(out + "\nReturn code: " + rc)) - - sys.exit(rc) + } + catch { + case exn: Throwable => + GUI.dialog(null, "Isabelle", GUI.scrollable_text(Exn.message(exn))) + sys.exit(2) + } + init_isabelle_home match { + case Some(isabelle_home) => + Swing_Thread.later { Cygwin_Init.main_frame(isabelle_home, start) } + case None => start + } } + else start } } diff -r d92578436d47 -r d2a7b6fe953e src/Pure/Tools/proof_general.ML --- a/src/Pure/Tools/proof_general.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Pure/Tools/proof_general.ML Fri Sep 06 10:57:27 2013 +0200 @@ -6,6 +6,8 @@ See also http://proofgeneral.inf.ed.ac.uk *) +(*Proof General legacy*) + signature PROOF_GENERAL = sig type category = string diff -r d92578436d47 -r d2a7b6fe953e src/Pure/Tools/proof_general_pure.ML --- a/src/Pure/Tools/proof_general_pure.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Pure/Tools/proof_general_pure.ML Fri Sep 06 10:57:27 2013 +0200 @@ -5,6 +5,8 @@ Proof General setup within theory Pure. *) +(*Proof General legacy*) + structure ProofGeneral_Pure: sig end = struct diff -r d92578436d47 -r d2a7b6fe953e src/Tools/Code/code_namespace.ML --- a/src/Tools/Code/code_namespace.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Tools/Code/code_namespace.ML Fri Sep 06 10:57:27 2013 +0200 @@ -48,10 +48,11 @@ Code_Symbol.lookup identifiers (symbol_of name) |> Option.map (split_last o Long_Name.explode); -fun force_identifier symbol_of fragments_tab identifiers name = +fun force_identifier symbol_of fragments_tab force_module identifiers name = case lookup_identifier symbol_of identifiers name of NONE => (apfst (the o Symtab.lookup fragments_tab) o split_name) name - | SOME name' => name'; + | SOME prefix_name => if null force_module then prefix_name + else (force_module, snd prefix_name); fun build_module_namespace { module_prefix, module_identifiers, reserved } program = let @@ -79,7 +80,7 @@ else K (SOME module_name); val fragments_tab = build_module_namespace { module_prefix = module_prefix, module_identifiers = module_identifiers, reserved = reserved } program; - val prep_name = force_identifier symbol_of fragments_tab identifiers + val prep_name = force_identifier symbol_of fragments_tab (Long_Name.explode module_name) identifiers #>> Long_Name.implode; (* distribute statements over hierarchy *) @@ -171,7 +172,7 @@ else K (SOME module_name); val fragments_tab = build_module_namespace { module_prefix = "", module_identifiers = module_identifiers, reserved = reserved } program; - val prep_name = force_identifier symbol_of fragments_tab identifiers; + val prep_name = force_identifier symbol_of fragments_tab (Long_Name.explode module_name) identifiers; (* building empty module hierarchy *) val empty_module = (empty_data, Graph.empty); diff -r d92578436d47 -r d2a7b6fe953e src/Tools/Code/code_target.ML --- a/src/Tools/Code/code_target.ML Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Tools/Code/code_target.ML Fri Sep 06 10:57:27 2013 +0200 @@ -417,8 +417,9 @@ fun invoke_serializer thy target some_width module_name args naming program names = let + val check = if module_name = "" then I else check_name true; val (mounted_serializer, prepared_program) = mount_serializer thy - target some_width module_name args naming program names; + target some_width (check module_name) args naming program names; in mounted_serializer prepared_program end; fun assert_module_name "" = error "Empty module name not allowed here" diff -r d92578436d47 -r d2a7b6fe953e src/Tools/jEdit/lib/Tools/jedit --- a/src/Tools/jEdit/lib/Tools/jedit Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Tools/jEdit/lib/Tools/jedit Fri Sep 06 10:57:27 2013 +0200 @@ -221,6 +221,7 @@ "$ISABELLE_JEDIT_BUILD_HOME/contrib/cobra.jar" "$ISABELLE_JEDIT_BUILD_HOME/contrib/js.jar" "$ISABELLE_JEDIT_BUILD_HOME/contrib/idea-icons.jar" + "$ISABELLE_JEDIT_BUILD_HOME/contrib/jsr305-2.0.0.jar" ) declare -a JFREECHART_JARS=() diff -r d92578436d47 -r d2a7b6fe953e src/Tools/jEdit/patches/jedit/annotation --- a/src/Tools/jEdit/patches/jedit/annotation Fri Sep 06 10:56:40 2013 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,45 +0,0 @@ -diff -ru 5.0.0/jEdit/org/gjt/sp/jedit/input/AbstractInputHandler.java 5.0.0/jEdit-patched/org/gjt/sp/jedit/input/AbstractInputHandler.java ---- 5.0.0/jEdit/org/gjt/sp/jedit/input/AbstractInputHandler.java 2012-11-17 16:41:23.000000000 +0100 -+++ 5.0.0/jEdit-patched/org/gjt/sp/jedit/input/AbstractInputHandler.java 2012-12-01 18:40:31.000000000 +0100 -@@ -29,8 +29,6 @@ - import java.awt.event.KeyEvent; - import java.util.Hashtable; - import java.util.StringTokenizer; --import javax.annotation.Nonnull; --import javax.annotation.Nullable; - - import org.gjt.sp.jedit.JEditAbstractEditAction; - import org.gjt.sp.jedit.gui.ShortcutPrefixActiveEvent; -@@ -198,8 +196,7 @@ - * @param keyBinding The key binding - * @since jEdit 3.2pre5 - */ -- @Nullable -- public Object getKeyBinding(@Nonnull String keyBinding) -+ public Object getKeyBinding(String keyBinding) - { - Hashtable current = bindings; - StringTokenizer st = new StringTokenizer(keyBinding); -diff -ru 5.0.0/jEdit/org/gjt/sp/jedit/jEdit.java 5.0.0/jEdit-patched/org/gjt/sp/jedit/jEdit.java ---- 5.0.0/jEdit/org/gjt/sp/jedit/jEdit.java 2012-11-17 16:42:29.000000000 +0100 -+++ 5.0.0/jEdit-patched/org/gjt/sp/jedit/jEdit.java 2012-12-01 18:40:40.000000000 +0100 -@@ -35,8 +35,6 @@ - import org.gjt.sp.jedit.View.ViewConfig; - import org.gjt.sp.jedit.bsh.UtilEvalError; - --import javax.annotation.Nonnull; --import javax.annotation.Nullable; - import javax.swing.*; - import java.awt.event.*; - import java.io.*; -@@ -3853,8 +3851,7 @@ - - } //}}} - -- @Nonnull -- private static String getPLAFClassName(@Nullable String lf) -+ private static String getPLAFClassName(String lf) - { - if (lf != null && lf.length() != 0) - { - diff -r d92578436d47 -r d2a7b6fe953e src/Tools/jEdit/patches/jedit/brackets --- a/src/Tools/jEdit/patches/jedit/brackets Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Tools/jEdit/patches/jedit/brackets Fri Sep 06 10:57:27 2013 +0200 @@ -1,5 +1,6 @@ ---- 5.0.0/jEdit/org/gjt/sp/jedit/TextUtilities.java 2012-11-17 16:42:29.000000000 +0100 -+++ 5.0.0/jEdit-patched/org/gjt/sp/jedit/TextUtilities.java 2013-08-24 15:58:43.075546141 +0200 +diff -ru 5.1.0/jEdit/org/gjt/sp/jedit/TextUtilities.java 5.1.0/jEdit-patched/org/gjt/sp/jedit/TextUtilities.java +--- 5.1.0/jEdit/org/gjt/sp/jedit/TextUtilities.java 2013-07-28 19:03:24.000000000 +0200 ++++ 5.1.0/jEdit-patched/org/gjt/sp/jedit/TextUtilities.java 2013-09-05 10:51:09.996193290 +0200 @@ -97,6 +97,22 @@ case '}': if (direction != null) direction[0] = false; return '{'; case '<': if (direction != null) direction[0] = true; return '>'; diff -r d92578436d47 -r d2a7b6fe953e src/Tools/jEdit/patches/jedit/completion --- a/src/Tools/jEdit/patches/jedit/completion Fri Sep 06 10:56:40 2013 +0200 +++ /dev/null Thu Jan 01 00:00:00 1970 +0000 @@ -1,15 +0,0 @@ -diff -ru 5.0.0/jEdit/org/gjt/sp/jedit/gui/CompletionPopup.java 5.0.0/jEdit-patched/org/gjt/sp/jedit/gui/CompletionPopup.java ---- 5.0.0/jEdit/org/gjt/sp/jedit/gui/CompletionPopup.java 2012-11-17 16:41:58.000000000 +0100 -+++ 5.0.0/jEdit-patched/org/gjt/sp/jedit/gui/CompletionPopup.java 2013-01-04 14:25:57.095172180 +0100 -@@ -113,9 +113,9 @@ - list.setCellRenderer(new CellRenderer()); - list.addKeyListener(keyHandler); - list.addMouseListener(new MouseHandler()); -+ list.setFocusTraversalKeysEnabled(false); - - JPanel content = new JPanel(new BorderLayout()); -- content.setFocusTraversalKeysEnabled(false); - // stupid scrollbar policy is an attempt to work around - // bugs people have been seeing with IBM's JDK -- 7 Sep 2000 - JScrollPane scroller = new JScrollPane(list, - diff -r d92578436d47 -r d2a7b6fe953e src/Tools/jEdit/patches/jedit/extended_styles --- a/src/Tools/jEdit/patches/jedit/extended_styles Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Tools/jEdit/patches/jedit/extended_styles Fri Sep 06 10:57:27 2013 +0200 @@ -1,6 +1,6 @@ -diff -ru 5.0.0/jEdit/org/gjt/sp/jedit/gui/StyleEditor.java 5.0.0/jEdit-patched/org/gjt/sp/jedit/gui/StyleEditor.java ---- 5.0.0/jEdit/org/gjt/sp/jedit/gui/StyleEditor.java 2012-11-17 16:41:58.000000000 +0100 -+++ 5.0.0/jEdit-patched/org/gjt/sp/jedit/gui/StyleEditor.java 2012-12-01 17:34:47.000000000 +0100 +diff -ru 5.1.0/jEdit/org/gjt/sp/jedit/gui/StyleEditor.java 5.1.0/jEdit-patched/org/gjt/sp/jedit/gui/StyleEditor.java +--- 5.1.0/jEdit/org/gjt/sp/jedit/gui/StyleEditor.java 2013-07-28 19:03:38.000000000 +0200 ++++ 5.1.0/jEdit-patched/org/gjt/sp/jedit/gui/StyleEditor.java 2013-09-05 10:51:29.192192327 +0200 @@ -79,7 +79,7 @@ start = next; token = token.next; @@ -10,9 +10,9 @@ { JOptionPane.showMessageDialog(textArea.getView(), jEdit.getProperty("syntax-style-no-token.message"), -diff -ru 5.0.0/jEdit/org/gjt/sp/jedit/syntax/Chunk.java 5.0.0/jEdit-patched/org/gjt/sp/jedit/syntax/Chunk.java ---- 5.0.0/jEdit/org/gjt/sp/jedit/syntax/Chunk.java 2012-11-17 16:42:25.000000000 +0100 -+++ 5.0.0/jEdit-patched/org/gjt/sp/jedit/syntax/Chunk.java 2012-12-01 18:28:35.000000000 +0100 +diff -ru 5.1.0/jEdit/org/gjt/sp/jedit/syntax/Chunk.java 5.1.0/jEdit-patched/org/gjt/sp/jedit/syntax/Chunk.java +--- 5.1.0/jEdit/org/gjt/sp/jedit/syntax/Chunk.java 2013-07-28 19:03:51.000000000 +0200 ++++ 5.1.0/jEdit-patched/org/gjt/sp/jedit/syntax/Chunk.java 2013-09-05 10:51:29.192192327 +0200 @@ -256,9 +256,9 @@ //{{{ Package private members @@ -34,9 +34,9 @@ private GlyphVector[] glyphs; //}}} -diff -ru 5.0.0/jEdit/org/gjt/sp/jedit/syntax/Token.java 5.0.0/jEdit-patched/org/gjt/sp/jedit/syntax/Token.java ---- 5.0.0/jEdit/org/gjt/sp/jedit/syntax/Token.java 2012-11-17 16:42:25.000000000 +0100 -+++ 5.0.0/jEdit-patched/org/gjt/sp/jedit/syntax/Token.java 2012-12-01 17:37:04.000000000 +0100 +diff -ru 5.1.0/jEdit/org/gjt/sp/jedit/syntax/Token.java 5.1.0/jEdit-patched/org/gjt/sp/jedit/syntax/Token.java +--- 5.1.0/jEdit/org/gjt/sp/jedit/syntax/Token.java 2013-07-28 19:03:51.000000000 +0200 ++++ 5.1.0/jEdit-patched/org/gjt/sp/jedit/syntax/Token.java 2013-09-05 10:51:29.192192327 +0200 @@ -57,7 +57,7 @@ */ public static String tokenToString(byte token) @@ -46,9 +46,9 @@ } //}}} //{{{ Token types -diff -ru 5.0.0/jEdit/org/gjt/sp/util/SyntaxUtilities.java 5.0.0/jEdit-patched/org/gjt/sp/util/SyntaxUtilities.java ---- 5.0.0/jEdit/org/gjt/sp/util/SyntaxUtilities.java 2012-11-17 16:42:30.000000000 +0100 -+++ 5.0.0/jEdit-patched/org/gjt/sp/util/SyntaxUtilities.java 2012-12-01 17:40:33.000000000 +0100 +diff -ru 5.1.0/jEdit/org/gjt/sp/util/SyntaxUtilities.java 5.1.0/jEdit-patched/org/gjt/sp/util/SyntaxUtilities.java +--- 5.1.0/jEdit/org/gjt/sp/util/SyntaxUtilities.java 2013-07-28 19:03:53.000000000 +0200 ++++ 5.1.0/jEdit-patched/org/gjt/sp/util/SyntaxUtilities.java 2013-09-05 10:51:29.192192327 +0200 @@ -194,7 +194,24 @@ { return loadStyles(family,size,true); @@ -88,10 +88,10 @@ + private SyntaxUtilities(){} } -diff -ru 5.0.0/jEdit/org/gjt/sp/jedit/textarea/TextArea.java 5.0.0/jEdit-patched/org/gjt/sp/jedit/textarea/TextArea.java ---- 5.0.0/jEdit/org/gjt/sp/jedit/textarea/TextArea.java 2012-11-17 16:41:43.000000000 +0100 -+++ 5.0.0/jEdit-patched/org/gjt/sp/jedit/textarea/TextArea.java 2012-12-01 17:28:12.000000000 +0100 -@@ -906,6 +906,11 @@ +diff -ru 5.1.0/jEdit/org/gjt/sp/jedit/textarea/TextArea.java 5.1.0/jEdit-patched/org/gjt/sp/jedit/textarea/TextArea.java +--- 5.1.0/jEdit/org/gjt/sp/jedit/textarea/TextArea.java 2013-07-28 19:03:32.000000000 +0200 ++++ 5.1.0/jEdit-patched/org/gjt/sp/jedit/textarea/TextArea.java 2013-09-05 10:51:29.196192309 +0200 +@@ -907,6 +907,11 @@ return chunkCache.getLineInfo(screenLine).physicalLine; } //}}} @@ -103,4 +103,3 @@ //{{{ getScreenLineOfOffset() method /** * Returns the screen (wrapped) line containing the specified offset. - diff -r d92578436d47 -r d2a7b6fe953e src/Tools/jEdit/patches/jedit/macos --- a/src/Tools/jEdit/patches/jedit/macos Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Tools/jEdit/patches/jedit/macos Fri Sep 06 10:57:27 2013 +0200 @@ -1,43 +1,13 @@ -diff -ru 5.0.0/jEdit/org/gjt/sp/jedit/OperatingSystem.java 5.0.0/jEdit-patched/org/gjt/sp/jedit/OperatingSystem.java ---- 5.0.0/jEdit/org/gjt/sp/jedit/OperatingSystem.java 2012-11-17 16:42:29.000000000 +0100 -+++ 5.0.0/jEdit-patched/org/gjt/sp/jedit/OperatingSystem.java 2012-12-01 17:32:47.000000000 +0100 -@@ -318,6 +318,10 @@ - { - os = WINDOWS_NT; - } -+ else if(osName.contains("Mac OS X")) -+ { -+ os = MAC_OS_X; -+ } - else if(osName.contains("VMS")) - { - os = VMS; -diff -ru 5.0.0/jEdit/org/gjt/sp/jedit/Debug.java 5.0.0/jEdit-patched/org/gjt/sp/jedit/Debug.java ---- 5.0.0/jEdit/org/gjt/sp/jedit/Debug.java 2012-11-17 16:42:29.000000000 +0100 -+++ 5.0.0/jEdit-patched/org/gjt/sp/jedit/Debug.java 2013-01-04 20:00:25.698332853 +0100 +diff -ru 5.1.0/jEdit/org/gjt/sp/jedit/Debug.java 5.1.0/jEdit-patched/org/gjt/sp/jedit/Debug.java +--- 5.1.0/jEdit/org/gjt/sp/jedit/Debug.java 2013-07-28 19:03:49.000000000 +0200 ++++ 5.1.0/jEdit-patched/org/gjt/sp/jedit/Debug.java 2013-09-05 10:55:36.388181955 +0200 @@ -109,7 +109,7 @@ - * used to handle a modifier key press in conjunction with an alphabet - * key. On by default on MacOS. - */ -- public static boolean ALTERNATIVE_DISPATCHER = OperatingSystem.isMacOS(); -+ public static boolean ALTERNATIVE_DISPATCHER = false; + * used to handle a modifier key press in conjunction with an alphabet + * key. On by default on MacOS. + */ +- public static boolean ALTERNATIVE_DISPATCHER = OperatingSystem.isMacOS(); ++ public static boolean ALTERNATIVE_DISPATCHER = false; - /** - * If true, A+ shortcuts are disabled. If you use this, you should also -diff -ru 5.0.0/jEdit/org/gjt/sp/jedit/gui/KeyEventWorkaround.java 5.0.0/jEdit-patched/org/gjt/sp/jed -it/gui/KeyEventWorkaround.java ---- 5.0.0/jEdit/org/gjt/sp/jedit/gui/KeyEventWorkaround.java 2012-11-17 16:41:58.000000000 +0100 -+++ 5.0.0/jEdit-patched/org/gjt/sp/jedit/gui/KeyEventWorkaround.java 2013-01-04 20:04:43.02632209 -2 +0100 -@@ -297,8 +297,8 @@ - - if(!Debug.ALTERNATIVE_DISPATCHER) - { -- if(((modifiers & InputEvent.CTRL_MASK) != 0 -- ^ (modifiers & InputEvent.ALT_MASK) != 0) -+ if((modifiers & InputEvent.CTRL_MASK) != 0 && (modifiers & InputEvent.ALT_MASK) == 0 -+ || (modifiers & InputEvent.CTRL_MASK) == 0 && (modifiers & InputEvent.ALT_MASK) != 0 && !Debug.ALT_KEY_PRESSED_DISABLED - || (modifiers & InputEvent.META_MASK) != 0) - { - return null; + /** + * If true, A+ shortcuts are disabled. If you use this, you should also diff -r d92578436d47 -r d2a7b6fe953e src/Tools/jEdit/src/completion_popup.scala --- a/src/Tools/jEdit/src/completion_popup.scala Fri Sep 06 10:56:40 2013 +0200 +++ b/src/Tools/jEdit/src/completion_popup.scala Fri Sep 06 10:57:27 2013 +0200 @@ -155,21 +155,21 @@ if (PIDE.options.bool("jedit_completion")) { if (!evt.isConsumed) { dismissed() + if (evt.getKeyChar != '\b') { + val mod = evt.getModifiers + val special = + // cf. 5.1.0/jEdit/org/gjt/sp/jedit/gui/KeyEventWorkaround.java + (mod & InputEvent.CTRL_MASK) != 0 && (mod & InputEvent.ALT_MASK) == 0 || + (mod & InputEvent.CTRL_MASK) == 0 && (mod & InputEvent.ALT_MASK) != 0 && + !Debug.ALT_KEY_PRESSED_DISABLED || + (mod & InputEvent.META_MASK) != 0 - val mod = evt.getModifiers - val special = - evt.getKeyChar == '\b' || - // cf. 5.1.0/jEdit/org/gjt/sp/jedit/gui/KeyEventWorkaround.java - (mod & InputEvent.CTRL_MASK) != 0 && (mod & InputEvent.ALT_MASK) == 0 || - (mod & InputEvent.CTRL_MASK) == 0 && (mod & InputEvent.ALT_MASK) != 0 && - !Debug.ALT_KEY_PRESSED_DISABLED || - (mod & InputEvent.META_MASK) != 0 - - if (PIDE.options.seconds("jedit_completion_delay").is_zero && !special) { - input_delay.revoke() - action(immediate = PIDE.options.bool("jedit_completion_immediate")) + if (PIDE.options.seconds("jedit_completion_delay").is_zero && !special) { + input_delay.revoke() + action(immediate = PIDE.options.bool("jedit_completion_immediate")) + } + else input_delay.invoke() } - else input_delay.invoke() } } } @@ -225,7 +225,9 @@ completion => Swing_Thread.require() + require(!items.isEmpty) + val multi = items.length > 1 /* actions */ @@ -244,6 +246,11 @@ list_view.peer.setVisibleRowCount(items.length min 8) list_view.peer.setSelectedIndex(0) + for (cond <- + List(JComponent.WHEN_FOCUSED, + JComponent.WHEN_ANCESTOR_OF_FOCUSED_COMPONENT, + JComponent.WHEN_IN_FOCUSED_WINDOW)) list_view.peer.setInputMap(cond, null) + private def complete_selected(): Boolean = { list_view.selection.items.toList match { @@ -283,10 +290,18 @@ case KeyEvent.VK_ESCAPE => hide_popup() e.consume - case KeyEvent.VK_UP => move_items(-1); e.consume - case KeyEvent.VK_DOWN => move_items(1); e.consume - case KeyEvent.VK_PAGE_UP => move_pages(-1); e.consume - case KeyEvent.VK_PAGE_DOWN => move_pages(1); e.consume + case KeyEvent.VK_UP | KeyEvent.VK_KP_UP if multi => + move_items(-1) + e.consume + case KeyEvent.VK_DOWN | KeyEvent.VK_KP_DOWN if multi => + move_items(1) + e.consume + case KeyEvent.VK_PAGE_UP if multi => + move_pages(-1) + e.consume + case KeyEvent.VK_PAGE_DOWN if multi => + move_pages(1) + e.consume case _ => if (e.isActionKey || e.isAltDown || e.isMetaDown || e.isControlDown) hide_popup()