# HG changeset patch # User wenzelm # Date 1506190156 -7200 # Node ID ebb97a834338167d693488ca3e419debeccd0f75 # Parent 4b10fa05423baa1ae48a570aa6f5257a2cf5f541# Parent cd8ad4eddb8addf81ca6d70ef91c778cd7e7e440 merged diff -r cd8ad4eddb8a -r ebb97a834338 CONTRIBUTORS --- a/CONTRIBUTORS Sat Sep 23 13:46:48 2017 +0200 +++ b/CONTRIBUTORS Sat Sep 23 20:09:16 2017 +0200 @@ -3,6 +3,10 @@ listed as an author in one of the source files of this Isabelle distribution. +Contributions to this Isabelle version +-------------------------------------- + + Contributions to Isabelle2017 ----------------------------- diff -r cd8ad4eddb8a -r ebb97a834338 NEWS --- a/NEWS Sat Sep 23 13:46:48 2017 +0200 +++ b/NEWS Sat Sep 23 20:09:16 2017 +0200 @@ -4,6 +4,16 @@ (Note: Isabelle/jEdit shows a tree-view of the NEWS file in Sidekick.) +New in this Isabelle version +---------------------------- + +*** HOL *** + +* SMT module: + - The 'smt_oracle' option is now necessary when using the 'smt' method + with a solver other than Z3. INCOMPATIBILITY. + + New in Isabelle2017 (October 2017) ---------------------------------- diff -r cd8ad4eddb8a -r ebb97a834338 src/HOL/Analysis/Conformal_Mappings.thy --- a/src/HOL/Analysis/Conformal_Mappings.thy Sat Sep 23 13:46:48 2017 +0200 +++ b/src/HOL/Analysis/Conformal_Mappings.thy Sat Sep 23 20:09:16 2017 +0200 @@ -739,7 +739,7 @@ lemma holomorphic_factor_zero_nonconstant: assumes holf: "f holomorphic_on S" and S: "open S" "connected S" and "\ \ S" "f \ = 0" - and nonconst: "\c. \z \ S. f z \ c" + and nonconst: "~ f constant_on S" obtains g r n where "0 < n" "0 < r" "ball \ r \ S" "g holomorphic_on ball \ r" @@ -747,7 +747,7 @@ "\w. w \ ball \ r \ g w \ 0" proof (cases "\n>0. (deriv ^^ n) f \ = 0") case True then show ?thesis - using holomorphic_fun_eq_const_on_connected [OF holf S _ \\ \ S\] nonconst by auto + using holomorphic_fun_eq_const_on_connected [OF holf S _ \\ \ S\] nonconst by (simp add: constant_on_def) next case False then obtain n0 where "n0 > 0" and n0: "(deriv ^^ n0) f \ \ 0" by blast @@ -3074,18 +3074,19 @@ lemma holomorphic_factor_zero_Ex1: assumes "open s" "connected s" "z \ s" and - holo:"f holomorphic_on s" - and "f z = 0" and "\w\s. f w \ 0" + holf: "f holomorphic_on s" + and f: "f z = 0" "\w\s. f w \ 0" shows "\!n. \g r. 0 < n \ 0 < r \ g holomorphic_on cball z r \ (\w\cball z r. f w = (w-z)^n * g w \ g w\0)" proof (rule ex_ex1I) - obtain g r n where "0 < n" "0 < r" "ball z r \ s" and + have "\ f constant_on s" + by (metis \z\s\ constant_on_def f) + then obtain g r n where "0 < n" "0 < r" "ball z r \ s" and g:"g holomorphic_on ball z r" "\w. w \ ball z r \ f w = (w - z) ^ n * g w" "\w. w \ ball z r \ g w \ 0" - using holomorphic_factor_zero_nonconstant[OF holo \open s\ \connected s\ \z\s\ \f z=0\] - by (metis assms(3) assms(5) assms(6)) + by (blast intro: holomorphic_factor_zero_nonconstant[OF holf \open s\ \connected s\ \z\s\ \f z=0\]) define r' where "r' \ r/2" have "cball z r' \ ball z r" unfolding r'_def by (simp add: \0 < r\ cball_subset_ball_iff) hence "cball z r' \ s" "g holomorphic_on cball z r'" diff -r cd8ad4eddb8a -r ebb97a834338 src/HOL/Analysis/Great_Picard.thy --- a/src/HOL/Analysis/Great_Picard.thy Sat Sep 23 13:46:48 2017 +0200 +++ b/src/HOL/Analysis/Great_Picard.thy Sat Sep 23 20:09:16 2017 +0200 @@ -1000,7 +1000,7 @@ and holf: "\n::nat. \ n holomorphic_on S" and holg: "g holomorphic_on S" and ul_g: "\K. \compact K; K \ S\ \ uniform_limit K \ g sequentially" - and nonconst: "\c. \z \ S. g z \ c" + and nonconst: "~ g constant_on S" and nz: "\n z. z \ S \ \ n z \ 0" and "z0 \ S" shows "g z0 \ 0" @@ -1164,14 +1164,14 @@ and holf: "\n::nat. \ n holomorphic_on S" and holg: "g holomorphic_on S" and ul_g: "\K. \compact K; K \ S\ \ uniform_limit K \ g sequentially" - and nonconst: "\c. \z \ S. g z \ c" + and nonconst: "~ g constant_on S" and inj: "\n. inj_on (\ n) S" shows "inj_on g S" proof - have False if z12: "z1 \ S" "z2 \ S" "z1 \ z2" "g z2 = g z1" for z1 z2 proof - obtain z0 where "z0 \ S" and z0: "g z0 \ g z2" - using nonconst by blast + using constant_on_def nonconst by blast have "(\z. g z - g z1) holomorphic_on S" by (intro holomorphic_intros holg) then obtain r where "0 < r" "ball z2 r \ S" "\z. dist z2 z < r \ z \ z2 \ g z \ g z1" @@ -1214,7 +1214,8 @@ show "\\<^sub>F n in sequentially. \x\K. dist (\ n x - \ n z1) (g x - g z1) < e" by simp qed - show "\c. \z\S - {z1}. g z - g z1 \ c" + show "\ (\z. g z - g z1) constant_on S - {z1}" + unfolding constant_on_def by (metis Diff_iff \z0 \ S\ empty_iff insert_iff right_minus_eq z0 z12) show "\n z. z \ S - {z1} \ \ n z - \ n z1 \ 0" by (metis DiffD1 DiffD2 eq_iff_diff_eq_0 inj inj_onD insertI1 \z1 \ S\) @@ -1360,8 +1361,9 @@ using \Z \ S\ e hol\ by force show "\n z. z \ ball v e \ (\ \ j) n z \ 0" using \not0 \Z \ S\ e by fastforce - show "\z\ball v e. h z \ c" for c - proof - + show "\ h constant_on ball v e" + proof (clarsimp simp: constant_on_def) + fix c have False if "\z. dist v z < e \ h z = c" proof - have "h v = c" @@ -1389,7 +1391,7 @@ show False using \C < cmod (\ (j n) y)\ le_C not_less by blast qed - then show ?thesis by force + then show "\x\ball v e. h x \ c" by force qed show "h holomorphic_on ball v e" by (simp add: holh) @@ -1828,7 +1830,6 @@ by meson qed - corollary Casorati_Weierstrass: assumes "open M" "z \ M" "f holomorphic_on (M - {z})" and "\l. \ (f \ l) (at z)" "\l. \ ((inverse \ f) \ l) (at z)" diff -r cd8ad4eddb8a -r ebb97a834338 src/HOL/Analysis/Polytope.thy --- a/src/HOL/Analysis/Polytope.thy Sat Sep 23 13:46:48 2017 +0200 +++ b/src/HOL/Analysis/Polytope.thy Sat Sep 23 20:09:16 2017 +0200 @@ -806,6 +806,75 @@ qed qed +lemma exposed_face_of_parallel: + "T exposed_face_of S \ + T face_of S \ + (\a b. S \ {x. a \ x \ b} \ T = S \ {x. a \ x = b} \ + (T \ {} \ T \ S \ a \ 0) \ + (T \ S \ (\w \ affine hull S. (w + a) \ affine hull S)))" + (is "?lhs = ?rhs") +proof + assume ?lhs then show ?rhs + proof (clarsimp simp: exposed_face_of_def) + fix a b + assume faceS: "S \ {x. a \ x = b} face_of S" and Ssub: "S \ {x. a \ x \ b}" + show "\c d. S \ {x. c \ x \ d} \ + S \ {x. a \ x = b} = S \ {x. c \ x = d} \ + (S \ {x. a \ x = b} \ {} \ S \ {x. a \ x = b} \ S \ c \ 0) \ + (S \ {x. a \ x = b} \ S \ (\w \ affine hull S. w + c \ affine hull S))" + proof (cases "affine hull S \ {x. -a \ x \ -b} = {} \ affine hull S \ {x. - a \ x \ - b}") + case True + then show ?thesis + proof + assume "affine hull S \ {x. - a \ x \ - b} = {}" + then show ?thesis + apply (rule_tac x="0" in exI) + apply (rule_tac x="1" in exI) + using hull_subset by fastforce + next + assume "affine hull S \ {x. - a \ x \ - b}" + then show ?thesis + apply (rule_tac x="0" in exI) + apply (rule_tac x="0" in exI) + using Ssub hull_subset by fastforce + qed + next + case False + then obtain a' b' where "a' \ 0" + and le: "affine hull S \ {x. a' \ x \ b'} = affine hull S \ {x. - a \ x \ - b}" + and eq: "affine hull S \ {x. a' \ x = b'} = affine hull S \ {x. - a \ x = - b}" + and mem: "\w. w \ affine hull S \ w + a' \ affine hull S" + using affine_parallel_slice affine_affine_hull by metis + show ?thesis + proof (intro conjI impI allI ballI exI) + have *: "S \ - (affine hull S \ {x. P x}) \ affine hull S \ {x. Q x} \ S \ {x. ~P x \ Q x}" + for P Q + using hull_subset by fastforce + have "S \ {x. ~ (a' \ x \ b') \ a' \ x = b'}" + apply (rule *) + apply (simp only: le eq) + using Ssub by auto + then show "S \ {x. - a' \ x \ - b'}" + by auto + show "S \ {x. a \ x = b} = S \ {x. - a' \ x = - b'}" + using eq hull_subset [of S affine] by force + show "\S \ {x. a \ x = b} \ {}; S \ {x. a \ x = b} \ S\ \ - a' \ 0" + using \a' \ 0\ by auto + show "w + - a' \ affine hull S" + if "S \ {x. a \ x = b} \ S" "w \ affine hull S" for w + proof - + have "w + 1 *\<^sub>R (w - (w + a')) \ affine hull S" + using affine_affine_hull mem mem_affine_3_minus that(2) by blast + then show ?thesis by simp + qed + qed + qed +qed +next + assume ?rhs then show ?lhs + unfolding exposed_face_of_def by blast +qed + subsection\Extreme points of a set: its singleton faces\ definition extreme_point_of :: "['a::real_vector, 'a set] \ bool" diff -r cd8ad4eddb8a -r ebb97a834338 src/HOL/Library/Stirling.thy --- a/src/HOL/Library/Stirling.thy Sat Sep 23 13:46:48 2017 +0200 +++ b/src/HOL/Library/Stirling.thy Sat Sep 23 20:09:16 2017 +0200 @@ -246,7 +246,7 @@ \ definition zip_with_prev :: "('a \ 'a \ 'b) \ 'a \ 'a list \ 'b list" - where "zip_with_prev f x xs = map (\(x,y). f x y) (zip (x # xs) xs)" + where "zip_with_prev f x xs = map2 f (x # xs) xs" lemma zip_with_prev_altdef: "zip_with_prev f x xs = diff -r cd8ad4eddb8a -r ebb97a834338 src/HOL/Library/Tree.thy --- a/src/HOL/Library/Tree.thy Sat Sep 23 13:46:48 2017 +0200 +++ b/src/HOL/Library/Tree.thy Sat Sep 23 20:09:16 2017 +0200 @@ -475,6 +475,12 @@ lemma height_mirror[simp]: "height(mirror t) = height t" by (induction t) simp_all +lemma min_height_mirror [simp]: "min_height (mirror t) = min_height t" +by (induction t) simp_all + +lemma ipl_mirror [simp]: "ipl (mirror t) = ipl t" +by (induction t) simp_all + lemma inorder_mirror: "inorder(mirror t) = rev(inorder t)" by (induction t) simp_all diff -r cd8ad4eddb8a -r ebb97a834338 src/HOL/List.thy --- a/src/HOL/List.thy Sat Sep 23 13:46:48 2017 +0200 +++ b/src/HOL/List.thy Sat Sep 23 20:09:16 2017 +0200 @@ -151,6 +151,9 @@ \ \Warning: simpset does not contain this definition, but separate theorems for \xs = []\ and \xs = z # zs\\ +abbreviation map2 :: "('a \ 'b \ 'c) \ 'a list \ 'b list \ 'c list" where +"map2 f xs ys \ map (\(x,y). f x y) (zip xs ys)" + primrec product :: "'a list \ 'b list \ ('a \ 'b) list" where "product [] _ = []" | "product (x#xs) ys = map (Pair x) ys @ product xs ys" @@ -2011,11 +2014,17 @@ subsubsection \@{const take} and @{const drop}\ -lemma take_0 [simp]: "take 0 xs = []" +lemma take_0: "take 0 xs = []" +by (induct xs) auto + +lemma drop_0: "drop 0 xs = xs" by (induct xs) auto -lemma drop_0 [simp]: "drop 0 xs = xs" -by (induct xs) auto +lemma take0[simp]: "take 0 = (\xs. [])" +by(rule ext) (rule take_0) + +lemma drop0[simp]: "drop 0 = (\x. x)" +by(rule ext) (rule drop_0) lemma take_Suc_Cons [simp]: "take (Suc n) (x # xs) = x # take n xs" by simp @@ -2031,6 +2040,9 @@ lemma drop_Suc: "drop (Suc n) xs = drop n (tl xs)" by(cases xs, simp_all) +lemma hd_take: "j > 0 \ hd (take j xs) = hd xs" +by (metis gr0_conv_Suc list.sel(1) take.simps(1) take_Suc) + lemma take_tl: "take n (tl xs) = tl (take (Suc n) xs)" by (induct xs arbitrary: n) simp_all @@ -4393,12 +4405,12 @@ done lemma nths_shift_lemma: - "map fst [p<-zip xs [i.. distinct (nths xs I)" - by (induct xs arbitrary: I) (auto simp: nths_Cons) - +by (induct xs arbitrary: I) (auto simp: nths_Cons) lemma nths_upt_eq_take [simp]: "nths l {.. P(xs!i)}" +by(induction xs) (auto simp: nths_Cons) lemma filter_in_nths: - "distinct xs \ filter (%x. x \ set (nths xs s)) xs = nths xs s" + "distinct xs \ filter (%x. x \ set (nths xs s)) xs = nths xs s" proof (induct xs arbitrary: s) case Nil thus ?case by simp next @@ -5123,7 +5136,7 @@ text\Currently it is not shown that @{const sort} returns a permutation of its input because the nicest proof is via multisets, -which are not yet available. Alternatively one could define a function +which are not part of Main. Alternatively one could define a function that counts the number of occurrences of an element in a list and use that instead of multisets to state the correctness property.\ @@ -5336,6 +5349,59 @@ "sorted (map fst (enumerate n xs))" by (simp add: enumerate_eq_zip) +text \Stability of function @{const sort_key}:\ + +lemma sort_key_stable: + "x \ set xs \ [y <- sort_key f xs. f y = f x] = [y <- xs. f y = f x]" +proof (induction xs arbitrary: x) + case Nil thus ?case by simp +next + case (Cons a xs) + thus ?case + proof (cases "x \ set xs") + case True + thus ?thesis + proof (cases "f a = f x") + case False thus ?thesis + using Cons.IH by (metis (mono_tags) True filter.simps(2) filter_sort) + next + case True + hence ler: "[y <- (a # xs). f y = f x] = a # [y <- xs. f y = f a]" by simp + have "\y \ set (sort_key f [y <- xs. f y = f a]). f y = f a" by simp + hence "insort_key f a (sort_key f [y <- xs. f y = f a]) + = a # (sort_key f [y <- xs. f y = f a])" + by (simp add: insort_is_Cons) + hence lel: "[y <- sort_key f (a # xs). f y = f x] = a # [y <- sort_key f xs. f y = f a]" + by (metis True filter_sort ler sort_key_simps(2)) + from lel ler show ?thesis using Cons.IH \x \ set xs\ by (metis True filter_sort) + qed + next + case False + from Cons.prems have "x = a" by (metis False set_ConsD) + have ler: "[y <- (a # xs). f y = f a] = a # [y <- xs. f y = f a]" by simp + have "\y \ set (sort_key f [y <- xs. f y = f a]). f y = f a" by simp + hence "insort_key f a (sort_key f [y <- xs. f y = f a]) + = a # (sort_key f [y <- xs. f y = f a])" + by (simp add: insort_is_Cons) + hence lel: "[y <- sort_key f (a # xs). f y = f a] = a # [y <- sort_key f xs. f y = f a]" + by (metis (mono_tags) filter.simps(2) filter_sort sort_key_simps(2)) + show ?thesis (is "?l = ?r") + proof (cases "f a \ set (map f xs)") + case False + hence "\y \ set xs. f y \ f a" by (metis image_eqI set_map) + hence R: "?r = [a]" using ler \x=a\ by simp + have L: "?l = [a]" using lel \x=a\ by (metis R filter_sort insort_key.simps(1) sort_key_simps) + from L R show ?thesis .. + next + case True + then obtain z where Z: "z \ set xs \ f z = f a" by auto + hence L: "[y <- sort_key f xs. f y = f z] = [y <- sort_key f xs. f y = f a]" by simp + from Z have R: "[y <- xs. f y = f z] = [y <- xs. f y = f a]" by simp + from L R Z show ?thesis using Cons.IH ler lel \x=a\ by metis + qed + qed +qed + subsubsection \@{const transpose} on sorted lists\ diff -r cd8ad4eddb8a -r ebb97a834338 src/HOL/Tools/SMT/smt_solver.ML --- a/src/HOL/Tools/SMT/smt_solver.ML Sat Sep 23 13:46:48 2017 +0200 +++ b/src/HOL/Tools/SMT/smt_solver.ML Sat Sep 23 20:09:16 2017 +0200 @@ -202,9 +202,13 @@ (replay_data as {context = ctxt, ...} : SMT_Translate.replay_data) output = (case outcome output of (Unsat, lines) => - if not (Config.get ctxt SMT_Config.oracle) andalso is_some replay0 - then the replay0 outer_ctxt replay_data lines - else oracle () + if Config.get ctxt SMT_Config.oracle then + oracle () + else + (case replay0 of + SOME replay => replay outer_ctxt replay_data lines + | NONE => error "No proof reconstruction for solver -- \ + \declare [[smt_oracle]] to allow oracle") | (result, _) => raise SMT_Failure.SMT (SMT_Failure.Counterexample (result = Sat))) val cfalse = Thm.cterm_of @{context} @{prop False}