# HG changeset patch # User wenzelm # Date 1348253688 -7200 # Node ID 4d2c93e1d9c80be565bf41818e9f6ec33871f830 # Parent b377da40244bc39f116849d2a5904652910673e2 misc tuning; diff -r b377da40244b -r 4d2c93e1d9c8 src/HOL/Decision_Procs/DP_Library.thy --- a/src/HOL/Decision_Procs/DP_Library.thy Fri Sep 21 19:17:49 2012 +0200 +++ b/src/HOL/Decision_Procs/DP_Library.thy Fri Sep 21 20:54:48 2012 +0200 @@ -2,35 +2,38 @@ imports Main begin -primrec alluopairs:: "'a list \ ('a \ 'a) list" where +primrec alluopairs:: "'a list \ ('a \ 'a) list" +where "alluopairs [] = []" | "alluopairs (x#xs) = (map (Pair x) (x#xs))@(alluopairs xs)" lemma alluopairs_set1: "set (alluopairs xs) \ {(x,y). x\ set xs \ y\ set xs}" -by (induct xs, auto) + by (induct xs) auto lemma alluopairs_set: "\x\ set xs ; y \ set xs\ \ (x,y) \ set (alluopairs xs) \ (y,x) \ set (alluopairs xs) " -by (induct xs, auto) + by (induct xs) auto lemma alluopairs_bex: assumes Pc: "\ x \ set xs. \y\ set xs. P x y = P y x" shows "(\ x \ set xs. \ y \ set xs. P x y) = (\ (x,y) \ set (alluopairs xs). P x y)" proof assume "\x\set xs. \y\set xs. P x y" - then obtain x y where x: "x \ set xs" and y:"y \ set xs" and P: "P x y" by blast + then obtain x y where x: "x \ set xs" and y:"y \ set xs" and P: "P x y" + by blast from alluopairs_set[OF x y] P Pc x y show"\(x, y)\set (alluopairs xs). P x y" by auto next assume "\(x, y)\set (alluopairs xs). P x y" - then obtain "x" and "y" where xy:"(x,y) \ set (alluopairs xs)" and P: "P x y" by blast+ + then obtain "x" and "y" where xy: "(x,y) \ set (alluopairs xs)" and P: "P x y" + by blast+ from xy have "x \ set xs \ y\ set xs" using alluopairs_set1 by blast with P show "\x\set xs. \y\set xs. P x y" by blast qed lemma alluopairs_ex: - "\ x y. P x y = P y x \ - (\ x \ set xs. \ y \ set xs. P x y) = (\ (x,y) \ set (alluopairs xs). P x y)" -by(blast intro!: alluopairs_bex) + "\x y. P x y = P y x \ + (\x \ set xs. \ y \ set xs. P x y) = (\(x,y) \ set (alluopairs xs). P x y)" + by (blast intro!: alluopairs_bex) end diff -r b377da40244b -r 4d2c93e1d9c8 src/HOL/Decision_Procs/Dense_Linear_Order.thy --- a/src/HOL/Decision_Procs/Dense_Linear_Order.thy Fri Sep 21 19:17:49 2012 +0200 +++ b/src/HOL/Decision_Procs/Dense_Linear_Order.thy Fri Sep 21 20:54:48 2012 +0200 @@ -17,17 +17,21 @@ context linorder begin -lemma less_not_permute[no_atp]: "\ (x < y \ y < x)" by (simp add: not_less linear) +lemma less_not_permute[no_atp]: "\ (x < y \ y < x)" + by (simp add: not_less linear) lemma gather_simps[no_atp]: - shows - "(\x. (\y \ L. y < x) \ (\y \ U. x < y) \ x < u \ P x) \ (\x. (\y \ L. y < x) \ (\y \ (insert u U). x < y) \ P x)" - and "(\x. (\y \ L. y < x) \ (\y \ U. x < y) \ l < x \ P x) \ (\x. (\y \ (insert l L). y < x) \ (\y \ U. x < y) \ P x)" - "(\x. (\y \ L. y < x) \ (\y \ U. x < y) \ x < u) \ (\x. (\y \ L. y < x) \ (\y \ (insert u U). x < y))" - and "(\x. (\y \ L. y < x) \ (\y \ U. x < y) \ l < x) \ (\x. (\y \ (insert l L). y < x) \ (\y \ U. x < y))" by auto + "(\x. (\y \ L. y < x) \ (\y \ U. x < y) \ x < u \ P x) \ + (\x. (\y \ L. y < x) \ (\y \ (insert u U). x < y) \ P x)" + "(\x. (\y \ L. y < x) \ (\y \ U. x < y) \ l < x \ P x) \ + (\x. (\y \ (insert l L). y < x) \ (\y \ U. x < y) \ P x)" + "(\x. (\y \ L. y < x) \ (\y \ U. x < y) \ x < u) \ + (\x. (\y \ L. y < x) \ (\y \ (insert u U). x < y))" + "(\x. (\y \ L. y < x) \ (\y \ U. x < y) \ l < x) \ + (\x. (\y \ (insert l L). y < x) \ (\y \ U. x < y))" + by auto -lemma - gather_start[no_atp]: "(\x. P x) \ (\x. (\y \ {}. y < x) \ (\y\ {}. x < y) \ P x)" +lemma gather_start [no_atp]: "(\x. P x) \ (\x. (\y \ {}. y < x) \ (\y\ {}. x < y) \ P x)" by simp text{* Theorems for @{text "\z. \x. x < z \ (P x \ P\<^bsub>-\\<^esub>)"}*} @@ -43,8 +47,8 @@ lemma minf_P[no_atp]: "\z. \x. x < z \ (P \ P)" by blast text{* Theorems for @{text "\z. \x. x < z \ (P x \ P\<^bsub>+\\<^esub>)"}*} -lemma pinf_gt[no_atp]: "\z . \x. z < x \ (t < x \ True)" by auto -lemma pinf_lt[no_atp]: "\z . \x. z < x \ (x < t \ False)" +lemma pinf_gt[no_atp]: "\z. \x. z < x \ (t < x \ True)" by auto +lemma pinf_lt[no_atp]: "\z. \x. z < x \ (x < t \ False)" by (simp add: not_less) (rule exI[where x="t"], auto simp add: less_le) lemma pinf_ge[no_atp]: "\z. \x. z < x \ (t \ x \ True)" by (auto simp add: less_le) @@ -81,60 +85,84 @@ lemma npi_disj[no_atp]: "\\x. \P1' \ P1 x \ (\ u\ U. x \ u) ; \x. \P2' \ P2 x \ (\ u\ U. x \ u)\ \ \x. \(P1' \ P2') \ (P1 x \ P2 x) \ (\ u\ U. x \ u)" by auto -lemma lin_dense_lt[no_atp]: "t \ U \ \x l u. (\ t. l < t \ t < u \ t \ U) \ l< x \ x < u \ x < t \ (\ y. l < y \ y < u \ y < t)" +lemma lin_dense_lt[no_atp]: + "t \ U \ + \x l u. (\ t. l < t \ t < u \ t \ U) \ l< x \ x < u \ x < t \ (\ y. l < y \ y < u \ y < t)" proof(clarsimp) - fix x l u y assume tU: "t \ U" and noU: "\t. l < t \ t < u \ t \ U" and lx: "l < x" + fix x l u y + assume tU: "t \ U" and noU: "\t. l < t \ t < u \ t \ U" and lx: "l < x" and xu: "xy" by auto - {assume H: "t < y" + { assume H: "t < y" from less_trans[OF lx px] less_trans[OF H yu] - have "l < t \ t < u" by simp - with tU noU have "False" by auto} - hence "\ t < y" by auto hence "y \ t" by (simp add: not_less) - thus "y < t" using tny by (simp add: less_le) + have "l < t \ t < u" by simp + with tU noU have "False" by auto } + then have "\ t < y" by auto + then have "y \ t" by (simp add: not_less) + then show "y < t" using tny by (simp add: less_le) qed -lemma lin_dense_gt[no_atp]: "t \ U \ \x l u. (\ t. l < t \ t< u \ t \ U) \ l < x \ x < u \ t < x \ (\ y. l < y \ y < u \ t < y)" +lemma lin_dense_gt[no_atp]: + "t \ U \ + \x l u. (\ t. l < t \ t< u \ t \ U) \ l < x \ x < u \ t < x \ (\ y. l < y \ y < u \ t < y)" +proof(clarsimp) + fix x l u y + assume tU: "t \ U" and noU: "\t. l < t \ t < u \ t \ U" and lx: "l < x" and xu: "xy" by auto + { assume H: "y< t" + from less_trans[OF ly H] less_trans[OF px xu] have "l < t \ t < u" by simp + with tU noU have "False" by auto } + then have "\ y y" by (auto simp add: not_less) + then show "t < y" using tny by (simp add: less_le) +qed + +lemma lin_dense_le[no_atp]: + "t \ U \ + \x l u. (\ t. l < t \ t< u \ t \ U) \ l< x \ x < u \ x \ t \ (\ y. l < y \ y < u \ y\ t)" proof(clarsimp) fix x l u y assume tU: "t \ U" and noU: "\t. l < t \ t < u \ t \ U" and lx: "l < x" and xu: "x t" and ly: "ly" by auto - {assume H: "y< t" - from less_trans[OF ly H] less_trans[OF px xu] have "l < t \ t < u" by simp - with tU noU have "False" by auto} - hence "\ y y" by (auto simp add: not_less) - thus "t < y" using tny by (simp add:less_le) + { assume H: "t < y" + from less_le_trans[OF lx px] less_trans[OF H yu] + have "l < t \ t < u" by simp + with tU noU have "False" by auto } + then have "\ t < y" by auto + then show "y \ t" by (simp add: not_less) qed -lemma lin_dense_le[no_atp]: "t \ U \ \x l u. (\ t. l < t \ t< u \ t \ U) \ l< x \ x < u \ x \ t \ (\ y. l < y \ y < u \ y\ t)" +lemma lin_dense_ge[no_atp]: + "t \ U \ + \x l u. (\ t. l < t \ t< u \ t \ U) \ l< x \ x < u \ t \ x \ (\ y. l < y \ y < u \ t \ y)" proof(clarsimp) fix x l u y assume tU: "t \ U" and noU: "\t. l < t \ t < u \ t \ U" and lx: "l < x" and xu: "x t" and ly: "l x" and ly: "ly" by auto - {assume H: "t < y" - from less_le_trans[OF lx px] less_trans[OF H yu] + { assume H: "y< t" + from less_trans[OF ly H] le_less_trans[OF px xu] have "l < t \ t < u" by simp - with tU noU have "False" by auto} - hence "\ t < y" by auto thus "y \ t" by (simp add: not_less) + with tU noU have "False" by auto } + then have "\ y y" by (simp add: not_less) qed -lemma lin_dense_ge[no_atp]: "t \ U \ \x l u. (\ t. l < t \ t< u \ t \ U) \ l< x \ x < u \ t \ x \ (\ y. l < y \ y < u \ t \ y)" -proof(clarsimp) - fix x l u y - assume tU: "t \ U" and noU: "\t. l < t \ t < u \ t \ U" and lx: "l < x" and xu: "x x" and ly: "ly" by auto - {assume H: "y< t" - from less_trans[OF ly H] le_less_trans[OF px xu] - have "l < t \ t < u" by simp - with tU noU have "False" by auto} - hence "\ y y" by (simp add: not_less) -qed -lemma lin_dense_eq[no_atp]: "t \ U \ \x l u. (\ t. l < t \ t< u \ t \ U) \ l< x \ x < u \ x = t \ (\ y. l < y \ y < u \ y= t)" by auto -lemma lin_dense_neq[no_atp]: "t \ U \ \x l u. (\ t. l < t \ t< u \ t \ U) \ l< x \ x < u \ x \ t \ (\ y. l < y \ y < u \ y\ t)" by auto -lemma lin_dense_P[no_atp]: "\x l u. (\ t. l < t \ t< u \ t \ U) \ l< x \ x < u \ P \ (\ y. l < y \ y < u \ P)" by auto +lemma lin_dense_eq[no_atp]: + "t \ U \ + \x l u. (\ t. l < t \ t< u \ t \ U) \ l< x \ x < u \ x = t \ (\ y. l < y \ y < u \ y= t)" + by auto + +lemma lin_dense_neq[no_atp]: + "t \ U \ + \x l u. (\ t. l < t \ t< u \ t \ U) \ l< x \ x < u \ x \ t \ (\ y. l < y \ y < u \ y\ t)" + by auto + +lemma lin_dense_P[no_atp]: + "\x l u. (\ t. l < t \ t< u \ t \ U) \ l< x \ x < u \ P \ (\ y. l < y \ y < u \ P)" + by auto lemma lin_dense_conj[no_atp]: "\\x l u. (\ t. l < t \ t< u \ t \ U) \ l< x \ x < u \ P1 x @@ -155,13 +183,13 @@ lemma npmibnd[no_atp]: "\\x. \ MP \ P x \ (\ u\ U. u \ x); \x. \PP \ P x \ (\ u\ U. x \ u)\ \ \x. \ MP \ \PP \ P x \ (\ u\ U. \ u' \ U. u \ x \ x \ u')" -by auto + by auto lemma finite_set_intervals[no_atp]: assumes px: "P x" and lx: "l \ x" and xu: "x \ u" and linS: "l\ S" - and uinS: "u \ S" and fS:"finite S" and lS: "\ x\ S. l \ x" and Su: "\ x\ S. x \ u" + and uinS: "u \ S" and fS:"finite S" and lS: "\ x\ S. l \ x" and Su: "\ x\ S. x \ u" shows "\ a \ S. \ b \ S. (\ y. a < y \ y < b \ y \ S) \ a \ x \ x \ b \ P x" -proof- +proof - let ?Mx = "{y. y\ S \ y \ x}" let ?xM = "{y. y\ S \ x \ y}" let ?a = "Max ?Mx" @@ -180,37 +208,45 @@ have "?b \ ?xM" using Min_in[OF fxM xMne] by simp hence binS: "?b \ S" using xMS by blast have noy:"\ y. ?a < y \ y < ?b \ y \ S" proof(clarsimp) - fix y assume ay: "?a < y" and yb: "y < ?b" and yS: "y \ S" + fix y + assume ay: "?a < y" and yb: "y < ?b" and yS: "y \ S" from yS have "y\ ?Mx \ y\ ?xM" by (auto simp add: linear) - moreover {assume "y \ ?Mx" hence "y \ ?a" using Mxne fMx by auto with ay have "False" by (simp add: not_le[symmetric])} - moreover {assume "y \ ?xM" hence "?b \ y" using xMne fxM by auto with yb have "False" by (simp add: not_le[symmetric])} - ultimately show "False" by blast + moreover { + assume "y \ ?Mx" + hence "y \ ?a" using Mxne fMx by auto + with ay have "False" by (simp add: not_le[symmetric]) + } + moreover { + assume "y \ ?xM" + hence "?b \ y" using xMne fxM by auto + with yb have "False" by (simp add: not_le[symmetric]) + } + ultimately show False by blast qed from ainS binS noy ax xb px show ?thesis by blast qed lemma finite_set_intervals2[no_atp]: assumes px: "P x" and lx: "l \ x" and xu: "x \ u" and linS: "l\ S" - and uinS: "u \ S" and fS:"finite S" and lS: "\ x\ S. l \ x" and Su: "\ x\ S. x \ u" + and uinS: "u \ S" and fS:"finite S" and lS: "\ x\ S. l \ x" and Su: "\ x\ S. x \ u" shows "(\ s\ S. P s) \ (\ a \ S. \ b \ S. (\ y. a < y \ y < b \ y \ S) \ a < x \ x < b \ P x)" proof- from finite_set_intervals[where P="P", OF px lx xu linS uinS fS lS Su] - obtain a and b where - as: "a\ S" and bs: "b\ S" and noS:"\y. a < y \ y < b \ y \ S" - and axb: "a \ x \ x \ b \ P x" by auto + obtain a and b where as: "a\ S" and bs: "b\ S" and noS:"\y. a < y \ y < b \ y \ S" + and axb: "a \ x \ x \ b \ P x" by auto from axb have "x= a \ x= b \ (a < x \ x < b)" by (auto simp add: le_less) thus ?thesis using px as bs noS by blast qed end + section {* The classical QE after Langford for dense linear orders *} context dense_linorder begin -lemma interval_empty_iff: - "{y. x < y \ y < z} = {} \ \ x < z" +lemma interval_empty_iff: "{y. x < y \ y < z} = {} \ \ x < z" by (auto dest: dense) lemma dlo_qe_bnds[no_atp]: @@ -219,11 +255,11 @@ proof (simp only: atomize_eq, rule iffI) assume H: "\x. (\y\L. y < x) \ (\y\U. x < y)" then obtain x where xL: "\y\L. y < x" and xU: "\y\U. x < y" by blast - {fix l u assume l: "l \ L" and u: "u \ U" + { fix l u assume l: "l \ L" and u: "u \ U" have "l < x" using xL l by blast also have "x < u" using xU u by blast - finally (less_trans) have "l < u" .} - thus "\l\L. \u\U. l < u" by blast + finally (less_trans) have "l < u" . } + then show "\l\L. \u\U. l < u" by blast next assume H: "\l\L. \u\U. l < u" let ?ML = "Max L" @@ -300,6 +336,7 @@ locale linorder_stupid_syntax = linorder begin + notation less_eq ("op \") and less_eq ("(_/ \ _)" [51, 51] 50) and @@ -311,6 +348,7 @@ locale linorder_no_ub = linorder_stupid_syntax + assumes gt_ex: "\y. less x y" begin + lemma ge_ex[no_atp]: "\y. x \ y" using gt_ex by auto text {* Theorems for @{text "\z. \x. z \ x \ (P x \ P\<^bsub>+\\<^esub>)"} *} @@ -323,7 +361,7 @@ and z2: "\x. z2 \ x \ (P2 x \ P2')" by blast from gt_ex obtain z where z:"ord.max less_eq z1 z2 \ z" by blast from z have zz1: "z1 \ z" and zz2: "z2 \ z" by simp_all - {fix x assume H: "z \ x" + { fix x assume H: "z \ x" from less_trans[OF zz1 H] less_trans[OF zz2 H] have "(P1 x \ P2 x) \ (P1' \ P2')" using z1 zz1 z2 zz2 by auto } @@ -332,14 +370,14 @@ lemma pinf_disj[no_atp]: assumes ex1: "\z1. \x. z1 \ x \ (P1 x \ P1')" - and ex2: "\z2. \x. z2 \ x \ (P2 x \ P2')" + and ex2: "\z2. \x. z2 \ x \ (P2 x \ P2')" shows "\z. \x. z \ x \ ((P1 x \ P2 x) \ (P1' \ P2'))" proof- from ex1 ex2 obtain z1 and z2 where z1: "\x. z1 \ x \ (P1 x \ P1')" and z2: "\x. z2 \ x \ (P2 x \ P2')" by blast from gt_ex obtain z where z:"ord.max less_eq z1 z2 \ z" by blast from z have zz1: "z1 \ z" and zz2: "z2 \ z" by simp_all - {fix x assume H: "z \ x" + { fix x assume H: "z \ x" from less_trans[OF zz1 H] less_trans[OF zz2 H] have "(P1 x \ P2 x) \ (P1' \ P2')" using z1 zz1 z2 zz2 by auto } @@ -347,7 +385,7 @@ qed lemma pinf_ex[no_atp]: assumes ex:"\z. \x. z \ x \ (P x \ P1)" and p1: P1 shows "\ x. P x" -proof- +proof - from ex obtain z where z: "\x. z \ x \ (P x \ P1)" by blast from gt_ex obtain x where x: "z \ x" by blast from z x p1 show ?thesis by blast @@ -360,19 +398,20 @@ locale linorder_no_lb = linorder_stupid_syntax + assumes lt_ex: "\y. less y x" begin + lemma le_ex[no_atp]: "\y. y \ x" using lt_ex by auto text {* Theorems for @{text "\z. \x. x \ z \ (P x \ P\<^bsub>-\\<^esub>)"} *} lemma minf_conj[no_atp]: assumes ex1: "\z1. \x. x \ z1 \ (P1 x \ P1')" - and ex2: "\z2. \x. x \ z2 \ (P2 x \ P2')" + and ex2: "\z2. \x. x \ z2 \ (P2 x \ P2')" shows "\z. \x. x \ z \ ((P1 x \ P2 x) \ (P1' \ P2'))" proof- from ex1 ex2 obtain z1 and z2 where z1: "\x. x \ z1 \ (P1 x \ P1')"and z2: "\x. x \ z2 \ (P2 x \ P2')" by blast from lt_ex obtain z where z:"z \ ord.min less_eq z1 z2" by blast from z have zz1: "z \ z1" and zz2: "z \ z2" by simp_all - {fix x assume H: "x \ z" + { fix x assume H: "x \ z" from less_trans[OF H zz1] less_trans[OF H zz2] have "(P1 x \ P2 x) \ (P1' \ P2')" using z1 zz1 z2 zz2 by auto } @@ -381,21 +420,25 @@ lemma minf_disj[no_atp]: assumes ex1: "\z1. \x. x \ z1 \ (P1 x \ P1')" - and ex2: "\z2. \x. x \ z2 \ (P2 x \ P2')" + and ex2: "\z2. \x. x \ z2 \ (P2 x \ P2')" shows "\z. \x. x \ z \ ((P1 x \ P2 x) \ (P1' \ P2'))" -proof- - from ex1 ex2 obtain z1 and z2 where z1: "\x. x \ z1 \ (P1 x \ P1')"and z2: "\x. x \ z2 \ (P2 x \ P2')" by blast +proof - + from ex1 ex2 obtain z1 and z2 where z1: "\x. x \ z1 \ (P1 x \ P1')" + and z2: "\x. x \ z2 \ (P2 x \ P2')" by blast from lt_ex obtain z where z:"z \ ord.min less_eq z1 z2" by blast from z have zz1: "z \ z1" and zz2: "z \ z2" by simp_all - {fix x assume H: "x \ z" + { fix x assume H: "x \ z" from less_trans[OF H zz1] less_trans[OF H zz2] have "(P1 x \ P2 x) \ (P1' \ P2')" using z1 zz1 z2 zz2 by auto } thus ?thesis by blast qed -lemma minf_ex[no_atp]: assumes ex:"\z. \x. x \ z \ (P x \ P1)" and p1: P1 shows "\ x. P x" -proof- +lemma minf_ex[no_atp]: + assumes ex: "\z. \x. x \ z \ (P x \ P1)" + and p1: P1 + shows "\ x. P x" +proof - from ex obtain z where z: "\x. x \ z \ (P x \ P1)" by blast from lt_ex obtain x where x: "x \ z" by blast from z x p1 show ?thesis by blast @@ -407,29 +450,31 @@ locale constr_dense_linorder = linorder_no_lb + linorder_no_ub + fixes between assumes between_less: "less x y \ less x (between x y) \ less (between x y) y" - and between_same: "between x x = x" + and between_same: "between x x = x" sublocale constr_dense_linorder < dense_linorder apply unfold_locales using gt_ex lt_ex between_less - by (auto, rule_tac x="between x y" in exI, simp) + apply auto + apply (rule_tac x="between x y" in exI) + apply simp + done -context constr_dense_linorder +context constr_dense_linorder begin lemma rinf_U[no_atp]: assumes fU: "finite U" - and lin_dense: "\x l u. (\ t. l \ t \ t\ u \ t \ U) \ l\ x \ x \ u \ P x - \ (\ y. l \ y \ y \ u \ P y )" - and nmpiU: "\x. \ MP \ \PP \ P x \ (\ u\ U. \ u' \ U. u \ x \ x \ u')" - and nmi: "\ MP" and npi: "\ PP" and ex: "\ x. P x" + and lin_dense: "\x l u. (\ t. l \ t \ t\ u \ t \ U) \ l\ x \ x \ u \ P x + \ (\ y. l \ y \ y \ u \ P y )" + and nmpiU: "\x. \ MP \ \PP \ P x \ (\ u\ U. \ u' \ U. u \ x \ x \ u')" + and nmi: "\ MP" and npi: "\ PP" and ex: "\ x. P x" shows "\ u\ U. \ u' \ U. P (between u u')" -proof- +proof - from ex obtain x where px: "P x" by blast from px nmi npi nmpiU have "\ u\ U. \ u' \ U. u \ x \ x \ u'" by auto then obtain u and u' where uU:"u\ U" and uU': "u' \ U" and ux:"u \ x" and xu':"x \ u'" by auto from uU have Une: "U \ {}" by auto - term "linorder.Min less_eq" let ?l = "linorder.Min less_eq U" let ?u = "linorder.Max less_eq U" have linM: "?l \ U" using fU Une by simp @@ -443,49 +488,51 @@ from finite_set_intervals2[where P="P",OF px lx xu linM uinM fU lM Mu] have "(\ s\ U. P s) \ (\ t1\ U. \ t2 \ U. (\ y. t1 \ y \ y \ t2 \ y \ U) \ t1 \ x \ x \ t2 \ P x)" . - moreover { fix u assume um: "u\U" and pu: "P u" + moreover { + fix u assume um: "u\U" and pu: "P u" have "between u u = u" by (simp add: between_same) with um pu have "P (between u u)" by simp - with um have ?thesis by blast} - moreover{ + with um have ?thesis by blast } + moreover { assume "\ t1\ U. \ t2 \ U. (\ y. t1 \ y \ y \ t2 \ y \ U) \ t1 \ x \ x \ t2 \ P x" - then obtain t1 and t2 where t1M: "t1 \ U" and t2M: "t2\ U" - and noM: "\ y. t1 \ y \ y \ t2 \ y \ U" and t1x: "t1 \ x" and xt2: "x \ t2" and px: "P x" - by blast - from less_trans[OF t1x xt2] have t1t2: "t1 \ t2" . - let ?u = "between t1 t2" - from between_less t1t2 have t1lu: "t1 \ ?u" and ut2: "?u \ t2" by auto - from lin_dense noM t1x xt2 px t1lu ut2 have "P ?u" by blast - with t1M t2M have ?thesis by blast} - ultimately show ?thesis by blast - qed + then obtain t1 and t2 where t1M: "t1 \ U" and t2M: "t2\ U" + and noM: "\ y. t1 \ y \ y \ t2 \ y \ U" + and t1x: "t1 \ x" and xt2: "x \ t2" and px: "P x" by blast + from less_trans[OF t1x xt2] have t1t2: "t1 \ t2" . + let ?u = "between t1 t2" + from between_less t1t2 have t1lu: "t1 \ ?u" and ut2: "?u \ t2" by auto + from lin_dense noM t1x xt2 px t1lu ut2 have "P ?u" by blast + with t1M t2M have ?thesis by blast + } + ultimately show ?thesis by blast +qed theorem fr_eq[no_atp]: assumes fU: "finite U" - and lin_dense: "\x l u. (\ t. l \ t \ t\ u \ t \ U) \ l\ x \ x \ u \ P x - \ (\ y. l \ y \ y \ u \ P y )" - and nmibnd: "\x. \ MP \ P x \ (\ u\ U. u \ x)" - and npibnd: "\x. \PP \ P x \ (\ u\ U. x \ u)" - and mi: "\z. \x. x \ z \ (P x = MP)" and pi: "\z. \x. z \ x \ (P x = PP)" + and lin_dense: "\x l u. (\ t. l \ t \ t\ u \ t \ U) \ l\ x \ x \ u \ P x + \ (\ y. l \ y \ y \ u \ P y )" + and nmibnd: "\x. \ MP \ P x \ (\ u\ U. u \ x)" + and npibnd: "\x. \PP \ P x \ (\ u\ U. x \ u)" + and mi: "\z. \x. x \ z \ (P x = MP)" and pi: "\z. \x. z \ x \ (P x = PP)" shows "(\ x. P x) \ (MP \ PP \ (\ u \ U. \ u'\ U. P (between u u')))" (is "_ \ (_ \ _ \ ?F)" is "?E \ ?D") -proof- - { - assume px: "\ x. P x" - have "MP \ PP \ (\ MP \ \ PP)" by blast - moreover {assume "MP \ PP" hence "?D" by blast} - moreover {assume nmi: "\ MP" and npi: "\ PP" - from npmibnd[OF nmibnd npibnd] - have nmpiU: "\x. \ MP \ \PP \ P x \ (\ u\ U. \ u' \ U. u \ x \ x \ u')" . - from rinf_U[OF fU lin_dense nmpiU nmi npi px] have "?D" by blast} - ultimately have "?D" by blast} - moreover - { assume "?D" - moreover {assume m:"MP" from minf_ex[OF mi m] have "?E" .} - moreover {assume p: "PP" from pinf_ex[OF pi p] have "?E" . } - moreover {assume f:"?F" hence "?E" by blast} - ultimately have "?E" by blast} - ultimately have "?E = ?D" by blast thus "?E \ ?D" by simp +proof - + { assume px: "\ x. P x" + have "MP \ PP \ (\ MP \ \ PP)" by blast + moreover { assume "MP \ PP" hence "?D" by blast } + moreover { + assume nmi: "\ MP" and npi: "\ PP" + from npmibnd[OF nmibnd npibnd] + have nmpiU: "\x. \ MP \ \PP \ P x \ (\ u\ U. \ u' \ U. u \ x \ x \ u')" . + from rinf_U[OF fU lin_dense nmpiU nmi npi px] have "?D" by blast } + ultimately have "?D" by blast } + moreover + { assume "?D" + moreover { assume m:"MP" from minf_ex[OF mi m] have "?E" . } + moreover { assume p: "PP" from pinf_ex[OF pi p] have "?E" . } + moreover { assume f:"?F" hence "?E" by blast } + ultimately have "?E" by blast } + ultimately have "?E = ?D" by blast thus "?E \ ?D" by simp qed lemmas minf_thms[no_atp] = minf_conj minf_disj minf_eq minf_neq minf_lt minf_le minf_gt minf_ge minf_P @@ -497,6 +544,7 @@ lemma ferrack_axiom[no_atp]: "constr_dense_linorder less_eq less between" by (rule constr_dense_linorder_axioms) + lemma atoms[no_atp]: shows "TERM (less :: 'a \ _)" and "TERM (less_eq :: 'a \ _)" @@ -508,31 +556,33 @@ declaration {* let -fun simps phi = map (Morphism.thm phi) [@{thm "not_less"}, @{thm "not_le"}] -fun generic_whatis phi = - let - val [lt, le] = map (Morphism.term phi) [@{term "op \"}, @{term "op \"}] - fun h x t = - case term_of t of - Const(@{const_name HOL.eq}, _)$y$z => if term_of x aconv y then Ferrante_Rackoff_Data.Eq - else Ferrante_Rackoff_Data.Nox - | @{term "Not"}$(Const(@{const_name HOL.eq}, _)$y$z) => if term_of x aconv y then Ferrante_Rackoff_Data.NEq - else Ferrante_Rackoff_Data.Nox - | b$y$z => if Term.could_unify (b, lt) then - if term_of x aconv y then Ferrante_Rackoff_Data.Lt - else if term_of x aconv z then Ferrante_Rackoff_Data.Gt + fun simps phi = map (Morphism.thm phi) [@{thm "not_less"}, @{thm "not_le"}] + fun generic_whatis phi = + let + val [lt, le] = map (Morphism.term phi) [@{term "op \"}, @{term "op \"}] + fun h x t = + case term_of t of + Const(@{const_name HOL.eq}, _)$y$z => + if term_of x aconv y then Ferrante_Rackoff_Data.Eq + else Ferrante_Rackoff_Data.Nox + | @{term "Not"}$(Const(@{const_name HOL.eq}, _)$y$z) => + if term_of x aconv y then Ferrante_Rackoff_Data.NEq + else Ferrante_Rackoff_Data.Nox + | b$y$z => if Term.could_unify (b, lt) then + if term_of x aconv y then Ferrante_Rackoff_Data.Lt + else if term_of x aconv z then Ferrante_Rackoff_Data.Gt + else Ferrante_Rackoff_Data.Nox + else if Term.could_unify (b, le) then + if term_of x aconv y then Ferrante_Rackoff_Data.Le + else if term_of x aconv z then Ferrante_Rackoff_Data.Ge + else Ferrante_Rackoff_Data.Nox else Ferrante_Rackoff_Data.Nox - else if Term.could_unify (b, le) then - if term_of x aconv y then Ferrante_Rackoff_Data.Le - else if term_of x aconv z then Ferrante_Rackoff_Data.Ge - else Ferrante_Rackoff_Data.Nox - else Ferrante_Rackoff_Data.Nox - | _ => Ferrante_Rackoff_Data.Nox - in h end - fun ss phi = HOL_ss addsimps (simps phi) + | _ => Ferrante_Rackoff_Data.Nox + in h end + fun ss phi = HOL_ss addsimps (simps phi) in - Ferrante_Rackoff_Data.funs @{thm "ferrack_axiom"} - {isolate_conv = K (K (K Thm.reflexive)), whatis = generic_whatis, simpset = ss} + Ferrante_Rackoff_Data.funs @{thm "ferrack_axiom"} + {isolate_conv = K (K (K Thm.reflexive)), whatis = generic_whatis, simpset = ss} end *} @@ -544,38 +594,45 @@ Scan.succeed (SIMPLE_METHOD' o FerranteRackoff.dlo_tac) *} "Ferrante and Rackoff's algorithm for quantifier elimination in dense linear orders" + subsection {* Ferrante and Rackoff algorithm over ordered fields *} lemma neg_prod_lt:"(c\'a\linordered_field) < 0 \ ((c*x < 0) == (x > 0))" -proof- +proof - assume H: "c < 0" - have "c*x < 0 = (0/c < x)" by (simp only: neg_divide_less_eq[OF H] algebra_simps) + have "c*x < 0 = (0/c < x)" + by (simp only: neg_divide_less_eq[OF H] algebra_simps) also have "\ = (0 < x)" by simp finally show "(c*x < 0) == (x > 0)" by simp qed lemma pos_prod_lt:"(c\'a\linordered_field) > 0 \ ((c*x < 0) == (x < 0))" -proof- +proof - assume H: "c > 0" - hence "c*x < 0 = (0/c > x)" by (simp only: pos_less_divide_eq[OF H] algebra_simps) + then have "c*x < 0 = (0/c > x)" + by (simp only: pos_less_divide_eq[OF H] algebra_simps) also have "\ = (0 > x)" by simp finally show "(c*x < 0) == (x < 0)" by simp qed lemma neg_prod_sum_lt: "(c\'a\linordered_field) < 0 \ ((c*x + t< 0) == (x > (- 1/c)*t))" -proof- +proof - assume H: "c < 0" - have "c*x + t< 0 = (c*x < -t)" by (subst less_iff_diff_less_0 [of "c*x" "-t"], simp) - also have "\ = (-t/c < x)" by (simp only: neg_divide_less_eq[OF H] algebra_simps) + have "c*x + t< 0 = (c*x < -t)" + by (subst less_iff_diff_less_0 [of "c*x" "-t"], simp) + also have "\ = (-t/c < x)" + by (simp only: neg_divide_less_eq[OF H] algebra_simps) also have "\ = ((- 1/c)*t < x)" by simp - finally show "(c*x + t < 0) == (x > (- 1/c)*t)" by simp + finally show "(c*x + t < 0) == (x > (- 1/c)*t)" by simp qed lemma pos_prod_sum_lt:"(c\'a\linordered_field) > 0 \ ((c*x + t < 0) == (x < (- 1/c)*t))" -proof- +proof - assume H: "c > 0" - have "c*x + t< 0 = (c*x < -t)" by (subst less_iff_diff_less_0 [of "c*x" "-t"], simp) - also have "\ = (-t/c > x)" by (simp only: pos_less_divide_eq[OF H] algebra_simps) + have "c*x + t< 0 = (c*x < -t)" + by (subst less_iff_diff_less_0 [of "c*x" "-t"], simp) + also have "\ = (-t/c > x)" + by (simp only: pos_less_divide_eq[OF H] algebra_simps) also have "\ = ((- 1/c)*t > x)" by simp finally show "(c*x + t < 0) == (x < (- 1/c)*t)" by simp qed @@ -584,50 +641,60 @@ using less_diff_eq[where a= x and b=t and c=0] by simp lemma neg_prod_le:"(c\'a\linordered_field) < 0 \ ((c*x <= 0) == (x >= 0))" -proof- +proof - assume H: "c < 0" - have "c*x <= 0 = (0/c <= x)" by (simp only: neg_divide_le_eq[OF H] algebra_simps) + have "c*x <= 0 = (0/c <= x)" + by (simp only: neg_divide_le_eq[OF H] algebra_simps) also have "\ = (0 <= x)" by simp finally show "(c*x <= 0) == (x >= 0)" by simp qed lemma pos_prod_le:"(c\'a\linordered_field) > 0 \ ((c*x <= 0) == (x <= 0))" -proof- +proof - assume H: "c > 0" - hence "c*x <= 0 = (0/c >= x)" by (simp only: pos_le_divide_eq[OF H] algebra_simps) + hence "c*x <= 0 = (0/c >= x)" + by (simp only: pos_le_divide_eq[OF H] algebra_simps) also have "\ = (0 >= x)" by simp finally show "(c*x <= 0) == (x <= 0)" by simp qed lemma neg_prod_sum_le: "(c\'a\linordered_field) < 0 \ ((c*x + t <= 0) == (x >= (- 1/c)*t))" -proof- +proof - assume H: "c < 0" - have "c*x + t <= 0 = (c*x <= -t)" by (subst le_iff_diff_le_0 [of "c*x" "-t"], simp) - also have "\ = (-t/c <= x)" by (simp only: neg_divide_le_eq[OF H] algebra_simps) + have "c*x + t <= 0 = (c*x <= -t)" + by (subst le_iff_diff_le_0 [of "c*x" "-t"], simp) + also have "\ = (-t/c <= x)" + by (simp only: neg_divide_le_eq[OF H] algebra_simps) also have "\ = ((- 1/c)*t <= x)" by simp - finally show "(c*x + t <= 0) == (x >= (- 1/c)*t)" by simp + finally show "(c*x + t <= 0) == (x >= (- 1/c)*t)" by simp qed lemma pos_prod_sum_le:"(c\'a\linordered_field) > 0 \ ((c*x + t <= 0) == (x <= (- 1/c)*t))" -proof- +proof - assume H: "c > 0" - have "c*x + t <= 0 = (c*x <= -t)" by (subst le_iff_diff_le_0 [of "c*x" "-t"], simp) - also have "\ = (-t/c >= x)" by (simp only: pos_le_divide_eq[OF H] algebra_simps) + have "c*x + t <= 0 = (c*x <= -t)" + by (subst le_iff_diff_le_0 [of "c*x" "-t"], simp) + also have "\ = (-t/c >= x)" + by (simp only: pos_le_divide_eq[OF H] algebra_simps) also have "\ = ((- 1/c)*t >= x)" by simp - finally show "(c*x + t <= 0) == (x <= (- 1/c)*t)" by simp + finally show "(c*x + t <= 0) == (x <= (- 1/c)*t)" by simp qed lemma sum_le:"((x::'a::ordered_ab_group_add) + t <= 0) == (x <= - t)" using le_diff_eq[where a= x and b=t and c=0] by simp lemma nz_prod_eq:"(c\'a\linordered_field) \ 0 \ ((c*x = 0) == (x = 0))" by simp + lemma nz_prod_sum_eq: "(c\'a\linordered_field) \ 0 \ ((c*x + t = 0) == (x = (- 1/c)*t))" -proof- +proof - assume H: "c \ 0" - have "c*x + t = 0 = (c*x = -t)" by (subst eq_iff_diff_eq_0 [of "c*x" "-t"], simp) - also have "\ = (x = -t/c)" by (simp only: nonzero_eq_divide_eq[OF H] algebra_simps) + have "c*x + t = 0 = (c*x = -t)" + by (subst eq_iff_diff_eq_0 [of "c*x" "-t"], simp) + also have "\ = (x = -t/c)" + by (simp only: nonzero_eq_divide_eq[OF H] algebra_simps) finally show "(c*x + t = 0) == (x = (- 1/c)*t)" by simp qed + lemma sum_eq:"((x::'a::ordered_ab_group_add) + t = 0) == (x = - t)" using eq_diff_eq[where a= x and b=t and c=0] by simp @@ -635,23 +702,24 @@ interpretation class_dense_linordered_field: constr_dense_linorder "op <=" "op <" "\ x y. 1/2 * ((x::'a::{linordered_field}) + y)" -by (unfold_locales, dlo, dlo, auto) + by unfold_locales (dlo, dlo, auto) declaration{* let -fun earlier [] x y = false - | earlier (h::t) x y = - if h aconvc y then false else if h aconvc x then true else earlier t x y; + fun earlier [] x y = false + | earlier (h::t) x y = + if h aconvc y then false else if h aconvc x then true else earlier t x y; -fun dest_frac ct = case term_of ct of - Const (@{const_name Fields.divide},_) $ a $ b=> - Rat.rat_of_quotient (snd (HOLogic.dest_number a), snd (HOLogic.dest_number b)) - | Const(@{const_name inverse}, _)$a => Rat.rat_of_quotient(1, HOLogic.dest_number a |> snd) - | t => Rat.rat_of_int (snd (HOLogic.dest_number t)) +fun dest_frac ct = + case term_of ct of + Const (@{const_name Fields.divide},_) $ a $ b=> + Rat.rat_of_quotient (snd (HOLogic.dest_number a), snd (HOLogic.dest_number b)) + | Const(@{const_name inverse}, _)$a => Rat.rat_of_quotient(1, HOLogic.dest_number a |> snd) + | t => Rat.rat_of_int (snd (HOLogic.dest_number t)) fun mk_frac phi cT x = - let val (a, b) = Rat.quotient_of_rat x - in if b = 1 then Numeral.mk_cnumber cT a + let val (a, b) = Rat.quotient_of_rat x + in if b = 1 then Numeral.mk_cnumber cT a else Thm.apply (Thm.apply (Drule.cterm_rule (instantiate' [SOME cT] []) @{cpat "op /"}) (Numeral.mk_cnumber cT a))