# HG changeset patch # User wenzelm # Date 1436643126 -7200 # Node ID 7990444967698c326a1d2d9ede579c0cdc7648cd # Parent 07089a750d2a89a09ecc6e3ed0f581cbffbbcb7b tuned proofs; diff -r 07089a750d2a -r 799044496769 src/HOL/Decision_Procs/Ferrack.thy --- a/src/HOL/Decision_Procs/Ferrack.thy Sat Jul 11 00:14:54 2015 +0200 +++ b/src/HOL/Decision_Procs/Ferrack.thy Sat Jul 11 21:32:06 2015 +0200 @@ -1702,490 +1702,758 @@ lemma lin_dense: assumes lp: "isrlfm p" - and noS: "\t. l < t \ t< u \ t \ (\(t,n). Inum (x#bs) t / real n) ` set (uset p)" - (is "\t. _ \ _ \ t \ (\(t,n). ?N x t / real n ) ` (?U p)") - and lx: "l < x" and xu:"x < u" and px:" Ifm (x#bs) p" - and ly: "l < y" and yu: "y < u" + and noS: "\t. l < t \ t< u \ t \ (\(t,n). Inum (x#bs) t / real n) ` set (uset p)" + (is "\t. _ \ _ \ t \ (\(t,n). ?N x t / real n ) ` (?U p)") + and lx: "l < x" + and xu:"x < u" + and px:" Ifm (x#bs) p" + and ly: "l < y" and yu: "y < u" shows "Ifm (y#bs) p" -using lp px noS + using lp px noS proof (induct p rule: isrlfm.induct) - case (5 c e) then have cp: "real c > 0" and nb: "numbound0 e" by simp+ - from 5 have "x * real c + ?N x e < 0" by (simp add: algebra_simps) + case (5 c e) + then have cp: "real c > 0" and nb: "numbound0 e" + by simp_all + from 5 have "x * real c + ?N x e < 0" + by (simp add: algebra_simps) then have pxc: "x < (- ?N x e) / real c" by (simp only: pos_less_divide_eq[OF cp, where a="x" and b="-?N x e"]) - from 5 have noSc:"\t. l < t \ t < u \ t \ (- ?N x e) / real c" by auto - with ly yu have yne: "y \ - ?N x e / real c" by auto - then have "y < (- ?N x e) / real c \ y > (-?N x e) / real c" by auto - moreover {assume y: "y < (-?N x e)/ real c" + from 5 have noSc:"\t. l < t \ t < u \ t \ (- ?N x e) / real c" + by auto + with ly yu have yne: "y \ - ?N x e / real c" + by auto + then consider "y < (-?N x e)/ real c" | "y > (- ?N x e) / real c" + by atomize_elim auto + then show ?case + proof cases + case y: 1 + then have "y * real c < - ?N x e" + by (simp add: pos_less_divide_eq[OF cp, where a="y" and b="-?N x e", symmetric]) + then have "real c * y + ?N x e < 0" + by (simp add: algebra_simps) + then show ?thesis + using numbound0_I[OF nb, where bs="bs" and b="x" and b'="y"] by simp + next + case y: 2 + with yu have eu: "u > (- ?N x e) / real c" + by auto + with noSc ly yu have "(- ?N x e) / real c \ l" + by (cases "(- ?N x e) / real c > l") auto + with lx pxc have False + by auto + then show ?thesis .. + qed +next + case (6 c e) + then have cp: "real c > 0" and nb: "numbound0 e" + by simp_all + from 6 have "x * real c + ?N x e \ 0" + by (simp add: algebra_simps) + then have pxc: "x \ (- ?N x e) / real c" + by (simp only: pos_le_divide_eq[OF cp, where a="x" and b="-?N x e"]) + from 6 have noSc:"\t. l < t \ t < u \ t \ (- ?N x e) / real c" + by auto + with ly yu have yne: "y \ - ?N x e / real c" + by auto + then consider "y < (- ?N x e) / real c" | "y > (-?N x e) / real c" + by atomize_elim auto + then show ?case + proof cases + case y: 1 then have "y * real c < - ?N x e" by (simp add: pos_less_divide_eq[OF cp, where a="y" and b="-?N x e", symmetric]) - then have "real c * y + ?N x e < 0" by (simp add: algebra_simps) - then have ?case using numbound0_I[OF nb, where bs="bs" and b="x" and b'="y"] by simp} - moreover {assume y: "y > (- ?N x e) / real c" - with yu have eu: "u > (- ?N x e) / real c" by auto - with noSc ly yu have "(- ?N x e) / real c \ l" by (cases "(- ?N x e) / real c > l", auto) - with lx pxc have "False" by auto - then have ?case by simp } - ultimately show ?case by blast + then have "real c * y + ?N x e < 0" + by (simp add: algebra_simps) + then show ?thesis + using numbound0_I[OF nb, where bs="bs" and b="x" and b'="y"] by simp + next + case y: 2 + with yu have eu: "u > (- ?N x e) / real c" + by auto + with noSc ly yu have "(- ?N x e) / real c \ l" + by (cases "(- ?N x e) / real c > l") auto + with lx pxc have False + by auto + then show ?thesis .. + qed next - case (6 c e) then have cp: "real c > 0" and nb: "numbound0 e" by simp + - from 6 have "x * real c + ?N x e \ 0" by (simp add: algebra_simps) - then have pxc: "x \ (- ?N x e) / real c" - by (simp only: pos_le_divide_eq[OF cp, where a="x" and b="-?N x e"]) - from 6 have noSc:"\t. l < t \ t < u \ t \ (- ?N x e) / real c" by auto - with ly yu have yne: "y \ - ?N x e / real c" by auto - then have "y < (- ?N x e) / real c \ y > (-?N x e) / real c" by auto - moreover {assume y: "y < (-?N x e)/ real c" - then have "y * real c < - ?N x e" - by (simp add: pos_less_divide_eq[OF cp, where a="y" and b="-?N x e", symmetric]) - then have "real c * y + ?N x e < 0" by (simp add: algebra_simps) - then have ?case using numbound0_I[OF nb, where bs="bs" and b="x" and b'="y"] by simp} - moreover {assume y: "y > (- ?N x e) / real c" - with yu have eu: "u > (- ?N x e) / real c" by auto - with noSc ly yu have "(- ?N x e) / real c \ l" by (cases "(- ?N x e) / real c > l", auto) - with lx pxc have "False" by auto - then have ?case by simp } - ultimately show ?case by blast -next - case (7 c e) then have cp: "real c > 0" and nb: "numbound0 e" by simp+ - from 7 have "x * real c + ?N x e > 0" by (simp add: algebra_simps) + case (7 c e) + then have cp: "real c > 0" and nb: "numbound0 e" + by simp_all + from 7 have "x * real c + ?N x e > 0" + by (simp add: algebra_simps) then have pxc: "x > (- ?N x e) / real c" by (simp only: pos_divide_less_eq[OF cp, where a="x" and b="-?N x e"]) - from 7 have noSc: "\t. l < t \ t < u \ t \ (- ?N x e) / real c" by auto - with ly yu have yne: "y \ - ?N x e / real c" by auto - then have "y < (- ?N x e) / real c \ y > (-?N x e) / real c" by auto - moreover {assume y: "y > (-?N x e)/ real c" + from 7 have noSc: "\t. l < t \ t < u \ t \ (- ?N x e) / real c" + by auto + with ly yu have yne: "y \ - ?N x e / real c" + by auto + then consider "y > (- ?N x e) / real c" | "y < (-?N x e) / real c" + by atomize_elim auto + then show ?case + proof cases + case 1 + then have "y * real c > - ?N x e" + by (simp add: pos_divide_less_eq[OF cp, where a="y" and b="-?N x e", symmetric]) + then have "real c * y + ?N x e > 0" + by (simp add: algebra_simps) + then show ?thesis + using numbound0_I[OF nb, where bs="bs" and b="x" and b'="y"] by simp + next + case 2 + with ly have eu: "l < (- ?N x e) / real c" + by auto + with noSc ly yu have "(- ?N x e) / real c \ u" + by (cases "(- ?N x e) / real c > l") auto + with xu pxc have False by auto + then show ?thesis .. + qed +next + case (8 c e) + then have cp: "real c > 0" and nb: "numbound0 e" + by simp_all + from 8 have "x * real c + ?N x e \ 0" + by (simp add: algebra_simps) + then have pxc: "x \ (- ?N x e) / real c" + by (simp only: pos_divide_le_eq[OF cp, where a="x" and b="-?N x e"]) + from 8 have noSc:"\t. l < t \ t < u \ t \ (- ?N x e) / real c" + by auto + with ly yu have yne: "y \ - ?N x e / real c" + by auto + then consider "y > (- ?N x e) / real c" | "y < (-?N x e) / real c" + by atomize_elim auto + then show ?case + proof cases + case 1 then have "y * real c > - ?N x e" by (simp add: pos_divide_less_eq[OF cp, where a="y" and b="-?N x e", symmetric]) then have "real c * y + ?N x e > 0" by (simp add: algebra_simps) - then have ?case using numbound0_I[OF nb, where bs="bs" and b="x" and b'="y"] by simp} - moreover {assume y: "y < (- ?N x e) / real c" - with ly have eu: "l < (- ?N x e) / real c" by auto - with noSc ly yu have "(- ?N x e) / real c \ u" by (cases "(- ?N x e) / real c > l", auto) - with xu pxc have "False" by auto - then have ?case by simp } - ultimately show ?case by blast + then show ?thesis + using numbound0_I[OF nb, where bs="bs" and b="x" and b'="y"] by simp + next + case 2 + with ly have eu: "l < (- ?N x e) / real c" + by auto + with noSc ly yu have "(- ?N x e) / real c \ u" + by (cases "(- ?N x e) / real c > l") auto + with xu pxc have False + by auto + then show ?thesis .. + qed next - case (8 c e) then have cp: "real c > 0" and nb: "numbound0 e" by simp+ - from 8 have "x * real c + ?N x e \ 0" by (simp add: algebra_simps) - then have pxc: "x \ (- ?N x e) / real c" - by (simp only: pos_divide_le_eq[OF cp, where a="x" and b="-?N x e"]) - from 8 have noSc:"\t. l < t \ t < u \ t \ (- ?N x e) / real c" by auto - with ly yu have yne: "y \ - ?N x e / real c" by auto - then have "y < (- ?N x e) / real c \ y > (-?N x e) / real c" by auto - moreover {assume y: "y > (-?N x e)/ real c" - then have "y * real c > - ?N x e" - by (simp add: pos_divide_less_eq[OF cp, where a="y" and b="-?N x e", symmetric]) - then have "real c * y + ?N x e > 0" by (simp add: algebra_simps) - then have ?case using numbound0_I[OF nb, where bs="bs" and b="x" and b'="y"] by simp} - moreover {assume y: "y < (- ?N x e) / real c" - with ly have eu: "l < (- ?N x e) / real c" by auto - with noSc ly yu have "(- ?N x e) / real c \ u" by (cases "(- ?N x e) / real c > l", auto) - with xu pxc have "False" by auto - then have ?case by simp } - ultimately show ?case by blast -next - case (3 c e) then have cp: "real c > 0" and nb: "numbound0 e" by simp+ - from cp have cnz: "real c \ 0" by simp - from 3 have "x * real c + ?N x e = 0" by (simp add: algebra_simps) + case (3 c e) + then have cp: "real c > 0" and nb: "numbound0 e" + by simp_all + from cp have cnz: "real c \ 0" + by simp + from 3 have "x * real c + ?N x e = 0" + by (simp add: algebra_simps) then have pxc: "x = (- ?N x e) / real c" by (simp only: nonzero_eq_divide_eq[OF cnz, where a="x" and b="-?N x e"]) - from 3 have noSc:"\t. l < t \ t < u \ t \ (- ?N x e) / real c" by auto - with lx xu have yne: "x \ - ?N x e / real c" by auto - with pxc show ?case by simp + from 3 have noSc:"\t. l < t \ t < u \ t \ (- ?N x e) / real c" + by auto + with lx xu have yne: "x \ - ?N x e / real c" + by auto + with pxc show ?case + by simp next - case (4 c e) then have cp: "real c > 0" and nb: "numbound0 e" by simp+ - from cp have cnz: "real c \ 0" by simp - from 4 have noSc:"\t. l < t \ t < u \ t \ (- ?N x e) / real c" by auto - with ly yu have yne: "y \ - ?N x e / real c" by auto + case (4 c e) + then have cp: "real c > 0" and nb: "numbound0 e" + by simp_all + from cp have cnz: "real c \ 0" + by simp + from 4 have noSc:"\t. l < t \ t < u \ t \ (- ?N x e) / real c" + by auto + with ly yu have yne: "y \ - ?N x e / real c" + by auto then have "y* real c \ -?N x e" by (simp only: nonzero_eq_divide_eq[OF cnz, where a="y" and b="-?N x e"]) simp - then have "y* real c + ?N x e \ 0" by (simp add: algebra_simps) + then have "y* real c + ?N x e \ 0" + by (simp add: algebra_simps) then show ?case using numbound0_I[OF nb, where bs="bs" and b="x" and b'="y"] by (simp add: algebra_simps) qed (auto simp add: numbound0_I[where bs="bs" and b="y" and b'="x"]) lemma finite_set_intervals: - assumes px: "P (x::real)" - 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" + fixes x :: real + 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" shows "\a \ S. \b \ S. (\y. a < y \ y < b \ y \ S) \ a \ x \ x \ b \ P x" proof - let ?Mx = "{y. y\ S \ y \ x}" let ?xM = "{y. y\ S \ x \ y}" let ?a = "Max ?Mx" let ?b = "Min ?xM" - have MxS: "?Mx \ S" by blast - then have fMx: "finite ?Mx" using fS finite_subset by auto - from lx linS have linMx: "l \ ?Mx" by blast - then have Mxne: "?Mx \ {}" by blast - have xMS: "?xM \ S" by blast - then have fxM: "finite ?xM" using fS finite_subset by auto - from xu uinS have linxM: "u \ ?xM" by blast - then have xMne: "?xM \ {}" by blast - have ax:"?a \ x" using Mxne fMx by auto - have xb:"x \ ?b" using xMne fxM by auto - have "?a \ ?Mx" using Max_in[OF fMx Mxne] by simp then have ainS: "?a \ S" using MxS by blast - have "?b \ ?xM" using Min_in[OF fxM xMne] by simp then have binS: "?b \ S" using xMS by blast - have noy:"\y. ?a < y \ y < ?b \ y \ S" - proof(clarsimp) + have MxS: "?Mx \ S" + by blast + then have fMx: "finite ?Mx" + using fS finite_subset by auto + from lx linS have linMx: "l \ ?Mx" + by blast + then have Mxne: "?Mx \ {}" + by blast + have xMS: "?xM \ S" + by blast + then have fxM: "finite ?xM" + using fS finite_subset by auto + from xu uinS have linxM: "u \ ?xM" + by blast + then have xMne: "?xM \ {}" + by blast + have ax:"?a \ x" + using Mxne fMx by auto + have xb:"x \ ?b" + using xMne fxM by auto + have "?a \ ?Mx" + using Max_in[OF fMx Mxne] by simp + then have ainS: "?a \ S" + using MxS by blast + have "?b \ ?xM" + using Min_in[OF fxM xMne] by simp + then have 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" - from yS have "y\ ?Mx \ y\ ?xM" by auto - moreover {assume "y \ ?Mx" then have "y \ ?a" using Mxne fMx by auto with ay have "False" by simp} - moreover {assume "y \ ?xM" then have "y \ ?b" using xMne fxM by auto with yb have "False" by simp} - ultimately show "False" by blast + from yS consider "y \ ?Mx" | "y \ ?xM" + by atomize_elim auto + then show False + proof cases + case 1 + then have "y \ ?a" + using Mxne fMx by auto + with ay show ?thesis by simp + next + case 2 + then have "y \ ?b" + using xMne fxM by auto + with yb show ?thesis by simp + qed qed - from ainS binS noy ax xb px show ?thesis by blast + from ainS binS noy ax xb px show ?thesis + by blast qed lemma rinf_uset: assumes lp: "isrlfm p" - and nmi: "\ (Ifm (x#bs) (minusinf p))" (is "\ (Ifm (x#bs) (?M p))") - and npi: "\ (Ifm (x#bs) (plusinf p))" (is "\ (Ifm (x#bs) (?P p))") - and ex: "\x. Ifm (x#bs) p" (is "\x. ?I x p") - shows "\(l,n) \ set (uset p). \(s,m) \ set (uset p). ?I ((Inum (x#bs) l / real n + Inum (x#bs) s / real m) / 2) p" + and nmi: "\ (Ifm (x # bs) (minusinf p))" (is "\ (Ifm (x # bs) (?M p))") + and npi: "\ (Ifm (x # bs) (plusinf p))" (is "\ (Ifm (x # bs) (?P p))") + and ex: "\x. Ifm (x # bs) p" (is "\x. ?I x p") + shows "\(l,n) \ set (uset p). \(s,m) \ set (uset p). + ?I ((Inum (x#bs) l / real n + Inum (x#bs) s / real m) / 2) p" proof - - let ?N = "\x t. Inum (x#bs) t" + let ?N = "\x t. Inum (x # bs) t" let ?U = "set (uset p)" - from ex obtain a where pa: "?I a p" by blast + from ex obtain a where pa: "?I a p" + by blast from bound0_I[OF rminusinf_bound0[OF lp], where bs="bs" and b="x" and b'="a"] nmi - have nmi': "\ (?I a (?M p))" by simp + have nmi': "\ (?I a (?M p))" + by simp from bound0_I[OF rplusinf_bound0[OF lp], where bs="bs" and b="x" and b'="a"] npi - have npi': "\ (?I a (?P p))" by simp + have npi': "\ (?I a (?P p))" + by simp have "\(l,n) \ set (uset p). \(s,m) \ set (uset p). ?I ((?N a l/real n + ?N a s /real m) / 2) p" proof - let ?M = "(\(t,c). ?N a t / real c) ` ?U" - have fM: "finite ?M" by auto + have fM: "finite ?M" + by auto from rminusinf_uset[OF lp nmi pa] rplusinf_uset[OF lp npi pa] - have "\(l,n) \ set (uset p). \(s,m) \ set (uset p). a \ ?N x l / real n \ a \ ?N x s / real m" by blast - then obtain "t" "n" "s" "m" where - tnU: "(t,n) \ ?U" and smU: "(s,m) \ ?U" - and xs1: "a \ ?N x s / real m" and tx1: "a \ ?N x t / real n" by blast - from uset_l[OF lp] tnU smU numbound0_I[where bs="bs" and b="x" and b'="a"] xs1 tx1 have xs: "a \ ?N a s / real m" and tx: "a \ ?N a t / real n" by auto - from tnU have Mne: "?M \ {}" by auto - then have Une: "?U \ {}" by simp + have "\(l,n) \ set (uset p). \(s,m) \ set (uset p). a \ ?N x l / real n \ a \ ?N x s / real m" + by blast + then obtain "t" "n" "s" "m" + where tnU: "(t,n) \ ?U" + and smU: "(s,m) \ ?U" + and xs1: "a \ ?N x s / real m" + and tx1: "a \ ?N x t / real n" + by blast + from uset_l[OF lp] tnU smU numbound0_I[where bs="bs" and b="x" and b'="a"] xs1 tx1 + have xs: "a \ ?N a s / real m" and tx: "a \ ?N a t / real n" + by auto + from tnU have Mne: "?M \ {}" + by auto + then have Une: "?U \ {}" + by simp let ?l = "Min ?M" let ?u = "Max ?M" - have linM: "?l \ ?M" using fM Mne by simp - have uinM: "?u \ ?M" using fM Mne by simp - have tnM: "?N a t / real n \ ?M" using tnU by auto - have smM: "?N a s / real m \ ?M" using smU by auto - have lM: "\t\ ?M. ?l \ t" using Mne fM by auto - have Mu: "\t\ ?M. t \ ?u" using Mne fM by auto - have "?l \ ?N a t / real n" using tnM Mne by simp then have lx: "?l \ a" using tx by simp - have "?N a s / real m \ ?u" using smM Mne by simp then have xu: "a \ ?u" using xs by simp + have linM: "?l \ ?M" + using fM Mne by simp + have uinM: "?u \ ?M" + using fM Mne by simp + have tnM: "?N a t / real n \ ?M" + using tnU by auto + have smM: "?N a s / real m \ ?M" + using smU by auto + have lM: "\t\ ?M. ?l \ t" + using Mne fM by auto + have Mu: "\t\ ?M. t \ ?u" + using Mne fM by auto + have "?l \ ?N a t / real n" + using tnM Mne by simp + then have lx: "?l \ a" + using tx by simp + have "?N a s / real m \ ?u" + using smM Mne by simp + then have xu: "a \ ?u" + using xs by simp from finite_set_intervals2[where P="\x. ?I x p",OF pa lx xu linM uinM fM lM Mu] - have "(\s\ ?M. ?I s p) \ - (\t1\ ?M. \t2 \ ?M. (\y. t1 < y \ y < t2 \ y \ ?M) \ t1 < a \ a < t2 \ ?I a p)" . - moreover { fix u assume um: "u\ ?M" and pu: "?I u p" - then have "\(tu,nu) \ ?U. u = ?N a tu / real nu" by auto - then obtain "tu" "nu" where tuU: "(tu,nu) \ ?U" and tuu:"u= ?N a tu / real nu" by blast - have "(u + u) / 2 = u" by auto with pu tuu - have "?I (((?N a tu / real nu) + (?N a tu / real nu)) / 2) p" by simp - with tuU have ?thesis by blast} - moreover{ - assume "\t1\ ?M. \t2 \ ?M. (\y. t1 < y \ y < t2 \ y \ ?M) \ t1 < a \ a < t2 \ ?I a p" - then obtain t1 and t2 where t1M: "t1 \ ?M" and t2M: "t2\ ?M" - and noM: "\y. t1 < y \ y < t2 \ y \ ?M" and t1x: "t1 < a" and xt2: "a < t2" and px: "?I a p" + consider u where "u \ ?M" "?I u p" + | t1 t2 where "t1 \ ?M" "t2 \ ?M" "\y. t1 < y \ y < t2 \ y \ ?M" "t1 < a" "a < t2" "?I a p" + by blast + then show ?thesis + proof cases + case 1 + note um = \u \ ?M\ and pu = \?I u p\ + then have "\(tu,nu) \ ?U. u = ?N a tu / real nu" + by auto + then obtain tu nu where tuU: "(tu, nu) \ ?U" and tuu: "u= ?N a tu / real nu" by blast - from t1M have "\(t1u,t1n) \ ?U. t1 = ?N a t1u / real t1n" by auto - then obtain "t1u" "t1n" where t1uU: "(t1u,t1n) \ ?U" and t1u: "t1 = ?N a t1u / real t1n" by blast - from t2M have "\(t2u,t2n) \ ?U. t2 = ?N a t2u / real t2n" by auto - then obtain "t2u" "t2n" where t2uU: "(t2u,t2n) \ ?U" and t2u: "t2 = ?N a t2u / real t2n" by blast - from t1x xt2 have t1t2: "t1 < t2" by simp + have "(u + u) / 2 = u" + by auto + with pu tuu have "?I (((?N a tu / real nu) + (?N a tu / real nu)) / 2) p" + by simp + with tuU show ?thesis by blast + next + case 2 + note t1M = \t1 \ ?M\ and t2M = \t2\ ?M\ + and noM = \\y. t1 < y \ y < t2 \ y \ ?M\ + and t1x = \t1 < a\ and xt2 = \a < t2\ and px = \?I a p\ + from t1M have "\(t1u,t1n) \ ?U. t1 = ?N a t1u / real t1n" + by auto + then obtain t1u t1n where t1uU: "(t1u, t1n) \ ?U" and t1u: "t1 = ?N a t1u / real t1n" + by blast + from t2M have "\(t2u,t2n) \ ?U. t2 = ?N a t2u / real t2n" + by auto + then obtain t2u t2n where t2uU: "(t2u, t2n) \ ?U" and t2u: "t2 = ?N a t2u / real t2n" + by blast + from t1x xt2 have t1t2: "t1 < t2" + by simp let ?u = "(t1 + t2) / 2" - from less_half_sum[OF t1t2] gt_half_sum[OF t1t2] have t1lu: "t1 < ?u" and ut2: "?u < t2" by auto + from less_half_sum[OF t1t2] gt_half_sum[OF t1t2] have t1lu: "t1 < ?u" and ut2: "?u < t2" + by auto from lin_dense[OF lp noM t1x xt2 px t1lu ut2] have "?I ?u p" . - with t1uU t2uU t1u t2u have ?thesis by blast} - ultimately show ?thesis by blast + with t1uU t2uU t1u t2u show ?thesis + by blast + qed qed - then obtain "l" "n" "s" "m" where lnU: "(l,n) \ ?U" and smU:"(s,m) \ ?U" - and pu: "?I ((?N a l / real n + ?N a s / real m) / 2) p" by blast - from lnU smU uset_l[OF lp] have nbl: "numbound0 l" and nbs: "numbound0 s" by auto + then obtain l n s m where lnU: "(l, n) \ ?U" and smU:"(s, m) \ ?U" + and pu: "?I ((?N a l / real n + ?N a s / real m) / 2) p" + by blast + from lnU smU uset_l[OF lp] have nbl: "numbound0 l" and nbs: "numbound0 s" + by auto from numbound0_I[OF nbl, where bs="bs" and b="a" and b'="x"] numbound0_I[OF nbs, where bs="bs" and b="a" and b'="x"] pu - have "?I ((?N x l / real n + ?N x s / real m) / 2) p" by simp - with lnU smU - show ?thesis by auto + have "?I ((?N x l / real n + ?N x s / real m) / 2) p" + by simp + with lnU smU show ?thesis + by auto qed + + (* The Ferrante - Rackoff Theorem *) theorem fr_eq: assumes lp: "isrlfm p" - shows "(\x. Ifm (x#bs) p) = ((Ifm (x#bs) (minusinf p)) \ (Ifm (x#bs) (plusinf p)) \ (\(t,n) \ set (uset p). \(s,m) \ set (uset p). Ifm ((((Inum (x#bs) t)/ real n + (Inum (x#bs) s) / real m) /2)#bs) p))" - (is "(\x. ?I x p) = (?M \ ?P \ ?F)" is "?E = ?D") + shows "(\x. Ifm (x#bs) p) \ + Ifm (x # bs) (minusinf p) \ Ifm (x # bs) (plusinf p) \ + (\(t,n) \ set (uset p). \(s,m) \ set (uset p). + Ifm ((((Inum (x # bs) t) / real n + (Inum (x # bs) s) / real m) / 2) # bs) p)" + (is "(\x. ?I x p) \ (?M \ ?P \ ?F)" is "?E = ?D") proof assume px: "\x. ?I x p" - have "?M \ ?P \ (\ ?M \ \ ?P)" by blast - moreover {assume "?M \ ?P" then have "?D" by blast} - moreover {assume nmi: "\ ?M" and npi: "\ ?P" - from rinf_uset[OF lp nmi npi] have "?F" using px by blast then have "?D" by blast} - ultimately show "?D" by blast + consider "?M \ ?P" | "\ ?M" "\ ?P" by blast + then show ?D + proof cases + case 1 + then show ?thesis by blast + next + case 2 + from rinf_uset[OF lp this] have ?F + using px by blast + then show ?thesis by blast + qed next - assume "?D" - moreover {assume m:"?M" from rminusinf_ex[OF lp m] have "?E" .} - moreover {assume p: "?P" from rplusinf_ex[OF lp p] have "?E" . } - moreover {assume f:"?F" then have "?E" by blast} - ultimately show "?E" by blast + assume ?D + then consider ?M | ?P | ?F by blast + then show ?E + proof cases + case 1 + from rminusinf_ex[OF lp this] show ?thesis . + next + case 2 + from rplusinf_ex[OF lp this] show ?thesis . + next + case 3 + then show ?thesis by blast + qed qed lemma fr_equsubst: assumes lp: "isrlfm p" - shows "(\x. Ifm (x#bs) p) = ((Ifm (x#bs) (minusinf p)) \ (Ifm (x#bs) (plusinf p)) \ (\(t,k) \ set (uset p). \(s,l) \ set (uset p). Ifm (x#bs) (usubst p (Add(Mul l t) (Mul k s) , 2*k*l))))" - (is "(\x. ?I x p) = (?M \ ?P \ ?F)" is "?E = ?D") + shows "(\x. Ifm (x # bs) p) \ + (Ifm (x # bs) (minusinf p) \ Ifm (x # bs) (plusinf p) \ + (\(t,k) \ set (uset p). \(s,l) \ set (uset p). + Ifm (x#bs) (usubst p (Add (Mul l t) (Mul k s), 2 * k * l))))" + (is "(\x. ?I x p) \ ?M \ ?P \ ?F" is "?E = ?D") proof assume px: "\x. ?I x p" - have "?M \ ?P \ (\ ?M \ \ ?P)" by blast - moreover {assume "?M \ ?P" then have "?D" by blast} - moreover {assume nmi: "\ ?M" and npi: "\ ?P" - let ?f ="\(t,n). Inum (x#bs) t / real n" - let ?N = "\t. Inum (x#bs) t" - {fix t n s m assume "(t,n)\ set (uset p)" and "(s,m) \ set (uset p)" - with uset_l[OF lp] have tnb: "numbound0 t" and np:"real n > 0" and snb: "numbound0 s" and mp:"real m > 0" + consider "?M \ ?P" | "\ ?M" "\ ?P" by blast + then show ?D + proof cases + case 1 + then show ?thesis by blast + next + case 2 + let ?f = "\(t,n). Inum (x # bs) t / real n" + let ?N = "\t. Inum (x # bs) t" + { + fix t n s m + assume "(t, n) \ set (uset p)" and "(s, m) \ set (uset p)" + with uset_l[OF lp] have tnb: "numbound0 t" + and np: "real n > 0" and snb: "numbound0 s" and mp: "real m > 0" by auto let ?st = "Add (Mul m t) (Mul n s)" - from np mp have mnp: "real (2*n*m) > 0" by (simp add: mult.commute) - from tnb snb have st_nb: "numbound0 ?st" by simp - have st: "(?N t / real n + ?N s / real m)/2 = ?N ?st / real (2*n*m)" + from np mp have mnp: "real (2 * n * m) > 0" + by (simp add: mult.commute) + from tnb snb have st_nb: "numbound0 ?st" + by simp + have st: "(?N t / real n + ?N s / real m) / 2 = ?N ?st / real (2 * n * m)" using mnp mp np by (simp add: algebra_simps add_divide_distrib) from usubst_I[OF lp mnp st_nb, where x="x" and bs="bs"] - have "?I x (usubst p (?st,2*n*m)) = ?I ((?N t / real n + ?N s / real m) /2) p" by (simp only: st[symmetric])} - with rinf_uset[OF lp nmi npi px] have "?F" by blast then have "?D" by blast} - ultimately show "?D" by blast + have "?I x (usubst p (?st, 2 * n * m)) = ?I ((?N t / real n + ?N s / real m) / 2) p" + by (simp only: st[symmetric]) + } + with rinf_uset[OF lp 2 px] have ?F + by blast + then show ?thesis + by blast + qed next - assume "?D" - moreover {assume m:"?M" from rminusinf_ex[OF lp m] have "?E" .} - moreover {assume p: "?P" from rplusinf_ex[OF lp p] have "?E" . } - moreover {fix t k s l assume "(t,k) \ set (uset p)" and "(s,l) \ set (uset p)" - and px:"?I x (usubst p (Add (Mul l t) (Mul k s), 2*k*l))" - with uset_l[OF lp] have tnb: "numbound0 t" and np:"real k > 0" and snb: "numbound0 s" and mp:"real l > 0" by auto + assume ?D + then consider ?M | ?P | t k s l where "(t, k) \ set (uset p)" "(s, l) \ set (uset p)" + "?I x (usubst p (Add (Mul l t) (Mul k s), 2 * k * l))" + by blast + then show ?E + proof cases + case 1 + from rminusinf_ex[OF lp this] show ?thesis . + next + case 2 + from rplusinf_ex[OF lp this] show ?thesis . + next + case 3 + with uset_l[OF lp] have tnb: "numbound0 t" and np: "real k > 0" + and snb: "numbound0 s" and mp: "real l > 0" + by auto let ?st = "Add (Mul l t) (Mul k s)" - from np mp have mnp: "real (2*k*l) > 0" by (simp add: mult.commute) - from tnb snb have st_nb: "numbound0 ?st" by simp - from usubst_I[OF lp mnp st_nb, where bs="bs"] px have "?E" by auto} - ultimately show "?E" by blast + from np mp have mnp: "real (2 * k * l) > 0" + by (simp add: mult.commute) + from tnb snb have st_nb: "numbound0 ?st" + by simp + from usubst_I[OF lp mnp st_nb, where bs="bs"] + \?I x (usubst p (Add (Mul l t) (Mul k s), 2 * k * l))\ show ?thesis + by auto + qed qed (* Implement the right hand side of Ferrante and Rackoff's Theorem. *) -definition ferrack :: "fm \ fm" where - "ferrack p = (let p' = rlfm (simpfm p); mp = minusinf p'; pp = plusinf p' - in if (mp = T \ pp = T) then T else - (let U = remdups(map simp_num_pair - (map (\((t,n),(s,m)). (Add (Mul m t) (Mul n s) , 2*n*m)) - (alluopairs (uset p')))) - in decr (disj mp (disj pp (evaldjf (simpfm \ (usubst p')) U)))))" +definition ferrack :: "fm \ fm" +where + "ferrack p = + (let + p' = rlfm (simpfm p); + mp = minusinf p'; + pp = plusinf p' + in + if mp = T \ pp = T then T + else + (let U = remdups (map simp_num_pair + (map (\((t,n),(s,m)). (Add (Mul m t) (Mul n s) , 2 * n * m)) + (alluopairs (uset p')))) + in decr (disj mp (disj pp (evaldjf (simpfm \ usubst p') U)))))" lemma uset_cong_aux: - assumes Ul: "\(t,n) \ set U. numbound0 t \ n >0" - shows "((\(t,n). Inum (x#bs) t /real n) ` (set (map (\((t,n),(s,m)). (Add (Mul m t) (Mul n s) , 2*n*m)) (alluopairs U)))) = ((\((t,n),(s,m)). (Inum (x#bs) t /real n + Inum (x#bs) s /real m)/2) ` (set U \ set U))" + assumes Ul: "\(t,n) \ set U. numbound0 t \ n > 0" + shows "((\(t,n). Inum (x # bs) t / real n) ` + (set (map (\((t,n),(s,m)). (Add (Mul m t) (Mul n s), 2 * n * m)) (alluopairs U)))) = + ((\((t,n),(s,m)). (Inum (x # bs) t / real n + Inum (x # bs) s / real m) / 2) ` (set U \ set U))" (is "?lhs = ?rhs") -proof(auto) +proof auto fix t n s m - assume "((t,n),(s,m)) \ set (alluopairs U)" - then have th: "((t,n),(s,m)) \ (set U \ set U)" + assume "((t, n), (s, m)) \ set (alluopairs U)" + then have th: "((t, n), (s, m)) \ set U \ set U" using alluopairs_set1[where xs="U"] by blast - let ?N = "\t. Inum (x#bs) t" - let ?st= "Add (Mul m t) (Mul n s)" - from Ul th have mnz: "m \ 0" by auto - from Ul th have nnz: "n \ 0" by auto - have st: "(?N t / real n + ?N s / real m)/2 = ?N ?st / real (2*n*m)" - using mnz nnz by (simp add: algebra_simps add_divide_distrib) - - then show "(real m * Inum (x # bs) t + real n * Inum (x # bs) s) / - (2 * real n * real m) - \ (\((t, n), s, m). - (Inum (x # bs) t / real n + Inum (x # bs) s / real m) / 2) ` - (set U \ set U)"using mnz nnz th + let ?N = "\t. Inum (x # bs) t" + let ?st = "Add (Mul m t) (Mul n s)" + from Ul th have mnz: "m \ 0" + by auto + from Ul th have nnz: "n \ 0" + by auto + have st: "(?N t / real n + ?N s / real m) / 2 = ?N ?st / real (2 * n * m)" + using mnz nnz by (simp add: algebra_simps add_divide_distrib) + then show "(real m * Inum (x # bs) t + real n * Inum (x # bs) s) / (2 * real n * real m) + \ (\((t, n), s, m). (Inum (x # bs) t / real n + Inum (x # bs) s / real m) / 2) ` + (set U \ set U)" + using mnz nnz th apply (auto simp add: th add_divide_distrib algebra_simps split_def image_def) - by (rule_tac x="(s,m)" in bexI,simp_all) - (rule_tac x="(t,n)" in bexI,simp_all add: mult.commute) + apply (rule_tac x="(s,m)" in bexI) + apply simp_all + apply (rule_tac x="(t,n)" in bexI) + apply (simp_all add: mult.commute) + done next fix t n s m - assume tnU: "(t,n) \ set U" and smU:"(s,m) \ set U" - let ?N = "\t. Inum (x#bs) t" - let ?st= "Add (Mul m t) (Mul n s)" - from Ul smU have mnz: "m \ 0" by auto - from Ul tnU have nnz: "n \ 0" by auto - have st: "(?N t / real n + ?N s / real m)/2 = ?N ?st / real (2*n*m)" - using mnz nnz by (simp add: algebra_simps add_divide_distrib) - let ?P = "\(t',n') (s',m'). (Inum (x # bs) t / real n + Inum (x # bs) s / real m)/2 = (Inum (x # bs) t' / real n' + Inum (x # bs) s' / real m')/2" - have Pc:"\a b. ?P a b = ?P b a" - by auto - from Ul alluopairs_set1 have Up:"\((t,n),(s,m)) \ set (alluopairs U). n \ 0 \ m \ 0" by blast - from alluopairs_ex[OF Pc, where xs="U"] tnU smU - have th':"\((t',n'),(s',m')) \ set (alluopairs U). ?P (t',n') (s',m')" - by blast - then obtain t' n' s' m' where ts'_U: "((t',n'),(s',m')) \ set (alluopairs U)" - and Pts': "?P (t',n') (s',m')" by blast - from ts'_U Up have mnz': "m' \ 0" and nnz': "n'\ 0" by auto - let ?st' = "Add (Mul m' t') (Mul n' s')" - have st': "(?N t' / real n' + ?N s' / real m')/2 = ?N ?st' / real (2*n'*m')" - using mnz' nnz' by (simp add: algebra_simps add_divide_distrib) - from Pts' have - "(Inum (x # bs) t / real n + Inum (x # bs) s / real m)/2 = (Inum (x # bs) t' / real n' + Inum (x # bs) s' / real m')/2" by simp - also have "\ = ((\(t, n). Inum (x # bs) t / real n) ((\((t, n), s, m). (Add (Mul m t) (Mul n s), 2 * n * m)) ((t',n'),(s',m'))))" by (simp add: st') - finally show "(Inum (x # bs) t / real n + Inum (x # bs) s / real m) / 2 - \ (\(t, n). Inum (x # bs) t / real n) ` - (\((t, n), s, m). (Add (Mul m t) (Mul n s), 2 * n * m)) ` - set (alluopairs U)" - using ts'_U by blast + assume tnU: "(t, n) \ set U" and smU: "(s, m) \ set U" + let ?N = "\t. Inum (x # bs) t" + let ?st = "Add (Mul m t) (Mul n s)" + from Ul smU have mnz: "m \ 0" + by auto + from Ul tnU have nnz: "n \ 0" + by auto + have st: "(?N t / real n + ?N s / real m) / 2 = ?N ?st / real (2 * n * m)" + using mnz nnz by (simp add: algebra_simps add_divide_distrib) + let ?P = "\(t',n') (s',m'). (Inum (x # bs) t / real n + Inum (x # bs) s / real m)/2 = + (Inum (x # bs) t' / real n' + Inum (x # bs) s' / real m') / 2" + have Pc:"\a b. ?P a b = ?P b a" + by auto + from Ul alluopairs_set1 have Up:"\((t,n),(s,m)) \ set (alluopairs U). n \ 0 \ m \ 0" + by blast + from alluopairs_ex[OF Pc, where xs="U"] tnU smU + have th':"\((t',n'),(s',m')) \ set (alluopairs U). ?P (t',n') (s',m')" + by blast + then obtain t' n' s' m' where ts'_U: "((t',n'),(s',m')) \ set (alluopairs U)" + and Pts': "?P (t', n') (s', m')" + by blast + from ts'_U Up have mnz': "m' \ 0" and nnz': "n'\ 0" + by auto + let ?st' = "Add (Mul m' t') (Mul n' s')" + have st': "(?N t' / real n' + ?N s' / real m') / 2 = ?N ?st' / real (2 * n' * m')" + using mnz' nnz' by (simp add: algebra_simps add_divide_distrib) + from Pts' have "(Inum (x # bs) t / real n + Inum (x # bs) s / real m) / 2 = + (Inum (x # bs) t' / real n' + Inum (x # bs) s' / real m') / 2" + by simp + also have "\ = (\(t, n). Inum (x # bs) t / real n) + ((\((t, n), s, m). (Add (Mul m t) (Mul n s), 2 * n * m)) ((t', n'), (s', m')))" + by (simp add: st') + finally show "(Inum (x # bs) t / real n + Inum (x # bs) s / real m) / 2 + \ (\(t, n). Inum (x # bs) t / real n) ` + (\((t, n), s, m). (Add (Mul m t) (Mul n s), 2 * n * m)) ` set (alluopairs U)" + using ts'_U by blast qed lemma uset_cong: assumes lp: "isrlfm p" - and UU': "((\(t,n). Inum (x#bs) t /real n) ` U') = ((\((t,n),(s,m)). (Inum (x#bs) t /real n + Inum (x#bs) s /real m)/2) ` (U \ U))" (is "?f ` U' = ?g ` (U\U)") - and U: "\(t,n) \ U. numbound0 t \ n > 0" - and U': "\(t,n) \ U'. numbound0 t \ n > 0" - shows "(\(t,n) \ U. \(s,m) \ U. Ifm (x#bs) (usubst p (Add (Mul m t) (Mul n s),2*n*m))) = (\(t,n) \ U'. Ifm (x#bs) (usubst p (t,n)))" - (is "?lhs = ?rhs") + and UU': "((\(t,n). Inum (x # bs) t / real n) ` U') = + ((\((t,n),(s,m)). (Inum (x # bs) t / real n + Inum (x # bs) s / real m) / 2) ` (U \ U))" + (is "?f ` U' = ?g ` (U \ U)") + and U: "\(t,n) \ U. numbound0 t \ n > 0" + and U': "\(t,n) \ U'. numbound0 t \ n > 0" + shows "(\(t,n) \ U. \(s,m) \ U. Ifm (x # bs) (usubst p (Add (Mul m t) (Mul n s), 2 * n * m))) = + (\(t,n) \ U'. Ifm (x # bs) (usubst p (t, n)))" + (is "?lhs \ ?rhs") proof - assume ?lhs - then obtain t n s m where tnU: "(t,n) \ U" and smU:"(s,m) \ U" and - Pst: "Ifm (x#bs) (usubst p (Add (Mul m t) (Mul n s),2*n*m))" by blast - let ?N = "\t. Inum (x#bs) t" - from tnU smU U have tnb: "numbound0 t" and np: "n > 0" - and snb: "numbound0 s" and mp:"m > 0" by auto - let ?st= "Add (Mul m t) (Mul n s)" - from np mp have mnp: "real (2*n*m) > 0" + show ?rhs if ?lhs + proof - + from that obtain t n s m where tnU: "(t, n) \ U" and smU: "(s, m) \ U" + and Pst: "Ifm (x # bs) (usubst p (Add (Mul m t) (Mul n s), 2 * n * m))" + by blast + let ?N = "\t. Inum (x#bs) t" + from tnU smU U have tnb: "numbound0 t" and np: "n > 0" + and snb: "numbound0 s" and mp: "m > 0" + by auto + let ?st = "Add (Mul m t) (Mul n s)" + from np mp have mnp: "real (2 * n * m) > 0" by (simp add: mult.commute real_of_int_mult[symmetric] del: real_of_int_mult) - from tnb snb have stnb: "numbound0 ?st" by simp - have st: "(?N t / real n + ?N s / real m)/2 = ?N ?st / real (2*n*m)" - using mp np by (simp add: algebra_simps add_divide_distrib) - from tnU smU UU' have "?g ((t,n),(s,m)) \ ?f ` U'" by blast - then have "\(t',n') \ U'. ?g ((t,n),(s,m)) = ?f (t',n')" - by auto (rule_tac x="(a,b)" in bexI, auto) - then obtain t' n' where tnU': "(t',n') \ U'" and th: "?g ((t,n),(s,m)) = ?f (t',n')" by blast - from U' tnU' have tnb': "numbound0 t'" and np': "real n' > 0" by auto - from usubst_I[OF lp mnp stnb, where bs="bs" and x="x"] Pst - have Pst2: "Ifm (Inum (x # bs) (Add (Mul m t) (Mul n s)) / real (2 * n * m) # bs) p" by simp - from conjunct1[OF usubst_I[OF lp np' tnb', where bs="bs" and x="x"], symmetric] th[simplified split_def fst_conv snd_conv,symmetric] Pst2[simplified st[symmetric]] - have "Ifm (x # bs) (usubst p (t', n')) " by (simp only: st) - then show ?rhs using tnU' by auto -next - assume ?rhs - then obtain t' n' where tnU': "(t',n') \ U'" and Pt': "Ifm (x # bs) (usubst p (t', n'))" - by blast - from tnU' UU' have "?f (t',n') \ ?g ` (U\U)" by blast - then have "\((t,n),(s,m)) \ (U\U). ?f (t',n') = ?g ((t,n),(s,m))" - by auto (rule_tac x="(a,b)" in bexI, auto) - then obtain t n s m where tnU: "(t,n) \ U" and smU:"(s,m) \ U" and - th: "?f (t',n') = ?g((t,n),(s,m)) "by blast - let ?N = "\t. Inum (x#bs) t" - from tnU smU U have tnb: "numbound0 t" and np: "n > 0" - and snb: "numbound0 s" and mp:"m > 0" by auto - let ?st= "Add (Mul m t) (Mul n s)" - from np mp have mnp: "real (2*n*m) > 0" + from tnb snb have stnb: "numbound0 ?st" + by simp + have st: "(?N t / real n + ?N s / real m) / 2 = ?N ?st / real (2 * n * m)" + using mp np by (simp add: algebra_simps add_divide_distrib) + from tnU smU UU' have "?g ((t, n), (s, m)) \ ?f ` U'" + by blast + then have "\(t',n') \ U'. ?g ((t, n), (s, m)) = ?f (t', n')" + apply auto + apply (rule_tac x="(a, b)" in bexI) + apply auto + done + then obtain t' n' where tnU': "(t',n') \ U'" and th: "?g ((t, n), (s, m)) = ?f (t', n')" + by blast + from U' tnU' have tnb': "numbound0 t'" and np': "real n' > 0" + by auto + from usubst_I[OF lp mnp stnb, where bs="bs" and x="x"] Pst + have Pst2: "Ifm (Inum (x # bs) (Add (Mul m t) (Mul n s)) / real (2 * n * m) # bs) p" + by simp + from conjunct1[OF usubst_I[OF lp np' tnb', where bs="bs" and x="x"], symmetric] + th[simplified split_def fst_conv snd_conv,symmetric] Pst2[simplified st[symmetric]] + have "Ifm (x # bs) (usubst p (t', n'))" + by (simp only: st) + then show ?thesis + using tnU' by auto + qed + show ?lhs if ?rhs + proof - + from that obtain t' n' where tnU': "(t', n') \ U'" and Pt': "Ifm (x # bs) (usubst p (t', n'))" + by blast + from tnU' UU' have "?f (t', n') \ ?g ` (U \ U)" + by blast + then have "\((t,n),(s,m)) \ U \ U. ?f (t', n') = ?g ((t, n), (s, m))" + apply auto + apply (rule_tac x="(a,b)" in bexI) + apply auto + done + then obtain t n s m where tnU: "(t, n) \ U" and smU: "(s, m) \ U" and + th: "?f (t', n') = ?g ((t, n), (s, m))" + by blast + let ?N = "\t. Inum (x # bs) t" + from tnU smU U have tnb: "numbound0 t" and np: "n > 0" + and snb: "numbound0 s" and mp: "m > 0" + by auto + let ?st = "Add (Mul m t) (Mul n s)" + from np mp have mnp: "real (2 * n * m) > 0" by (simp add: mult.commute real_of_int_mult[symmetric] del: real_of_int_mult) - from tnb snb have stnb: "numbound0 ?st" by simp - have st: "(?N t / real n + ?N s / real m)/2 = ?N ?st / real (2*n*m)" - using mp np by (simp add: algebra_simps add_divide_distrib) - from U' tnU' have tnb': "numbound0 t'" and np': "real n' > 0" by auto - from usubst_I[OF lp np' tnb', where bs="bs" and x="x",simplified th[simplified split_def fst_conv snd_conv] st] Pt' - have Pst2: "Ifm (Inum (x # bs) (Add (Mul m t) (Mul n s)) / real (2 * n * m) # bs) p" by simp - with usubst_I[OF lp mnp stnb, where x="x" and bs="bs"] tnU smU show ?lhs by blast + from tnb snb have stnb: "numbound0 ?st" + by simp + have st: "(?N t / real n + ?N s / real m) / 2 = ?N ?st / real (2 * n * m)" + using mp np by (simp add: algebra_simps add_divide_distrib) + from U' tnU' have tnb': "numbound0 t'" and np': "real n' > 0" + by auto + from usubst_I[OF lp np' tnb', where bs="bs" and x="x",simplified + th[simplified split_def fst_conv snd_conv] st] Pt' + have Pst2: "Ifm (Inum (x # bs) (Add (Mul m t) (Mul n s)) / real (2 * n * m) # bs) p" + by simp + with usubst_I[OF lp mnp stnb, where x="x" and bs="bs"] tnU smU + show ?thesis by blast + qed qed lemma ferrack: assumes qf: "qfree p" - shows "qfree (ferrack p) \ ((Ifm bs (ferrack p)) = (\x. Ifm (x#bs) p))" - (is "_ \ (?rhs = ?lhs)") + shows "qfree (ferrack p) \ (Ifm bs (ferrack p) \ (\x. Ifm (x # bs) p))" + (is "_ \ (?rhs \ ?lhs)") proof - - let ?I = "\x p. Ifm (x#bs) p" + let ?I = "\x p. Ifm (x # bs) p" fix x - let ?N = "\t. Inum (x#bs) t" + let ?N = "\t. Inum (x # bs) t" let ?q = "rlfm (simpfm p)" let ?U = "uset ?q" let ?Up = "alluopairs ?U" - let ?g = "\((t,n),(s,m)). (Add (Mul m t) (Mul n s) , 2*n*m)" + let ?g = "\((t,n),(s,m)). (Add (Mul m t) (Mul n s), 2 * n * m)" let ?S = "map ?g ?Up" let ?SS = "map simp_num_pair ?S" let ?Y = "remdups ?SS" - let ?f= "(\(t,n). ?N t / real n)" - let ?h = "\((t,n),(s,m)). (?N t/real n + ?N s/ real m) /2" - let ?F = "\p. \a \ set (uset p). \b \ set (uset p). ?I x (usubst p (?g(a,b)))" + let ?f = "\(t,n). ?N t / real n" + let ?h = "\((t,n),(s,m)). (?N t / real n + ?N s / real m) / 2" + let ?F = "\p. \a \ set (uset p). \b \ set (uset p). ?I x (usubst p (?g (a, b)))" let ?ep = "evaldjf (simpfm \ (usubst ?q)) ?Y" - from rlfm_I[OF simpfm_qf[OF qf]] have lq: "isrlfm ?q" by blast - from alluopairs_set1[where xs="?U"] have UpU: "set ?Up \ (set ?U \ set ?U)" by simp + from rlfm_I[OF simpfm_qf[OF qf]] have lq: "isrlfm ?q" + by blast + from alluopairs_set1[where xs="?U"] have UpU: "set ?Up \ set ?U \ set ?U" + by simp from uset_l[OF lq] have U_l: "\(t,n) \ set ?U. numbound0 t \ n > 0" . from U_l UpU - have "\((t,n),(s,m)) \ set ?Up. numbound0 t \ n> 0 \ numbound0 s \ m > 0" by auto - then have Snb: "\(t,n) \ set ?S. numbound0 t \ n > 0 " by auto + have "\((t,n),(s,m)) \ set ?Up. numbound0 t \ n> 0 \ numbound0 s \ m > 0" + by auto + then have Snb: "\(t,n) \ set ?S. numbound0 t \ n > 0 " + by auto have Y_l: "\(t,n) \ set ?Y. numbound0 t \ n > 0" proof - - { fix t n assume tnY: "(t,n) \ set ?Y" - then have "(t,n) \ set ?SS" by simp - then have "\(t',n') \ set ?S. simp_num_pair (t',n') = (t,n)" - by (auto simp add: split_def simp del: map_map) - (rule_tac x="((aa,ba),(ab,bb))" in bexI, simp_all) - then obtain t' n' where tn'S: "(t',n') \ set ?S" and tns: "simp_num_pair (t',n') = (t,n)" by blast - from tn'S Snb have tnb: "numbound0 t'" and np: "n' > 0" by auto - from simp_num_pair_l[OF tnb np tns] - have "numbound0 t \ n > 0" . } + have "numbound0 t \ n > 0" if tnY: "(t, n) \ set ?Y" for t n + proof - + from that have "(t,n) \ set ?SS" + by simp + then have "\(t',n') \ set ?S. simp_num_pair (t', n') = (t, n)" + apply (auto simp add: split_def simp del: map_map) + apply (rule_tac x="((aa,ba),(ab,bb))" in bexI) + apply simp_all + done + then obtain t' n' where tn'S: "(t', n') \ set ?S" and tns: "simp_num_pair (t', n') = (t, n)" + by blast + from tn'S Snb have tnb: "numbound0 t'" and np: "n' > 0" + by auto + from simp_num_pair_l[OF tnb np tns] show ?thesis . + qed then show ?thesis by blast qed have YU: "(?f ` set ?Y) = (?h ` (set ?U \ set ?U))" proof - - from simp_num_pair_ci[where bs="x#bs"] have - "\x. (?f \ simp_num_pair) x = ?f x" by auto - then have th: "?f \ simp_num_pair = ?f" using ext by blast - have "(?f ` set ?Y) = ((?f \ simp_num_pair) ` set ?S)" by (simp add: comp_assoc image_comp) - also have "\ = (?f ` set ?S)" by (simp add: th) - also have "\ = ((?f \ ?g) ` set ?Up)" + from simp_num_pair_ci[where bs="x#bs"] have "\x. (?f \ simp_num_pair) x = ?f x" + by auto + then have th: "?f \ simp_num_pair = ?f" + by auto + have "(?f ` set ?Y) = ((?f \ simp_num_pair) ` set ?S)" + by (simp add: comp_assoc image_comp) + also have "\ = ?f ` set ?S" + by (simp add: th) + also have "\ = (?f \ ?g) ` set ?Up" by (simp only: set_map o_def image_comp) - also have "\ = (?h ` (set ?U \ set ?U))" - using uset_cong_aux[OF U_l, where x="x" and bs="bs", simplified set_map image_comp] by blast + also have "\ = ?h ` (set ?U \ set ?U)" + using uset_cong_aux[OF U_l, where x="x" and bs="bs", simplified set_map image_comp] + by blast finally show ?thesis . qed - have "\(t,n) \ set ?Y. bound0 (simpfm (usubst ?q (t,n)))" + have "\(t,n) \ set ?Y. bound0 (simpfm (usubst ?q (t, n)))" proof - - { fix t n assume tnY: "(t,n) \ set ?Y" - with Y_l have tnb: "numbound0 t" and np: "real n > 0" by auto - from usubst_I[OF lq np tnb] - have "bound0 (usubst ?q (t,n))" by simp then have "bound0 (simpfm (usubst ?q (t,n)))" - using simpfm_bound0 by simp} + have "bound0 (simpfm (usubst ?q (t, n)))" if tnY: "(t,n) \ set ?Y" for t n + proof - + from Y_l that have tnb: "numbound0 t" and np: "real n > 0" + by auto + from usubst_I[OF lq np tnb] have "bound0 (usubst ?q (t, n))" + by simp + then show ?thesis + using simpfm_bound0 by simp + qed then show ?thesis by blast qed - then have ep_nb: "bound0 ?ep" using evaldjf_bound0[where xs="?Y" and f="simpfm \ (usubst ?q)"] by auto + then have ep_nb: "bound0 ?ep" + using evaldjf_bound0[where xs="?Y" and f="simpfm \ (usubst ?q)"] by auto let ?mp = "minusinf ?q" let ?pp = "plusinf ?q" let ?M = "?I x ?mp" let ?P = "?I x ?pp" let ?res = "disj ?mp (disj ?pp ?ep)" - from rminusinf_bound0[OF lq] rplusinf_bound0[OF lq] ep_nb - have nbth: "bound0 ?res" by auto + from rminusinf_bound0[OF lq] rplusinf_bound0[OF lq] ep_nb have nbth: "bound0 ?res" + by auto - from conjunct1[OF rlfm_I[OF simpfm_qf[OF qf]]] simpfm - - have th: "?lhs = (\x. ?I x ?q)" by auto + from conjunct1[OF rlfm_I[OF simpfm_qf[OF qf]]] simpfm have th: "?lhs = (\x. ?I x ?q)" + by auto from th fr_equsubst[OF lq, where bs="bs" and x="x"] have lhfr: "?lhs = (?M \ ?P \ ?F ?q)" by (simp only: split_def fst_conv snd_conv) also have "\ = (?M \ ?P \ (\(t,n) \ set ?Y. ?I x (simpfm (usubst ?q (t,n)))))" - using uset_cong[OF lq YU U_l Y_l] by (simp only: split_def fst_conv snd_conv simpfm) + using uset_cong[OF lq YU U_l Y_l] by (simp only: split_def fst_conv snd_conv simpfm) also have "\ = (Ifm (x#bs) ?res)" using evaldjf_ex[where ps="?Y" and bs = "x#bs" and f="simpfm \ (usubst ?q)",symmetric] by (simp add: split_def pair_collapse) - finally have lheq: "?lhs = (Ifm bs (decr ?res))" using decr[OF nbth] by blast - then have lr: "?lhs = ?rhs" apply (unfold ferrack_def Let_def) + finally have lheq: "?lhs = Ifm bs (decr ?res)" + using decr[OF nbth] by blast + then have lr: "?lhs = ?rhs" + unfolding ferrack_def Let_def by (cases "?mp = T \ ?pp = T", auto) (simp add: disj_def)+ - from decr_qf[OF nbth] have "qfree (ferrack p)" by (auto simp add: Let_def ferrack_def) - with lr show ?thesis by blast + from decr_qf[OF nbth] have "qfree (ferrack p)" + by (auto simp add: Let_def ferrack_def) + with lr show ?thesis + by blast qed -definition linrqe:: "fm \ fm" where - "linrqe p = qelim (prep p) ferrack" +definition linrqe:: "fm \ fm" + where "linrqe p = qelim (prep p) ferrack" theorem linrqe: "Ifm bs (linrqe p) = Ifm bs p \ qfree (linrqe p)" -using ferrack qelim_ci prep -unfolding linrqe_def by auto + using ferrack qelim_ci prep + unfolding linrqe_def by auto -definition ferrack_test :: "unit \ fm" where - "ferrack_test u = linrqe (A (A (Imp (Lt (Sub (Bound 1) (Bound 0))) - (E (Eq (Sub (Add (Bound 0) (Bound 2)) (Bound 1)))))))" +definition ferrack_test :: "unit \ fm" +where + "ferrack_test u = + linrqe (A (A (Imp (Lt (Sub (Bound 1) (Bound 0))) + (E (Eq (Sub (Add (Bound 0) (Bound 2)) (Bound 1)))))))" ML_val \@{code ferrack_test} ()\