src/HOL/Multivariate_Analysis/Integration.thy
changeset 53494 c24892032eea
parent 53468 0688928a41fd
child 53495 fd977a1574dc
equal deleted inserted replaced
53490:c413adedef46 53494:c24892032eea
  2997   using integrable_integral
  2997   using integrable_integral
  2998   apply auto
  2998   apply auto
  2999   done
  2999   done
  3000 
  3000 
  3001 lemma integrable_setsum:
  3001 lemma integrable_setsum:
  3002   "finite t \<Longrightarrow> \<forall>a \<in> t.(f a) integrable_on s \<Longrightarrow> (\<lambda>x. setsum (\<lambda>a. f a x) t) integrable_on s"
  3002   "finite t \<Longrightarrow> \<forall>a \<in> t. (f a) integrable_on s \<Longrightarrow> (\<lambda>x. setsum (\<lambda>a. f a x) t) integrable_on s"
  3003   unfolding integrable_on_def
  3003   unfolding integrable_on_def
  3004   apply (drule bchoice)
  3004   apply (drule bchoice)
  3005   using has_integral_setsum[of t]
  3005   using has_integral_setsum[of t]
  3006   apply auto
  3006   apply auto
  3007   done
  3007   done
  3139   then guess y unfolding integrable_on_def has_integral .. note y=this
  3139   then guess y unfolding integrable_on_def has_integral .. note y=this
  3140   show "\<forall>e>0. \<exists>d. ?P e d"
  3140   show "\<forall>e>0. \<exists>d. ?P e d"
  3141   proof (rule, rule)
  3141   proof (rule, rule)
  3142     case goal1
  3142     case goal1
  3143     then have "e/2 > 0" by auto
  3143     then have "e/2 > 0" by auto
  3144     then guess d apply- apply(drule y[rule_format]) by(erule exE,erule conjE) note d=this[rule_format]
  3144     then guess d
       
  3145       apply -
       
  3146       apply (drule y[rule_format])
       
  3147       apply (elim exE conjE)
       
  3148       done
       
  3149     note d=this[rule_format]
  3145     show ?case
  3150     show ?case
  3146       apply (rule_tac x=d in exI)
  3151       apply (rule_tac x=d in exI)
  3147       apply rule
  3152       apply rule
  3148       apply (rule d)
  3153       apply (rule d)
  3149       apply rule
  3154       apply rule
  3213     then guess N1 unfolding real_arch_inv[of "e/2"] .. note N1=this
  3218     then guess N1 unfolding real_arch_inv[of "e/2"] .. note N1=this
  3214     then have N1': "N1 = N1 - 1 + 1"
  3219     then have N1': "N1 = N1 - 1 + 1"
  3215       by auto
  3220       by auto
  3216     guess N2 using y[OF *] .. note N2=this
  3221     guess N2 using y[OF *] .. note N2=this
  3217     show "\<exists>d. gauge d \<and>
  3222     show "\<exists>d. gauge d \<and>
  3218       (\<forall>p. p tagged_division_of {a..b} \<and> d fine p \<longrightarrow> norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - y) < e)"
  3223       (\<forall>p. p tagged_division_of {a..b} \<and> d fine p \<longrightarrow>
       
  3224         norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - y) < e)"
  3219       apply (rule_tac x="d (N1 + N2)" in exI)
  3225       apply (rule_tac x="d (N1 + N2)" in exI)
  3220       apply rule
  3226       apply rule
  3221       defer
  3227       defer
  3222     proof (rule, rule, erule conjE)
  3228     proof (rule, rule, erule conjE)
  3223       show "gauge (d (N1 + N2))"
  3229       show "gauge (d (N1 + N2))"
  3313     and "k1 \<inter> {x::'a. x\<bullet>k \<le> c} = k2 \<inter> {x. x\<bullet>k \<le> c}"
  3319     and "k1 \<inter> {x::'a. x\<bullet>k \<le> c} = k2 \<inter> {x. x\<bullet>k \<le> c}"
  3314     and k: "k\<in>Basis"
  3320     and k: "k\<in>Basis"
  3315   shows "content(k1 \<inter> {x. x\<bullet>k \<le> c}) = 0"
  3321   shows "content(k1 \<inter> {x. x\<bullet>k \<le> c}) = 0"
  3316 proof -
  3322 proof -
  3317   note d=division_ofD[OF assms(1)]
  3323   note d=division_ofD[OF assms(1)]
  3318   have *: "\<And>a b::'a. \<And> c. (content({a..b} \<inter> {x. x\<bullet>k \<le> c}) = 0 \<longleftrightarrow> interior({a..b} \<inter> {x. x\<bullet>k \<le> c}) = {})"
  3324   have *: "\<And>(a::'a) b c. content ({a..b} \<inter> {x. x\<bullet>k \<le> c}) = 0 \<longleftrightarrow>
       
  3325     interior({a..b} \<inter> {x. x\<bullet>k \<le> c}) = {}"
  3319     unfolding  interval_split[OF k] content_eq_0_interior by auto
  3326     unfolding  interval_split[OF k] content_eq_0_interior by auto
  3320   guess u1 v1 using d(4)[OF assms(2)] apply-by(erule exE)+ note uv1=this
  3327   guess u1 v1 using d(4)[OF assms(2)] apply-by(erule exE)+ note uv1=this
  3321   guess u2 v2 using d(4)[OF assms(3)] apply-by(erule exE)+ note uv2=this
  3328   guess u2 v2 using d(4)[OF assms(3)] apply-by(erule exE)+ note uv2=this
  3322   have **: "\<And>s t u. s \<inter> t = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<subseteq> t \<Longrightarrow> u = {}"
  3329   have **: "\<And>s t u. s \<inter> t = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<subseteq> t \<Longrightarrow> u = {}"
  3323     by auto
  3330     by auto
  3342 proof -
  3349 proof -
  3343   note d=division_ofD[OF assms(1)]
  3350   note d=division_ofD[OF assms(1)]
  3344   have *: "\<And>a b::'a. \<And>c. content({a..b} \<inter> {x. x\<bullet>k \<ge> c}) = 0 \<longleftrightarrow>
  3351   have *: "\<And>a b::'a. \<And>c. content({a..b} \<inter> {x. x\<bullet>k \<ge> c}) = 0 \<longleftrightarrow>
  3345     interior({a..b} \<inter> {x. x\<bullet>k \<ge> c}) = {}"
  3352     interior({a..b} \<inter> {x. x\<bullet>k \<ge> c}) = {}"
  3346     unfolding interval_split[OF k] content_eq_0_interior by auto
  3353     unfolding interval_split[OF k] content_eq_0_interior by auto
  3347   guess u1 v1 using d(4)[OF assms(2)] apply-by(erule exE)+ note uv1=this
  3354   guess u1 v1 using d(4)[OF assms(2)] by (elim exE) note uv1=this
  3348   guess u2 v2 using d(4)[OF assms(3)] apply-by(erule exE)+ note uv2=this
  3355   guess u2 v2 using d(4)[OF assms(3)] by (elim exE) note uv2=this
  3349   have **: "\<And>s t u. s \<inter> t = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<subseteq> t \<Longrightarrow> u = {}"
  3356   have **: "\<And>s t u. s \<inter> t = {} \<Longrightarrow> u \<subseteq> s \<Longrightarrow> u \<subseteq> t \<Longrightarrow> u = {}"
  3350     by auto
  3357     by auto
  3351   show ?thesis
  3358   show ?thesis
  3352     unfolding uv1 uv2 *
  3359     unfolding uv1 uv2 *
  3353     apply (rule **[OF d(5)[OF assms(2-4)]])
  3360     apply (rule **[OF d(5)[OF assms(2-4)]])
  3359 qed
  3366 qed
  3360 
  3367 
  3361 lemma tagged_division_split_left_inj:
  3368 lemma tagged_division_split_left_inj:
  3362   fixes x1 :: "'a::ordered_euclidean_space"
  3369   fixes x1 :: "'a::ordered_euclidean_space"
  3363   assumes "d tagged_division_of i"
  3370   assumes "d tagged_division_of i"
  3364     and "(x1,k1) \<in> d"
  3371     and "(x1, k1) \<in> d"
  3365     and "(x2, k2) \<in> d"
  3372     and "(x2, k2) \<in> d"
  3366     and "k1 \<noteq> k2"
  3373     and "k1 \<noteq> k2"
  3367     and "k1 \<inter> {x. x\<bullet>k \<le> c} = k2 \<inter> {x. x\<bullet>k \<le> c}"
  3374     and "k1 \<inter> {x. x\<bullet>k \<le> c} = k2 \<inter> {x. x\<bullet>k \<le> c}"
  3368     and k: "k \<in> Basis"
  3375     and k: "k \<in> Basis"
  3369   shows "content (k1 \<inter> {x. x\<bullet>k \<le> c}) = 0"
  3376   shows "content (k1 \<inter> {x. x\<bullet>k \<le> c}) = 0"
  3387     and "(x1, k1) \<in> d"
  3394     and "(x1, k1) \<in> d"
  3388     and "(x2, k2) \<in> d"
  3395     and "(x2, k2) \<in> d"
  3389     and "k1 \<noteq> k2"
  3396     and "k1 \<noteq> k2"
  3390     and "k1 \<inter> {x. x\<bullet>k \<ge> c} = k2 \<inter> {x. x\<bullet>k \<ge> c}"
  3397     and "k1 \<inter> {x. x\<bullet>k \<ge> c} = k2 \<inter> {x. x\<bullet>k \<ge> c}"
  3391   and k: "k \<in> Basis"
  3398   and k: "k \<in> Basis"
  3392   shows "content(k1 \<inter> {x. x\<bullet>k \<ge> c}) = 0"
  3399   shows "content (k1 \<inter> {x. x\<bullet>k \<ge> c}) = 0"
  3393 proof -
  3400 proof -
  3394   have *: "\<And>a b c. (a,b) \<in> c \<Longrightarrow> b \<in> snd ` c"
  3401   have *: "\<And>a b c. (a,b) \<in> c \<Longrightarrow> b \<in> snd ` c"
  3395     unfolding image_iff
  3402     unfolding image_iff
  3396     apply (rule_tac x="(a,b)" in bexI)
  3403     apply (rule_tac x="(a,b)" in bexI)
  3397     apply auto
  3404     apply auto
  3470   shows "(f has_integral (i + j)) ({a..b})"
  3477   shows "(f has_integral (i + j)) ({a..b})"
  3471 proof (unfold has_integral, rule, rule)
  3478 proof (unfold has_integral, rule, rule)
  3472   case goal1
  3479   case goal1
  3473   then have e: "e/2 > 0"
  3480   then have e: "e/2 > 0"
  3474     by auto
  3481     by auto
  3475   guess d1 using has_integralD[OF assms(1)[unfolded interval_split[OF k]] e] . note d1=this[unfolded interval_split[symmetric,OF k]]
  3482   guess d1 using has_integralD[OF assms(1)[unfolded interval_split[OF k]] e] .
  3476   guess d2 using has_integralD[OF assms(2)[unfolded interval_split[OF k]] e] . note d2=this[unfolded interval_split[symmetric,OF k]]
  3483   note d1=this[unfolded interval_split[symmetric,OF k]]
       
  3484   guess d2 using has_integralD[OF assms(2)[unfolded interval_split[OF k]] e] .
       
  3485   note d2=this[unfolded interval_split[symmetric,OF k]]
  3477   let ?d = "\<lambda>x. if x\<bullet>k = c then (d1 x \<inter> d2 x) else ball x (abs(x\<bullet>k - c)) \<inter> d1 x \<inter> d2 x"
  3486   let ?d = "\<lambda>x. if x\<bullet>k = c then (d1 x \<inter> d2 x) else ball x (abs(x\<bullet>k - c)) \<inter> d1 x \<inter> d2 x"
  3478   show ?case
  3487   show ?case
  3479     apply (rule_tac x="?d" in exI)
  3488     apply (rule_tac x="?d" in exI)
  3480     apply rule
  3489     apply rule
  3481     defer
  3490     defer
  3484     apply (elim conjE)
  3493     apply (elim conjE)
  3485   proof -
  3494   proof -
  3486     show "gauge ?d"
  3495     show "gauge ?d"
  3487       using d1(1) d2(1) unfolding gauge_def by auto
  3496       using d1(1) d2(1) unfolding gauge_def by auto
  3488     fix p
  3497     fix p
  3489     assume "p tagged_division_of {a..b}" "?d fine p" note p = this tagged_division_ofD[OF this(1)]
  3498     assume "p tagged_division_of {a..b}" "?d fine p"
       
  3499     note p = this tagged_division_ofD[OF this(1)]
  3490     have lem0:
  3500     have lem0:
  3491       "\<And>x kk. (x, kk) \<in> p \<Longrightarrow> kk \<inter> {x. x\<bullet>k \<le> c} \<noteq> {} \<Longrightarrow> x\<bullet>k \<le> c"
  3501       "\<And>x kk. (x, kk) \<in> p \<Longrightarrow> kk \<inter> {x. x\<bullet>k \<le> c} \<noteq> {} \<Longrightarrow> x\<bullet>k \<le> c"
  3492       "\<And>x kk. (x, kk) \<in> p \<Longrightarrow> kk \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {} \<Longrightarrow> x\<bullet>k \<ge> c"
  3502       "\<And>x kk. (x, kk) \<in> p \<Longrightarrow> kk \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {} \<Longrightarrow> x\<bullet>k \<ge> c"
  3493     proof -
  3503     proof -
  3494       fix x kk
  3504       fix x kk
  3699           apply auto
  3709           apply auto
  3700           done
  3710           done
  3701       qed
  3711       qed
  3702       also note setsum_addf[symmetric]
  3712       also note setsum_addf[symmetric]
  3703       also have *: "\<And>x. x \<in> p \<Longrightarrow>
  3713       also have *: "\<And>x. x \<in> p \<Longrightarrow>
  3704         (\<lambda>(x,ka). content (ka \<inter> {x. x \<bullet> k \<le> c}) *\<^sub>R f x) x + (\<lambda>(x,ka). content (ka \<inter> {x. c \<le> x \<bullet> k}) *\<^sub>R f x) x =
  3714         (\<lambda>(x,ka). content (ka \<inter> {x. x \<bullet> k \<le> c}) *\<^sub>R f x) x +
       
  3715           (\<lambda>(x,ka). content (ka \<inter> {x. c \<le> x \<bullet> k}) *\<^sub>R f x) x =
  3705         (\<lambda>(x,ka). content ka *\<^sub>R f x) x"
  3716         (\<lambda>(x,ka). content ka *\<^sub>R f x) x"
  3706         unfolding split_paired_all split_conv
  3717         unfolding split_paired_all split_conv
  3707       proof -
  3718       proof -
  3708         fix a b
  3719         fix a b
  3709         assume "(a, b) \<in> p"
  3720         assume "(a, b) \<in> p"
  3726 qed
  3737 qed
  3727 
  3738 
  3728 
  3739 
  3729 subsection {* A sort of converse, integrability on subintervals. *}
  3740 subsection {* A sort of converse, integrability on subintervals. *}
  3730 
  3741 
  3731 lemma tagged_division_union_interval: fixes a::"'a::ordered_euclidean_space"
  3742 lemma tagged_division_union_interval:
  3732   assumes "p1 tagged_division_of ({a..b} \<inter> {x. x\<bullet>k \<le> (c::real)})"  "p2 tagged_division_of ({a..b} \<inter> {x. x\<bullet>k \<ge> c})"
  3743   fixes a :: "'a::ordered_euclidean_space"
  3733   and k:"k\<in>Basis"
  3744   assumes "p1 tagged_division_of ({a..b} \<inter> {x. x\<bullet>k \<le> (c::real)})"
       
  3745     and "p2 tagged_division_of ({a..b} \<inter> {x. x\<bullet>k \<ge> c})"
       
  3746     and k: "k \<in> Basis"
  3734   shows "(p1 \<union> p2) tagged_division_of ({a..b})"
  3747   shows "(p1 \<union> p2) tagged_division_of ({a..b})"
  3735 proof- have *:"{a..b} = ({a..b} \<inter> {x. x\<bullet>k \<le> c}) \<union> ({a..b} \<inter> {x. x\<bullet>k \<ge> c})" by auto
  3748 proof -
  3736   show ?thesis apply(subst *) apply(rule tagged_division_union[OF assms(1-2)])
  3749   have *: "{a..b} = ({a..b} \<inter> {x. x\<bullet>k \<le> c}) \<union> ({a..b} \<inter> {x. x\<bullet>k \<ge> c})"
  3737     unfolding interval_split[OF k] interior_closed_interval using k
  3750     by auto
  3738     by(auto simp add: eucl_less[where 'a='a] elim!: ballE[where x=k]) qed
  3751   show ?thesis
  3739 
  3752     apply (subst *)
  3740 lemma has_integral_separate_sides: fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'b::real_normed_vector"
  3753     apply (rule tagged_division_union[OF assms(1-2)])
  3741   assumes "(f has_integral i) ({a..b})" "e>0" and k:"k\<in>Basis"
  3754     unfolding interval_split[OF k] interior_closed_interval
  3742   obtains d where "gauge d" "(\<forall>p1 p2. p1 tagged_division_of ({a..b} \<inter> {x. x\<bullet>k \<le> c}) \<and> d fine p1 \<and>
  3755     using k
  3743                                 p2 tagged_division_of ({a..b} \<inter> {x. x\<bullet>k \<ge> c}) \<and> d fine p2
  3756     apply (auto simp add: eucl_less[where 'a='a] elim!: ballE[where x=k])
  3744                                 \<longrightarrow> norm((setsum (\<lambda>(x,k). content k *\<^sub>R f x) p1 +
  3757     done
  3745                                           setsum (\<lambda>(x,k). content k *\<^sub>R f x) p2) - i) < e)"
  3758 qed
  3746 proof- guess d using has_integralD[OF assms(1-2)] . note d=this
  3759 
  3747   show ?thesis apply(rule that[of d]) apply(rule d) apply(rule,rule,rule,(erule conjE)+)
  3760 lemma has_integral_separate_sides:
  3748   proof- fix p1 p2 assume "p1 tagged_division_of {a..b} \<inter> {x. x \<bullet> k \<le> c}" "d fine p1" note p1=tagged_division_ofD[OF this(1)] this
  3761   fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::real_normed_vector"
  3749                    assume "p2 tagged_division_of {a..b} \<inter> {x. c \<le> x \<bullet> k}" "d fine p2" note p2=tagged_division_ofD[OF this(1)] this
  3762   assumes "(f has_integral i) ({a..b})"
       
  3763     and "e > 0"
       
  3764     and k: "k \<in> Basis"
       
  3765   obtains d where "gauge d"
       
  3766     "\<forall>p1 p2. p1 tagged_division_of ({a..b} \<inter> {x. x\<bullet>k \<le> c}) \<and> d fine p1 \<and>
       
  3767         p2 tagged_division_of ({a..b} \<inter> {x. x\<bullet>k \<ge> c}) \<and> d fine p2 \<longrightarrow>
       
  3768         norm ((setsum (\<lambda>(x,k). content k *\<^sub>R f x) p1 + setsum (\<lambda>(x,k). content k *\<^sub>R f x) p2) - i) < e"
       
  3769 proof -
       
  3770   guess d using has_integralD[OF assms(1-2)] . note d=this
       
  3771   show ?thesis
       
  3772     apply (rule that[of d])
       
  3773     apply (rule d)
       
  3774     apply rule
       
  3775     apply rule
       
  3776     apply rule
       
  3777     apply (elim conjE)
       
  3778   proof -
       
  3779     fix p1 p2
       
  3780     assume "p1 tagged_division_of {a..b} \<inter> {x. x \<bullet> k \<le> c}" "d fine p1"
       
  3781     note p1=tagged_division_ofD[OF this(1)] this
       
  3782     assume "p2 tagged_division_of {a..b} \<inter> {x. c \<le> x \<bullet> k}" "d fine p2"
       
  3783     note p2=tagged_division_ofD[OF this(1)] this
  3750     note tagged_division_union_interval[OF p1(7) p2(7)] note p12 = tagged_division_ofD[OF this] this
  3784     note tagged_division_union_interval[OF p1(7) p2(7)] note p12 = tagged_division_ofD[OF this] this
  3751     have "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x) - i) = norm ((\<Sum>(x, k)\<in>p1 \<union> p2. content k *\<^sub>R f x) - i)"
  3785     have "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x) - i) =
  3752       apply(subst setsum_Un_zero) apply(rule p1 p2)+ apply(rule) unfolding split_paired_all split_conv
  3786       norm ((\<Sum>(x, k)\<in>p1 \<union> p2. content k *\<^sub>R f x) - i)"
  3753     proof- fix a b assume ab:"(a,b) \<in> p1 \<inter> p2"
  3787       apply (subst setsum_Un_zero)
  3754       have "(a,b) \<in> p1" using ab by auto from p1(4)[OF this] guess u v apply-by(erule exE)+ note uv =this
  3788       apply (rule p1 p2)+
  3755       have "b \<subseteq> {x. x\<bullet>k = c}" using ab p1(3)[of a b] p2(3)[of a b] by fastforce
  3789       apply rule
  3756       moreover have "interior {x::'a. x \<bullet> k = c} = {}"
  3790       unfolding split_paired_all split_conv
  3757       proof(rule ccontr) case goal1 then obtain x where x:"x\<in>interior {x::'a. x\<bullet>k = c}" by auto
  3791     proof -
       
  3792       fix a b
       
  3793       assume ab: "(a, b) \<in> p1 \<inter> p2"
       
  3794       have "(a, b) \<in> p1"
       
  3795         using ab by auto
       
  3796       from p1(4)[OF this] guess u v by (elim exE) note uv = this
       
  3797       have "b \<subseteq> {x. x\<bullet>k = c}"
       
  3798         using ab p1(3)[of a b] p2(3)[of a b] by fastforce
       
  3799       moreover
       
  3800       have "interior {x::'a. x \<bullet> k = c} = {}"
       
  3801       proof (rule ccontr)
       
  3802         assume "\<not> ?thesis"
       
  3803         then obtain x where x: "x \<in> interior {x::'a. x\<bullet>k = c}"
       
  3804           by auto
  3758         then guess e unfolding mem_interior .. note e=this
  3805         then guess e unfolding mem_interior .. note e=this
  3759         have x:"x\<bullet>k = c" using x interior_subset by fastforce
  3806         have x: "x\<bullet>k = c"
  3760         have *:"\<And>i. i\<in>Basis \<Longrightarrow> \<bar>(x - (x + (e / 2) *\<^sub>R k)) \<bullet> i\<bar>
  3807           using x interior_subset by fastforce
  3761           = (if i = k then e/2 else 0)" using e k by (auto simp: inner_simps inner_not_same_Basis)
  3808         have *: "\<And>i. i \<in> Basis \<Longrightarrow> \<bar>(x - (x + (e / 2) *\<^sub>R k)) \<bullet> i\<bar> = (if i = k then e/2 else 0)"
       
  3809           using e k by (auto simp: inner_simps inner_not_same_Basis)
  3762         have "(\<Sum>i\<in>Basis. \<bar>(x - (x + (e / 2 ) *\<^sub>R k)) \<bullet> i\<bar>) =
  3810         have "(\<Sum>i\<in>Basis. \<bar>(x - (x + (e / 2 ) *\<^sub>R k)) \<bullet> i\<bar>) =
  3763           (\<Sum>i\<in>Basis. (if i = k then e / 2 else 0))" apply(rule setsum_cong2) apply(subst *) by auto
  3811           (\<Sum>i\<in>Basis. (if i = k then e / 2 else 0))"
  3764         also have "... < e" apply(subst setsum_delta) using e by auto
  3812           apply (rule setsum_cong2)
       
  3813           apply (subst *)
       
  3814           apply auto
       
  3815           done
       
  3816         also have "\<dots> < e"
       
  3817           apply (subst setsum_delta)
       
  3818           using e
       
  3819           apply auto
       
  3820           done
  3765         finally have "x + (e/2) *\<^sub>R k \<in> ball x e"
  3821         finally have "x + (e/2) *\<^sub>R k \<in> ball x e"
  3766           unfolding mem_ball dist_norm by(rule le_less_trans[OF norm_le_l1])
  3822           unfolding mem_ball dist_norm by(rule le_less_trans[OF norm_le_l1])
  3767         hence "x + (e/2) *\<^sub>R k \<in> {x. x\<bullet>k = c}" using e by auto
  3823         then have "x + (e/2) *\<^sub>R k \<in> {x. x\<bullet>k = c}"
  3768         thus False unfolding mem_Collect_eq using e x k by (auto simp: inner_simps)
  3824           using e by auto
  3769       qed ultimately have "content b = 0" unfolding uv content_eq_0_interior apply-apply(drule interior_mono) by auto
  3825         then show False
  3770       thus "content b *\<^sub>R f a = 0" by auto
  3826           unfolding mem_Collect_eq using e x k by (auto simp: inner_simps)
       
  3827       qed
       
  3828       ultimately have "content b = 0"
       
  3829         unfolding uv content_eq_0_interior
       
  3830         apply -
       
  3831         apply (drule interior_mono)
       
  3832         apply auto
       
  3833         done
       
  3834       then show "content b *\<^sub>R f a = 0"
       
  3835         by auto
  3771     qed auto
  3836     qed auto
  3772     also have "\<dots> < e" by(rule k d(2) p12 fine_union p1 p2)+
  3837     also have "\<dots> < e"
  3773     finally show "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x) - i) < e" . qed qed
  3838       by (rule k d(2) p12 fine_union p1 p2)+
       
  3839     finally show "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) + (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x) - i) < e" .
       
  3840   qed
       
  3841 qed
  3774 
  3842 
  3775 lemma integrable_split[intro]:
  3843 lemma integrable_split[intro]:
  3776   fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'b::{real_normed_vector,complete_space}"
  3844   fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::{real_normed_vector,complete_space}"
  3777   assumes "f integrable_on {a..b}" and k:"k\<in>Basis"
  3845   assumes "f integrable_on {a..b}"
  3778   shows "f integrable_on ({a..b} \<inter> {x. x\<bullet>k \<le> c})" (is ?t1) and "f integrable_on ({a..b} \<inter> {x. x\<bullet>k \<ge> c})" (is ?t2)
  3846     and k: "k \<in> Basis"
  3779 proof- guess y using assms(1) unfolding integrable_on_def .. note y=this
  3847   shows "f integrable_on ({a..b} \<inter> {x. x\<bullet>k \<le> c})" (is ?t1)
       
  3848     and "f integrable_on ({a..b} \<inter> {x. x\<bullet>k \<ge> c})" (is ?t2)
       
  3849 proof -
       
  3850   guess y using assms(1) unfolding integrable_on_def .. note y=this
  3780   def b' \<equiv> "\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) c else b\<bullet>i)*\<^sub>R i::'a"
  3851   def b' \<equiv> "\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) c else b\<bullet>i)*\<^sub>R i::'a"
  3781   def a' \<equiv> "\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) c else a\<bullet>i)*\<^sub>R i::'a"
  3852   def a' \<equiv> "\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) c else a\<bullet>i)*\<^sub>R i::'a"
  3782   show ?t1 ?t2 unfolding interval_split[OF k] integrable_cauchy unfolding interval_split[symmetric,OF k]
  3853   show ?t1 ?t2
  3783   proof(rule_tac[!] allI impI)+ fix e::real assume "e>0" hence "e/2>0" by auto
  3854     unfolding interval_split[OF k] integrable_cauchy
       
  3855     unfolding interval_split[symmetric,OF k]
       
  3856   proof (rule_tac[!] allI impI)+
       
  3857     fix e :: real
       
  3858     assume "e > 0"
       
  3859     then have "e/2>0"
       
  3860       by auto
  3784     from has_integral_separate_sides[OF y this k,of c] guess d . note d=this[rule_format]
  3861     from has_integral_separate_sides[OF y this k,of c] guess d . note d=this[rule_format]
  3785     let ?P = "\<lambda>A. \<exists>d. gauge d \<and> (\<forall>p1 p2. p1 tagged_division_of {a..b} \<inter> A \<and> d fine p1
  3862     let ?P = "\<lambda>A. \<exists>d. gauge d \<and> (\<forall>p1 p2. p1 tagged_division_of {a..b} \<inter> A \<and> d fine p1 \<and>
  3786       \<and> p2 tagged_division_of {a..b} \<inter> A \<and> d fine p2 \<longrightarrow>
  3863       p2 tagged_division_of {a..b} \<inter> A \<and> d fine p2 \<longrightarrow>
  3787       norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e)"
  3864       norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e)"
  3788     show "?P {x. x \<bullet> k \<le> c}" apply(rule_tac x=d in exI) apply(rule,rule d) apply(rule,rule,rule)
  3865     show "?P {x. x \<bullet> k \<le> c}"
  3789     proof- fix p1 p2 assume as:"p1 tagged_division_of {a..b} \<inter> {x. x \<bullet> k \<le> c} \<and> d fine p1
  3866       apply (rule_tac x=d in exI)
  3790         \<and> p2 tagged_division_of {a..b} \<inter> {x. x \<bullet> k \<le> c} \<and> d fine p2"
  3867       apply rule
       
  3868       apply (rule d)
       
  3869       apply rule
       
  3870       apply rule
       
  3871       apply rule
       
  3872     proof -
       
  3873       fix p1 p2
       
  3874       assume as: "p1 tagged_division_of {a..b} \<inter> {x. x \<bullet> k \<le> c} \<and> d fine p1 \<and>
       
  3875         p2 tagged_division_of {a..b} \<inter> {x. x \<bullet> k \<le> c} \<and> d fine p2"
  3791       show "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e"
  3876       show "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e"
  3792       proof- guess p using fine_division_exists[OF d(1), of a' b] . note p=this
  3877       proof -
  3793         show ?thesis using norm_triangle_half_l[OF d(2)[of p1 p] d(2)[of p2 p]]
  3878         guess p using fine_division_exists[OF d(1), of a' b] . note p=this
       
  3879         show ?thesis
       
  3880           using norm_triangle_half_l[OF d(2)[of p1 p] d(2)[of p2 p]]
  3794           using as unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
  3881           using as unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
  3795           using p using assms by(auto simp add:algebra_simps)
  3882           using p using assms
  3796       qed qed
  3883           by (auto simp add: algebra_simps)
  3797     show "?P {x. x \<bullet> k \<ge> c}" apply(rule_tac x=d in exI) apply(rule,rule d) apply(rule,rule,rule)
  3884       qed
  3798     proof- fix p1 p2 assume as:"p1 tagged_division_of {a..b} \<inter> {x. x \<bullet> k \<ge> c} \<and> d fine p1
  3885     qed
  3799         \<and> p2 tagged_division_of {a..b} \<inter> {x. x \<bullet> k \<ge> c} \<and> d fine p2"
  3886     show "?P {x. x \<bullet> k \<ge> c}"
       
  3887       apply (rule_tac x=d in exI)
       
  3888       apply rule
       
  3889       apply (rule d)
       
  3890       apply rule
       
  3891       apply rule
       
  3892       apply rule
       
  3893     proof -
       
  3894       fix p1 p2
       
  3895       assume as: "p1 tagged_division_of {a..b} \<inter> {x. x \<bullet> k \<ge> c} \<and> d fine p1 \<and>
       
  3896         p2 tagged_division_of {a..b} \<inter> {x. x \<bullet> k \<ge> c} \<and> d fine p2"
  3800       show "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e"
  3897       show "norm ((\<Sum>(x, k)\<in>p1. content k *\<^sub>R f x) - (\<Sum>(x, k)\<in>p2. content k *\<^sub>R f x)) < e"
  3801       proof- guess p using fine_division_exists[OF d(1), of a b'] . note p=this
  3898       proof -
  3802         show ?thesis using norm_triangle_half_l[OF d(2)[of p p1] d(2)[of p p2]]
  3899         guess p using fine_division_exists[OF d(1), of a b'] . note p=this
  3803           using as unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
  3900         show ?thesis
  3804           using p using assms by(auto simp add:algebra_simps) qed qed qed qed
  3901           using norm_triangle_half_l[OF d(2)[of p p1] d(2)[of p p2]]
       
  3902           using as
       
  3903           unfolding interval_split[OF k] b'_def[symmetric] a'_def[symmetric]
       
  3904           using p
       
  3905           using assms
       
  3906           by (auto simp add:algebra_simps)
       
  3907       qed
       
  3908     qed
       
  3909   qed
       
  3910 qed
       
  3911 
  3805 
  3912 
  3806 subsection {* Generalized notion of additivity. *}
  3913 subsection {* Generalized notion of additivity. *}
  3807 
  3914 
  3808 definition "neutral opp = (SOME x. \<forall>y. opp x y = y \<and> opp y x = y)"
  3915 definition "neutral opp = (SOME x. \<forall>y. opp x y = y \<and> opp y x = y)"
  3809 
  3916 
  3810 definition operative :: "('a \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> (('b::ordered_euclidean_space) set \<Rightarrow> 'a) \<Rightarrow> bool" where
  3917 definition operative :: "('a \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> (('b::ordered_euclidean_space) set \<Rightarrow> 'a) \<Rightarrow> bool"
  3811   "operative opp f \<equiv>
  3918   where "operative opp f \<longleftrightarrow>
  3812     (\<forall>a b. content {a..b} = 0 \<longrightarrow> f {a..b} = neutral(opp)) \<and>
  3919     (\<forall>a b. content {a..b} = 0 \<longrightarrow> f {a..b} = neutral opp) \<and>
  3813     (\<forall>a b c. \<forall>k\<in>Basis. f({a..b}) =
  3920     (\<forall>a b c. \<forall>k\<in>Basis. f {a..b} = opp (f({a..b} \<inter> {x. x\<bullet>k \<le> c})) (f ({a..b} \<inter> {x. x\<bullet>k \<ge> c})))"
  3814                    opp (f({a..b} \<inter> {x. x\<bullet>k \<le> c}))
  3921 
  3815                        (f({a..b} \<inter> {x. x\<bullet>k \<ge> c})))"
  3922 lemma operativeD[dest]:
  3816 
  3923   fixes type :: "'a::ordered_euclidean_space"
  3817 lemma operativeD[dest]: fixes type::"'a::ordered_euclidean_space"  assumes "operative opp f"
  3924   assumes "operative opp f"
  3818   shows "\<And>a b. content {a..b} = 0 \<Longrightarrow> f {a..b::'a} = neutral(opp)"
  3925   shows "\<And>a b::'a. content {a..b} = 0 \<Longrightarrow> f {a..b} = neutral opp"
  3819   "\<And>a b c k. k\<in>Basis \<Longrightarrow> f({a..b}) = opp (f({a..b} \<inter> {x. x\<bullet>k \<le> c})) (f({a..b} \<inter> {x. x\<bullet>k \<ge> c}))"
  3926     and "\<And>a b c k. k \<in> Basis \<Longrightarrow> f {a..b} =
       
  3927       opp (f ({a..b} \<inter> {x. x\<bullet>k \<le> c})) (f ({a..b} \<inter> {x. x\<bullet>k \<ge> c}))"
  3820   using assms unfolding operative_def by auto
  3928   using assms unfolding operative_def by auto
  3821 
  3929 
  3822 lemma operative_trivial:
  3930 lemma operative_trivial: "operative opp f \<Longrightarrow> content({a..b}) = 0 \<Longrightarrow> f({a..b}) = neutral opp"
  3823  "operative opp f \<Longrightarrow> content({a..b}) = 0 \<Longrightarrow> f({a..b}) = neutral opp"
       
  3824   unfolding operative_def by auto
  3931   unfolding operative_def by auto
  3825 
  3932 
  3826 lemma property_empty_interval:
  3933 lemma property_empty_interval: "\<forall>a b. content {a..b} = 0 \<longrightarrow> P {a..b} \<Longrightarrow> P {}"
  3827  "(\<forall>a b. content({a..b}) = 0 \<longrightarrow> P({a..b})) \<Longrightarrow> P {}"
       
  3828   using content_empty unfolding empty_as_interval by auto
  3934   using content_empty unfolding empty_as_interval by auto
  3829 
  3935 
  3830 lemma operative_empty: "operative opp f \<Longrightarrow> f {} = neutral opp"
  3936 lemma operative_empty: "operative opp f \<Longrightarrow> f {} = neutral opp"
  3831   unfolding operative_def apply(rule property_empty_interval) by auto
  3937   unfolding operative_def by (rule property_empty_interval) auto
       
  3938 
  3832 
  3939 
  3833 subsection {* Using additivity of lifted function to encode definedness. *}
  3940 subsection {* Using additivity of lifted function to encode definedness. *}
  3834 
  3941 
  3835 lemma forall_option: "(\<forall>x. P x) \<longleftrightarrow> P None \<and> (\<forall>x. P(Some x))"
  3942 lemma forall_option: "(\<forall>x. P x) \<longleftrightarrow> P None \<and> (\<forall>x. P (Some x))"
  3836   by (metis option.nchotomy)
  3943   by (metis option.nchotomy)
  3837 
  3944 
  3838 lemma exists_option: "(\<exists>x. P x) \<longleftrightarrow> P None \<or> (\<exists>x. P(Some x))"
  3945 lemma exists_option: "(\<exists>x. P x) \<longleftrightarrow> P None \<or> (\<exists>x. P (Some x))"
  3839   by (metis option.nchotomy)
  3946   by (metis option.nchotomy)
  3840 
  3947 
  3841 fun lifted
  3948 fun lifted where
  3842 where
  3949   "lifted (opp :: 'a \<Rightarrow> 'a \<Rightarrow> 'b) (Some x) (Some y) = Some (opp x y)"
  3843   "lifted (opp::'a\<Rightarrow>'a\<Rightarrow>'b) (Some x) (Some y) = Some (opp x y)"
       
  3844 | "lifted opp None _ = (None::'b option)"
  3950 | "lifted opp None _ = (None::'b option)"
  3845 | "lifted opp _ None = None"
  3951 | "lifted opp _ None = None"
  3846 
  3952 
  3847 lemma lifted_simp_1[simp]: "lifted opp v None = None"
  3953 lemma lifted_simp_1[simp]: "lifted opp v None = None"
  3848   by (induct v) auto
  3954   by (induct v) auto
  3849 
  3955 
  3850 definition "monoidal opp \<equiv>  (\<forall>x y. opp x y = opp y x) \<and>
  3956 definition "monoidal opp \<longleftrightarrow>
  3851                    (\<forall>x y z. opp x (opp y z) = opp (opp x y) z) \<and>
  3957   (\<forall>x y. opp x y = opp y x) \<and>
  3852                    (\<forall>x. opp (neutral opp) x = x)"
  3958   (\<forall>x y z. opp x (opp y z) = opp (opp x y) z) \<and>
       
  3959   (\<forall>x. opp (neutral opp) x = x)"
  3853 
  3960 
  3854 lemma monoidalI:
  3961 lemma monoidalI:
  3855   assumes "\<And>x y. opp x y = opp y x"
  3962   assumes "\<And>x y. opp x y = opp y x"
  3856   "\<And>x y z. opp x (opp y z) = opp (opp x y) z"
  3963     and "\<And>x y z. opp x (opp y z) = opp (opp x y) z"
  3857   "\<And>x. opp (neutral opp) x = x" shows "monoidal opp"
  3964     and "\<And>x. opp (neutral opp) x = x"
       
  3965   shows "monoidal opp"
  3858   unfolding monoidal_def using assms by fastforce
  3966   unfolding monoidal_def using assms by fastforce
  3859 
  3967 
  3860 lemma monoidal_ac:
  3968 lemma monoidal_ac:
  3861   assumes "monoidal opp"
  3969   assumes "monoidal opp"
  3862   shows "opp (neutral opp) a = a" "opp a (neutral opp) = a" "opp a b = opp b a"
  3970   shows "opp (neutral opp) a = a"
  3863   "opp (opp a b) c = opp a (opp b c)"  "opp a (opp b c) = opp b (opp a c)"
  3971     and "opp a (neutral opp) = a"
       
  3972     and "opp a b = opp b a"
       
  3973     and "opp (opp a b) c = opp a (opp b c)"
       
  3974     and "opp a (opp b c) = opp b (opp a c)"
  3864   using assms unfolding monoidal_def by metis+
  3975   using assms unfolding monoidal_def by metis+
  3865 
  3976 
  3866 lemma monoidal_simps[simp]: assumes "monoidal opp"
  3977 lemma monoidal_simps[simp]:
  3867   shows "opp (neutral opp) a = a" "opp a (neutral opp) = a"
  3978   assumes "monoidal opp"
       
  3979   shows "opp (neutral opp) a = a"
       
  3980     and "opp a (neutral opp) = a"
  3868   using monoidal_ac[OF assms] by auto
  3981   using monoidal_ac[OF assms] by auto
  3869 
  3982 
  3870 lemma neutral_lifted[cong]: assumes "monoidal opp"
  3983 lemma neutral_lifted[cong]:
  3871   shows "neutral (lifted opp) = Some(neutral opp)"
  3984   assumes "monoidal opp"
  3872   apply(subst neutral_def) apply(rule some_equality) apply(rule,induct_tac y) prefer 3
  3985   shows "neutral (lifted opp) = Some (neutral opp)"
       
  3986   apply (subst neutral_def)
       
  3987   apply (rule some_equality)
       
  3988   apply rule
       
  3989   apply (induct_tac y)
       
  3990   prefer 3
  3873 proof -
  3991 proof -
  3874   fix x assume "\<forall>y. lifted opp x y = y \<and> lifted opp y x = y"
  3992   fix x
  3875   thus "x = Some (neutral opp)"
  3993   assume "\<forall>y. lifted opp x y = y \<and> lifted opp y x = y"
  3876     apply(induct x) defer
  3994   then show "x = Some (neutral opp)"
  3877     apply rule apply(subst neutral_def) apply(subst eq_commute,rule some_equality)
  3995     apply (induct x)
  3878     apply(rule,erule_tac x="Some y" in allE) defer apply(erule_tac x="Some x" in allE)
  3996     defer
       
  3997     apply rule
       
  3998     apply (subst neutral_def)
       
  3999     apply (subst eq_commute)
       
  4000     apply(rule some_equality)
       
  4001     apply rule
       
  4002     apply (erule_tac x="Some y" in allE)
       
  4003     defer
       
  4004     apply (erule_tac x="Some x" in allE)
  3879     apply auto
  4005     apply auto
  3880     done
  4006     done
  3881 qed(auto simp add:monoidal_ac[OF assms])
  4007 qed (auto simp add:monoidal_ac[OF assms])
  3882 
  4008 
  3883 lemma monoidal_lifted[intro]: assumes "monoidal opp" shows "monoidal(lifted opp)"
  4009 lemma monoidal_lifted[intro]:
  3884   unfolding monoidal_def forall_option neutral_lifted[OF assms] using monoidal_ac[OF assms] by auto
  4010   assumes "monoidal opp"
       
  4011   shows "monoidal (lifted opp)"
       
  4012   unfolding monoidal_def forall_option neutral_lifted[OF assms]
       
  4013   using monoidal_ac[OF assms]
       
  4014   by auto
  3885 
  4015 
  3886 definition "support opp f s = {x. x\<in>s \<and> f x \<noteq> neutral opp}"
  4016 definition "support opp f s = {x. x\<in>s \<and> f x \<noteq> neutral opp}"
  3887 definition "fold' opp e s \<equiv> (if finite s then Finite_Set.fold opp e s else e)"
  4017 definition "fold' opp e s = (if finite s then Finite_Set.fold opp e s else e)"
  3888 definition "iterate opp s f \<equiv> fold' (\<lambda>x a. opp (f x) a) (neutral opp) (support opp f s)"
  4018 definition "iterate opp s f = fold' (\<lambda>x a. opp (f x) a) (neutral opp) (support opp f s)"
  3889 
  4019 
  3890 lemma support_subset[intro]:"support opp f s \<subseteq> s" unfolding support_def by auto
  4020 lemma support_subset[intro]: "support opp f s \<subseteq> s"
  3891 lemma support_empty[simp]:"support opp f {} = {}" using support_subset[of opp f "{}"] by auto
  4021   unfolding support_def by auto
  3892 
  4022 
  3893 lemma comp_fun_commute_monoidal[intro]: assumes "monoidal opp" shows "comp_fun_commute opp"
  4023 lemma support_empty[simp]: "support opp f {} = {}"
  3894   unfolding comp_fun_commute_def using monoidal_ac[OF assms] by auto
  4024   using support_subset[of opp f "{}"] by auto
       
  4025 
       
  4026 lemma comp_fun_commute_monoidal[intro]:
       
  4027   assumes "monoidal opp"
       
  4028   shows "comp_fun_commute opp"
       
  4029   unfolding comp_fun_commute_def
       
  4030   using monoidal_ac[OF assms]
       
  4031   by auto
  3895 
  4032 
  3896 lemma support_clauses:
  4033 lemma support_clauses:
  3897   "\<And>f g s. support opp f {} = {}"
  4034   "\<And>f g s. support opp f {} = {}"
  3898   "\<And>f g s. support opp f (insert x s) =
  4035   "\<And>f g s. support opp f (insert x s) =
  3899     (if f(x) = neutral opp then support opp f s else insert x (support opp f s))"
  4036     (if f(x) = neutral opp then support opp f s else insert x (support opp f s))"
  3900   "\<And>f g s. support opp f (s - {x}) = (support opp f s) - {x}"
  4037   "\<And>f g s. support opp f (s - {x}) = (support opp f s) - {x}"
  3901   "\<And>f g s. support opp f (s \<union> t) = (support opp f s) \<union> (support opp f t)"
  4038   "\<And>f g s. support opp f (s \<union> t) = (support opp f s) \<union> (support opp f t)"
  3902   "\<And>f g s. support opp f (s \<inter> t) = (support opp f s) \<inter> (support opp f t)"
  4039   "\<And>f g s. support opp f (s \<inter> t) = (support opp f s) \<inter> (support opp f t)"
  3903   "\<And>f g s. support opp f (s - t) = (support opp f s) - (support opp f t)"
  4040   "\<And>f g s. support opp f (s - t) = (support opp f s) - (support opp f t)"
  3904   "\<And>f g s. support opp g (f ` s) = f ` (support opp (g o f) s)"
  4041   "\<And>f g s. support opp g (f ` s) = f ` (support opp (g o f) s)"
  3905 unfolding support_def by auto
       
  3906 
       
  3907 lemma finite_support[intro]:"finite s \<Longrightarrow> finite (support opp f s)"
       
  3908   unfolding support_def by auto
  4042   unfolding support_def by auto
  3909 
  4043 
  3910 lemma iterate_empty[simp]:"iterate opp {} f = neutral opp"
  4044 lemma finite_support[intro]: "finite s \<Longrightarrow> finite (support opp f s)"
       
  4045   unfolding support_def by auto
       
  4046 
       
  4047 lemma iterate_empty[simp]: "iterate opp {} f = neutral opp"
  3911   unfolding iterate_def fold'_def by auto
  4048   unfolding iterate_def fold'_def by auto
  3912 
  4049 
  3913 lemma iterate_insert[simp]: assumes "monoidal opp" "finite s"
  4050 lemma iterate_insert[simp]:
  3914   shows "iterate opp (insert x s) f = (if x \<in> s then iterate opp s f else opp (f x) (iterate opp s f))"
  4051   assumes "monoidal opp"
  3915 proof(cases "x\<in>s") case True hence *:"insert x s = s" by auto
  4052     and "finite s"
       
  4053   shows "iterate opp (insert x s) f =
       
  4054     (if x \<in> s then iterate opp s f else opp (f x) (iterate opp s f))"
       
  4055 proof (cases "x \<in> s")
       
  4056   case True
       
  4057   then have *: "insert x s = s"
       
  4058     by auto
  3916   show ?thesis unfolding iterate_def if_P[OF True] * by auto
  4059   show ?thesis unfolding iterate_def if_P[OF True] * by auto
  3917 next case False note x=this
  4060 next
       
  4061   case False
       
  4062   note x = this
  3918   note * = comp_fun_commute.comp_comp_fun_commute [OF comp_fun_commute_monoidal[OF assms(1)]]
  4063   note * = comp_fun_commute.comp_comp_fun_commute [OF comp_fun_commute_monoidal[OF assms(1)]]
  3919   show ?thesis proof(cases "f x = neutral opp")
  4064   show ?thesis
  3920     case True show ?thesis unfolding iterate_def if_not_P[OF x] support_clauses if_P[OF True]
  4065   proof (cases "f x = neutral opp")
  3921       unfolding True monoidal_simps[OF assms(1)] by auto
  4066     case True
  3922   next case False show ?thesis unfolding iterate_def fold'_def  if_not_P[OF x] support_clauses if_not_P[OF False]
  4067     show ?thesis
  3923       apply(subst comp_fun_commute.fold_insert[OF * finite_support, simplified comp_def])
  4068       unfolding iterate_def if_not_P[OF x] support_clauses if_P[OF True]
  3924       using `finite s` unfolding support_def using False x by auto qed qed
  4069       unfolding True monoidal_simps[OF assms(1)]
       
  4070       by auto
       
  4071   next
       
  4072     case False
       
  4073     show ?thesis
       
  4074       unfolding iterate_def fold'_def  if_not_P[OF x] support_clauses if_not_P[OF False]
       
  4075       apply (subst comp_fun_commute.fold_insert[OF * finite_support, simplified comp_def])
       
  4076       using `finite s`
       
  4077       unfolding support_def
       
  4078       using False x
       
  4079       apply auto
       
  4080       done
       
  4081   qed
       
  4082 qed
  3925 
  4083 
  3926 lemma iterate_some:
  4084 lemma iterate_some:
  3927   assumes "monoidal opp"  "finite s"
  4085   assumes "monoidal opp"
  3928   shows "iterate (lifted opp) s (\<lambda>x. Some(f x)) = Some (iterate opp s f)" using assms(2)
  4086     and "finite s"
  3929 proof(induct s) case empty thus ?case using assms by auto
  4087   shows "iterate (lifted opp) s (\<lambda>x. Some(f x)) = Some (iterate opp s f)"
  3930 next case (insert x F) show ?case apply(subst iterate_insert) prefer 3 apply(subst if_not_P)
  4088   using assms(2)
  3931     defer unfolding insert(3) lifted.simps apply rule using assms insert by auto qed
  4089 proof (induct s)
       
  4090   case empty
       
  4091   then show ?case
       
  4092     using assms by auto
       
  4093 next
       
  4094   case (insert x F)
       
  4095   show ?case
       
  4096     apply (subst iterate_insert)
       
  4097     prefer 3
       
  4098     apply (subst if_not_P)
       
  4099     defer
       
  4100     unfolding insert(3) lifted.simps
       
  4101     apply rule
       
  4102     using assms insert
       
  4103     apply auto
       
  4104     done
       
  4105 qed
       
  4106 
       
  4107 
  3932 subsection {* Two key instances of additivity. *}
  4108 subsection {* Two key instances of additivity. *}
  3933 
  4109 
  3934 lemma neutral_add[simp]:
  4110 lemma neutral_add[simp]: "neutral op + = (0::'a::comm_monoid_add)"
  3935   "neutral op + = (0::_::comm_monoid_add)" unfolding neutral_def
  4111   unfolding neutral_def
  3936   apply(rule some_equality) defer apply(erule_tac x=0 in allE) by auto
  4112   apply (rule some_equality)
       
  4113   defer
       
  4114   apply (erule_tac x=0 in allE)
       
  4115   apply auto
       
  4116   done
  3937 
  4117 
  3938 lemma operative_content[intro]: "operative (op +) content"
  4118 lemma operative_content[intro]: "operative (op +) content"
  3939   unfolding operative_def neutral_add apply safe
  4119   unfolding operative_def neutral_add
  3940   unfolding content_split[symmetric] ..
  4120   apply safe
       
  4121   unfolding content_split[symmetric]
       
  4122   apply rule
       
  4123   done
  3941 
  4124 
  3942 lemma neutral_monoid: "neutral ((op +)::('a::comm_monoid_add) \<Rightarrow> 'a \<Rightarrow> 'a) = 0"
  4125 lemma neutral_monoid: "neutral ((op +)::('a::comm_monoid_add) \<Rightarrow> 'a \<Rightarrow> 'a) = 0"
  3943   by (rule neutral_add) (* FIXME: duplicate *)
  4126   by (rule neutral_add) (* FIXME: duplicate *)
  3944 
  4127 
  3945 lemma monoidal_monoid[intro]:
  4128 lemma monoidal_monoid[intro]: "monoidal ((op +)::('a::comm_monoid_add) \<Rightarrow> 'a \<Rightarrow> 'a)"
  3946   shows "monoidal ((op +)::('a::comm_monoid_add) \<Rightarrow> 'a \<Rightarrow> 'a)"
  4129   unfolding monoidal_def neutral_monoid
  3947   unfolding monoidal_def neutral_monoid by(auto simp add: algebra_simps)
  4130   by (auto simp add: algebra_simps)
  3948 
  4131 
  3949 lemma operative_integral: fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'b::banach"
  4132 lemma operative_integral:
       
  4133   fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::banach"
  3950   shows "operative (lifted(op +)) (\<lambda>i. if f integrable_on i then Some(integral i f) else None)"
  4134   shows "operative (lifted(op +)) (\<lambda>i. if f integrable_on i then Some(integral i f) else None)"
  3951   unfolding operative_def unfolding neutral_lifted[OF monoidal_monoid] neutral_add
  4135   unfolding operative_def
  3952   apply(rule,rule,rule,rule) defer apply(rule allI ballI)+
  4136   unfolding neutral_lifted[OF monoidal_monoid] neutral_add
  3953 proof-
  4137   apply rule
  3954   fix a b c and k :: 'a assume k:"k\<in>Basis"
  4138   apply rule
       
  4139   apply rule
       
  4140   apply rule
       
  4141   defer
       
  4142   apply (rule allI ballI)+
       
  4143 proof -
       
  4144   fix a b c
       
  4145   fix k :: 'a
       
  4146   assume k: "k \<in> Basis"
  3955   show "(if f integrable_on {a..b} then Some (integral {a..b} f) else None) =
  4147   show "(if f integrable_on {a..b} then Some (integral {a..b} f) else None) =
  3956     lifted op + (if f integrable_on {a..b} \<inter> {x. x \<bullet> k \<le> c} then Some (integral ({a..b} \<inter> {x. x \<bullet> k \<le> c}) f) else None)
  4148     lifted op + (if f integrable_on {a..b} \<inter> {x. x \<bullet> k \<le> c} then Some (integral ({a..b} \<inter> {x. x \<bullet> k \<le> c}) f) else None)
  3957     (if f integrable_on {a..b} \<inter> {x. c \<le> x \<bullet> k} then Some (integral ({a..b} \<inter> {x. c \<le> x \<bullet> k}) f) else None)"
  4149     (if f integrable_on {a..b} \<inter> {x. c \<le> x \<bullet> k} then Some (integral ({a..b} \<inter> {x. c \<le> x \<bullet> k}) f) else None)"
  3958   proof(cases "f integrable_on {a..b}")
  4150   proof (cases "f integrable_on {a..b}")
  3959     case True show ?thesis unfolding if_P[OF True] using k apply-
  4151     case True
  3960       unfolding if_P[OF integrable_split(1)[OF True]] unfolding if_P[OF integrable_split(2)[OF True]]
  4152     show ?thesis
  3961       unfolding lifted.simps option.inject apply(rule integral_unique) apply(rule has_integral_split[OF _ _ k])
  4153       unfolding if_P[OF True]
  3962       apply(rule_tac[!] integrable_integral integrable_split)+ using True k by auto
  4154       using k
  3963   next case False have "(\<not> (f integrable_on {a..b} \<inter> {x. x \<bullet> k \<le> c})) \<or> (\<not> ( f integrable_on {a..b} \<inter> {x. c \<le> x \<bullet> k}))"
  4155       apply -
  3964     proof(rule ccontr) case goal1 hence "f integrable_on {a..b}" apply- unfolding integrable_on_def
  4156       unfolding if_P[OF integrable_split(1)[OF True]]
  3965         apply(rule_tac x="integral ({a..b} \<inter> {x. x \<bullet> k \<le> c}) f + integral ({a..b} \<inter> {x. x \<bullet> k \<ge> c}) f" in exI)
  4157       unfolding if_P[OF integrable_split(2)[OF True]]
  3966         apply(rule has_integral_split[OF _ _ k]) apply(rule_tac[!] integrable_integral) by auto
  4158       unfolding lifted.simps option.inject
  3967       thus False using False by auto
  4159       apply (rule integral_unique)
  3968     qed thus ?thesis using False by auto
  4160       apply (rule has_integral_split[OF _ _ k])
  3969   qed next
  4161       apply (rule_tac[!] integrable_integral integrable_split)+
  3970   fix a b assume as:"content {a..b::'a} = 0"
  4162       using True k
  3971   thus "(if f integrable_on {a..b} then Some (integral {a..b} f) else None) = Some 0"
  4163       apply auto
  3972     unfolding if_P[OF integrable_on_null[OF as]] using has_integral_null_eq[OF as] by auto qed
  4164       done
       
  4165   next
       
  4166     case False
       
  4167     have "\<not> (f integrable_on {a..b} \<inter> {x. x \<bullet> k \<le> c}) \<or> \<not> ( f integrable_on {a..b} \<inter> {x. c \<le> x \<bullet> k})"
       
  4168     proof (rule ccontr)
       
  4169       assume "\<not> ?thesis"
       
  4170       then have "f integrable_on {a..b}"
       
  4171         apply -
       
  4172         unfolding integrable_on_def
       
  4173         apply (rule_tac x="integral ({a..b} \<inter> {x. x \<bullet> k \<le> c}) f + integral ({a..b} \<inter> {x. x \<bullet> k \<ge> c}) f" in exI)
       
  4174         apply (rule has_integral_split[OF _ _ k])
       
  4175         apply (rule_tac[!] integrable_integral)
       
  4176         apply auto
       
  4177         done
       
  4178       then show False
       
  4179         using False by auto
       
  4180     qed
       
  4181     then show ?thesis
       
  4182       using False by auto
       
  4183   qed
       
  4184 next
       
  4185   fix a b :: 'a
       
  4186   assume as: "content {a..b} = 0"
       
  4187   then show "(if f integrable_on {a..b} then Some (integral {a..b} f) else None) = Some 0"
       
  4188     unfolding if_P[OF integrable_on_null[OF as]]
       
  4189     using has_integral_null_eq[OF as]
       
  4190     by auto
       
  4191 qed
       
  4192 
  3973 
  4193 
  3974 subsection {* Points of division of a partition. *}
  4194 subsection {* Points of division of a partition. *}
  3975 
  4195 
  3976 definition "division_points (k::('a::ordered_euclidean_space) set) d =
  4196 definition "division_points (k::('a::ordered_euclidean_space) set) d =
  3977     {(j,x). j\<in>Basis \<and> (interval_lowerbound k)\<bullet>j < x \<and> x < (interval_upperbound k)\<bullet>j \<and>
  4197   {(j,x). j \<in> Basis \<and> (interval_lowerbound k)\<bullet>j < x \<and> x < (interval_upperbound k)\<bullet>j \<and>
  3978            (\<exists>i\<in>d. (interval_lowerbound i)\<bullet>j = x \<or> (interval_upperbound i)\<bullet>j = x)}"
  4198     (\<exists>i\<in>d. (interval_lowerbound i)\<bullet>j = x \<or> (interval_upperbound i)\<bullet>j = x)}"
  3979 
  4199 
  3980 lemma division_points_finite: fixes i::"('a::ordered_euclidean_space) set"
  4200 lemma division_points_finite:
  3981   assumes "d division_of i" shows "finite (division_points i d)"
  4201   fixes i :: "'a::ordered_euclidean_space set"
  3982 proof- note assm = division_ofD[OF assms]
  4202   assumes "d division_of i"
       
  4203   shows "finite (division_points i d)"
       
  4204 proof -
       
  4205   note assm = division_ofD[OF assms]
  3983   let ?M = "\<lambda>j. {(j,x)|x. (interval_lowerbound i)\<bullet>j < x \<and> x < (interval_upperbound i)\<bullet>j \<and>
  4206   let ?M = "\<lambda>j. {(j,x)|x. (interval_lowerbound i)\<bullet>j < x \<and> x < (interval_upperbound i)\<bullet>j \<and>
  3984            (\<exists>i\<in>d. (interval_lowerbound i)\<bullet>j = x \<or> (interval_upperbound i)\<bullet>j = x)}"
  4207     (\<exists>i\<in>d. (interval_lowerbound i)\<bullet>j = x \<or> (interval_upperbound i)\<bullet>j = x)}"
  3985   have *:"division_points i d = \<Union>(?M ` Basis)"
  4208   have *: "division_points i d = \<Union>(?M ` Basis)"
  3986     unfolding division_points_def by auto
  4209     unfolding division_points_def by auto
  3987   show ?thesis unfolding * using assm by auto qed
  4210   show ?thesis
  3988 
  4211     unfolding * using assm by auto
  3989 lemma division_points_subset: fixes a::"'a::ordered_euclidean_space"
  4212 qed
  3990   assumes "d division_of {a..b}" "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"  "a\<bullet>k < c" "c < b\<bullet>k" and k:"k\<in>Basis"
  4213 
  3991   shows "division_points ({a..b} \<inter> {x. x\<bullet>k \<le> c}) {l \<inter> {x. x\<bullet>k \<le> c} | l . l \<in> d \<and> ~(l \<inter> {x. x\<bullet>k \<le> c} = {})}
  4214 lemma division_points_subset:
  3992                   \<subseteq> division_points ({a..b}) d" (is ?t1) and
  4215   fixes a :: "'a::ordered_euclidean_space"
  3993         "division_points ({a..b} \<inter> {x. x\<bullet>k \<ge> c}) {l \<inter> {x. x\<bullet>k \<ge> c} | l . l \<in> d \<and> ~(l \<inter> {x. x\<bullet>k \<ge> c} = {})}
  4216   assumes "d division_of {a..b}"
  3994                   \<subseteq> division_points ({a..b}) d" (is ?t2)
  4217     and "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"  "a\<bullet>k < c" "c < b\<bullet>k"
  3995 proof- note assm = division_ofD[OF assms(1)]
  4218     and k: "k \<in> Basis"
  3996   have *:"\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
  4219   shows "division_points ({a..b} \<inter> {x. x\<bullet>k \<le> c}) {l \<inter> {x. x\<bullet>k \<le> c} | l . l \<in> d \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}} \<subseteq>
       
  4220       division_points ({a..b}) d" (is ?t1)
       
  4221     and "division_points ({a..b} \<inter> {x. x\<bullet>k \<ge> c}) {l \<inter> {x. x\<bullet>k \<ge> c} | l . l \<in> d \<and> ~(l \<inter> {x. x\<bullet>k \<ge> c} = {})} \<subseteq>
       
  4222       division_points ({a..b}) d" (is ?t2)
       
  4223 proof -
       
  4224   note assm = division_ofD[OF assms(1)]
       
  4225   have *: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
  3997     "\<forall>i\<in>Basis. a\<bullet>i \<le> (\<Sum>i\<in>Basis. (if i = k then min (b \<bullet> k) c else b \<bullet> i) *\<^sub>R i) \<bullet> i"
  4226     "\<forall>i\<in>Basis. a\<bullet>i \<le> (\<Sum>i\<in>Basis. (if i = k then min (b \<bullet> k) c else b \<bullet> i) *\<^sub>R i) \<bullet> i"
  3998     "\<forall>i\<in>Basis. (\<Sum>i\<in>Basis. (if i = k then max (a \<bullet> k) c else a \<bullet> i) *\<^sub>R i) \<bullet> i \<le> b\<bullet>i"
  4227     "\<forall>i\<in>Basis. (\<Sum>i\<in>Basis. (if i = k then max (a \<bullet> k) c else a \<bullet> i) *\<^sub>R i) \<bullet> i \<le> b\<bullet>i"
  3999     "min (b \<bullet> k) c = c" "max (a \<bullet> k) c = c"
  4228     "min (b \<bullet> k) c = c" "max (a \<bullet> k) c = c"
  4000     using assms using less_imp_le by auto
  4229     using assms using less_imp_le by auto
  4001   show ?t1
  4230   show ?t1
  4002     unfolding division_points_def interval_split[OF k, of a b]
  4231     unfolding division_points_def interval_split[OF k, of a b]
  4003     unfolding interval_bounds[OF *(1)] interval_bounds[OF *(2)] interval_bounds[OF *(3)]
  4232     unfolding interval_bounds[OF *(1)] interval_bounds[OF *(2)] interval_bounds[OF *(3)]
  4004     unfolding *
  4233     unfolding *
  4005     unfolding subset_eq
  4234     unfolding subset_eq
  4006     apply(rule)
  4235     apply rule
  4007     unfolding mem_Collect_eq split_beta
  4236     unfolding mem_Collect_eq split_beta
  4008     apply(erule bexE conjE)+
  4237     apply (erule bexE conjE)+
  4009     apply(simp only: mem_Collect_eq inner_setsum_left_Basis simp_thms)
  4238     apply (simp only: mem_Collect_eq inner_setsum_left_Basis simp_thms)
  4010     apply(erule exE conjE)+
  4239     apply (erule exE conjE)+
  4011   proof
  4240   proof
  4012     fix i l x assume as:"a \<bullet> fst x < snd x" "snd x < (if fst x = k then c else b \<bullet> fst x)"
  4241     fix i l x
       
  4242     assume as:
       
  4243       "a \<bullet> fst x < snd x" "snd x < (if fst x = k then c else b \<bullet> fst x)"
  4013       "interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  4244       "interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  4014       "i = l \<inter> {x. x \<bullet> k \<le> c}" "l \<in> d" "l \<inter> {x. x \<bullet> k \<le> c} \<noteq> {}" and fstx:"fst x \<in>Basis"
  4245       "i = l \<inter> {x. x \<bullet> k \<le> c}" "l \<in> d" "l \<inter> {x. x \<bullet> k \<le> c} \<noteq> {}"
       
  4246       and fstx: "fst x \<in> Basis"
  4015     from assm(4)[OF this(5)] guess u v apply-by(erule exE)+ note l=this
  4247     from assm(4)[OF this(5)] guess u v apply-by(erule exE)+ note l=this
  4016     have *:"\<forall>i\<in>Basis. u \<bullet> i \<le> (\<Sum>i\<in>Basis. (if i = k then min (v \<bullet> k) c else v \<bullet> i) *\<^sub>R i) \<bullet> i"
  4248     have *: "\<forall>i\<in>Basis. u \<bullet> i \<le> (\<Sum>i\<in>Basis. (if i = k then min (v \<bullet> k) c else v \<bullet> i) *\<^sub>R i) \<bullet> i"
  4017       using as(6) unfolding l interval_split[OF k] interval_ne_empty as .
  4249       using as(6) unfolding l interval_split[OF k] interval_ne_empty as .
  4018     have **:"\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i" using l using as(6) unfolding interval_ne_empty[symmetric] by auto
  4250     have **: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i"
       
  4251       using l using as(6) unfolding interval_ne_empty[symmetric] by auto
  4019     show "\<exists>i\<in>d. interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  4252     show "\<exists>i\<in>d. interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  4020       apply (rule bexI[OF _ `l \<in> d`])
  4253       apply (rule bexI[OF _ `l \<in> d`])
  4021       using as(1-3,5) fstx
  4254       using as(1-3,5) fstx
  4022       unfolding l interval_bounds[OF **] interval_bounds[OF *] interval_split[OF k] as
  4255       unfolding l interval_bounds[OF **] interval_bounds[OF *] interval_split[OF k] as
  4023       by (auto split: split_if_asm)
  4256       apply (auto split: split_if_asm)
       
  4257       done
  4024     show "snd x < b \<bullet> fst x"
  4258     show "snd x < b \<bullet> fst x"
  4025       using as(2) `c < b\<bullet>k` by (auto split: split_if_asm)
  4259       using as(2) `c < b\<bullet>k` by (auto split: split_if_asm)
  4026   qed
  4260   qed
  4027   show ?t2
  4261   show ?t2
  4028     unfolding division_points_def interval_split[OF k, of a b]
  4262     unfolding division_points_def interval_split[OF k, of a b]
  4029     unfolding interval_bounds[OF *(1)] interval_bounds[OF *(2)] interval_bounds[OF *(3)] unfolding *
  4263     unfolding interval_bounds[OF *(1)] interval_bounds[OF *(2)] interval_bounds[OF *(3)]
  4030     unfolding subset_eq apply(rule) unfolding mem_Collect_eq split_beta
  4264     unfolding *
  4031     apply(erule bexE conjE)+
  4265     unfolding subset_eq
  4032     apply(simp only: mem_Collect_eq inner_setsum_left_Basis simp_thms)
  4266     apply rule
  4033     apply(erule exE conjE)+
  4267     unfolding mem_Collect_eq split_beta
       
  4268     apply (erule bexE conjE)+
       
  4269     apply (simp only: mem_Collect_eq inner_setsum_left_Basis simp_thms)
       
  4270     apply (erule exE conjE)+
  4034   proof
  4271   proof
  4035     fix i l x assume as:"(if fst x = k then c else a \<bullet> fst x) < snd x" "snd x < b \<bullet> fst x"
  4272     fix i l x
       
  4273     assume as:
       
  4274       "(if fst x = k then c else a \<bullet> fst x) < snd x" "snd x < b \<bullet> fst x"
  4036       "interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  4275       "interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  4037       "i = l \<inter> {x. c \<le> x \<bullet> k}" "l \<in> d" "l \<inter> {x. c \<le> x \<bullet> k} \<noteq> {}" and fstx:"fst x \<in> Basis"
  4276       "i = l \<inter> {x. c \<le> x \<bullet> k}" "l \<in> d" "l \<inter> {x. c \<le> x \<bullet> k} \<noteq> {}"
  4038     from assm(4)[OF this(5)] guess u v apply-by(erule exE)+ note l=this
  4277       and fstx: "fst x \<in> Basis"
  4039     have *:"\<forall>i\<in>Basis. (\<Sum>i\<in>Basis. (if i = k then max (u \<bullet> k) c else u \<bullet> i) *\<^sub>R i) \<bullet> i \<le> v \<bullet> i"
  4278     from assm(4)[OF this(5)] guess u v by (elim exE) note l=this
       
  4279     have *: "\<forall>i\<in>Basis. (\<Sum>i\<in>Basis. (if i = k then max (u \<bullet> k) c else u \<bullet> i) *\<^sub>R i) \<bullet> i \<le> v \<bullet> i"
  4040       using as(6) unfolding l interval_split[OF k] interval_ne_empty as .
  4280       using as(6) unfolding l interval_split[OF k] interval_ne_empty as .
  4041     have **:"\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i" using l using as(6) unfolding interval_ne_empty[symmetric] by auto
  4281     have **: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i"
       
  4282       using l using as(6) unfolding interval_ne_empty[symmetric] by auto
  4042     show "\<exists>i\<in>d. interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  4283     show "\<exists>i\<in>d. interval_lowerbound i \<bullet> fst x = snd x \<or> interval_upperbound i \<bullet> fst x = snd x"
  4043       apply (rule bexI[OF _ `l \<in> d`])
  4284       apply (rule bexI[OF _ `l \<in> d`])
  4044       using as(1-3,5) fstx
  4285       using as(1-3,5) fstx
  4045       unfolding l interval_bounds[OF **] interval_bounds[OF *] interval_split[OF k] as
  4286       unfolding l interval_bounds[OF **] interval_bounds[OF *] interval_split[OF k] as
  4046       by (auto split: split_if_asm)
  4287       apply (auto split: split_if_asm)
       
  4288       done
  4047     show "a \<bullet> fst x < snd x"
  4289     show "a \<bullet> fst x < snd x"
  4048       using as(1) `a\<bullet>k < c` by (auto split: split_if_asm)
  4290       using as(1) `a\<bullet>k < c` by (auto split: split_if_asm)
  4049    qed
  4291    qed
  4050 qed
  4292 qed
  4051 
  4293 
  4052 lemma division_points_psubset: fixes a::"'a::ordered_euclidean_space"
  4294 lemma division_points_psubset:
  4053   assumes "d division_of {a..b}"  "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"  "a\<bullet>k < c" "c < b\<bullet>k"
  4295   fixes a :: "'a::ordered_euclidean_space"
  4054   "l \<in> d" "interval_lowerbound l\<bullet>k = c \<or> interval_upperbound l\<bullet>k = c" and k:"k\<in>Basis"
  4296   assumes "d division_of {a..b}"
  4055   shows "division_points ({a..b} \<inter> {x. x\<bullet>k \<le> c}) {l \<inter> {x. x\<bullet>k \<le> c} | l. l\<in>d \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}}
  4297     and "\<forall>i\<in>Basis. a\<bullet>i < b\<bullet>i"  "a\<bullet>k < c" "c < b\<bullet>k"
  4056               \<subset> division_points ({a..b}) d" (is "?D1 \<subset> ?D")
  4298     and "l \<in> d"
  4057         "division_points ({a..b} \<inter> {x. x\<bullet>k \<ge> c}) {l \<inter> {x. x\<bullet>k \<ge> c} | l. l\<in>d \<and> l \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}}
  4299     and "interval_lowerbound l\<bullet>k = c \<or> interval_upperbound l\<bullet>k = c"
  4058               \<subset> division_points ({a..b}) d" (is "?D2 \<subset> ?D")
  4300     and k: "k \<in> Basis"
  4059 proof- have ab:"\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i" using assms(2) by(auto intro!:less_imp_le)
  4301   shows "division_points ({a..b} \<inter> {x. x\<bullet>k \<le> c}) {l \<inter> {x. x\<bullet>k \<le> c} | l. l\<in>d \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}} \<subset>
  4060   guess u v using division_ofD(4)[OF assms(1,5)] apply-by(erule exE)+ note l=this
  4302       division_points ({a..b}) d" (is "?D1 \<subset> ?D")
  4061   have uv:"\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i" "\<forall>i\<in>Basis. a\<bullet>i \<le> u\<bullet>i \<and> v\<bullet>i \<le> b\<bullet>i"
  4303     and "division_points ({a..b} \<inter> {x. x\<bullet>k \<ge> c}) {l \<inter> {x. x\<bullet>k \<ge> c} | l. l\<in>d \<and> l \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}} \<subset>
       
  4304       division_points ({a..b}) d" (is "?D2 \<subset> ?D")
       
  4305 proof -
       
  4306   have ab: "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
       
  4307     using assms(2) by (auto intro!:less_imp_le)
       
  4308   guess u v using division_ofD(4)[OF assms(1,5)] by (elim exE) note l=this
       
  4309   have uv: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i" "\<forall>i\<in>Basis. a\<bullet>i \<le> u\<bullet>i \<and> v\<bullet>i \<le> b\<bullet>i"
  4062     using division_ofD(2,2,3)[OF assms(1,5)] unfolding l interval_ne_empty
  4310     using division_ofD(2,2,3)[OF assms(1,5)] unfolding l interval_ne_empty
  4063     unfolding subset_eq apply- defer apply(erule_tac x=u in ballE, erule_tac x=v in ballE) unfolding mem_interval by auto
  4311     unfolding subset_eq
  4064   have *:"interval_upperbound ({a..b} \<inter> {x. x \<bullet> k \<le> interval_upperbound l \<bullet> k}) \<bullet> k = interval_upperbound l \<bullet> k"
  4312     apply -
  4065          "interval_upperbound ({a..b} \<inter> {x. x \<bullet> k \<le> interval_lowerbound l \<bullet> k}) \<bullet> k = interval_lowerbound l \<bullet> k"
  4313     defer
  4066     unfolding interval_split[OF k] apply(subst interval_bounds) prefer 3 apply(subst interval_bounds)
  4314     apply (erule_tac x=u in ballE)
  4067     unfolding l interval_bounds[OF uv(1)] using uv[rule_format,of k] ab k by auto
  4315     apply (erule_tac x=v in ballE)
  4068   have "\<exists>x. x \<in> ?D - ?D1" using assms(2-) apply-apply(erule disjE)
  4316     unfolding mem_interval
  4069     apply(rule_tac x="(k,(interval_lowerbound l)\<bullet>k)" in exI) defer
  4317     apply auto
  4070     apply(rule_tac x="(k,(interval_upperbound l)\<bullet>k)" in exI)
  4318     done
  4071     unfolding division_points_def unfolding interval_bounds[OF ab] by(auto simp add:*)
  4319   have *: "interval_upperbound ({a..b} \<inter> {x. x \<bullet> k \<le> interval_upperbound l \<bullet> k}) \<bullet> k = interval_upperbound l \<bullet> k"
  4072   thus "?D1 \<subset> ?D" apply-apply(rule,rule division_points_subset[OF assms(1-4)]) using k by auto
  4320     "interval_upperbound ({a..b} \<inter> {x. x \<bullet> k \<le> interval_lowerbound l \<bullet> k}) \<bullet> k = interval_lowerbound l \<bullet> k"
  4073 
  4321     unfolding interval_split[OF k]
  4074   have *:"interval_lowerbound ({a..b} \<inter> {x. x \<bullet> k \<ge> interval_lowerbound l \<bullet> k}) \<bullet> k = interval_lowerbound l \<bullet> k"
  4322     apply (subst interval_bounds)
  4075          "interval_lowerbound ({a..b} \<inter> {x. x \<bullet> k \<ge> interval_upperbound l \<bullet> k}) \<bullet> k = interval_upperbound l \<bullet> k"
  4323     prefer 3
  4076     unfolding interval_split[OF k] apply(subst interval_bounds) prefer 3 apply(subst interval_bounds)
  4324     apply (subst interval_bounds)
  4077     unfolding l interval_bounds[OF uv(1)] using uv[rule_format,of k] ab k by auto
  4325     unfolding l interval_bounds[OF uv(1)]
  4078   have "\<exists>x. x \<in> ?D - ?D2" using assms(2-) apply-apply(erule disjE)
  4326     using uv[rule_format,of k] ab k
  4079     apply(rule_tac x="(k,(interval_lowerbound l)\<bullet>k)" in exI) defer
  4327     apply auto
  4080     apply(rule_tac x="(k,(interval_upperbound l)\<bullet>k)" in exI)
  4328     done
  4081     unfolding division_points_def unfolding interval_bounds[OF ab] by(auto simp add:*)
  4329   have "\<exists>x. x \<in> ?D - ?D1"
  4082   thus "?D2 \<subset> ?D" apply-apply(rule,rule division_points_subset[OF assms(1-4) k]) by auto qed
  4330     using assms(2-)
       
  4331     apply -
       
  4332     apply (erule disjE)
       
  4333     apply (rule_tac x="(k,(interval_lowerbound l)\<bullet>k)" in exI)
       
  4334     defer
       
  4335     apply (rule_tac x="(k,(interval_upperbound l)\<bullet>k)" in exI)
       
  4336     unfolding division_points_def
       
  4337     unfolding interval_bounds[OF ab]
       
  4338     apply (auto simp add:*)
       
  4339     done
       
  4340   then show "?D1 \<subset> ?D"
       
  4341     apply -
       
  4342     apply rule
       
  4343     apply (rule division_points_subset[OF assms(1-4)])
       
  4344     using k
       
  4345     apply auto
       
  4346     done
       
  4347 
       
  4348   have *: "interval_lowerbound ({a..b} \<inter> {x. x \<bullet> k \<ge> interval_lowerbound l \<bullet> k}) \<bullet> k = interval_lowerbound l \<bullet> k"
       
  4349     "interval_lowerbound ({a..b} \<inter> {x. x \<bullet> k \<ge> interval_upperbound l \<bullet> k}) \<bullet> k = interval_upperbound l \<bullet> k"
       
  4350     unfolding interval_split[OF k]
       
  4351     apply (subst interval_bounds)
       
  4352     prefer 3
       
  4353     apply (subst interval_bounds)
       
  4354     unfolding l interval_bounds[OF uv(1)]
       
  4355     using uv[rule_format,of k] ab k
       
  4356     apply auto
       
  4357     done
       
  4358   have "\<exists>x. x \<in> ?D - ?D2"
       
  4359     using assms(2-)
       
  4360     apply -
       
  4361     apply (erule disjE)
       
  4362     apply (rule_tac x="(k,(interval_lowerbound l)\<bullet>k)" in exI)
       
  4363     defer
       
  4364     apply (rule_tac x="(k,(interval_upperbound l)\<bullet>k)" in exI)
       
  4365     unfolding division_points_def
       
  4366     unfolding interval_bounds[OF ab]
       
  4367     apply (auto simp add:*)
       
  4368     done
       
  4369   then show "?D2 \<subset> ?D"
       
  4370     apply -
       
  4371     apply rule
       
  4372     apply (rule division_points_subset[OF assms(1-4) k])
       
  4373     apply auto
       
  4374     done
       
  4375 qed
       
  4376 
  4083 
  4377 
  4084 subsection {* Preservation by divisions and tagged divisions. *}
  4378 subsection {* Preservation by divisions and tagged divisions. *}
  4085 
  4379 
  4086 lemma support_support[simp]:"support opp f (support opp f s) = support opp f s"
  4380 lemma support_support[simp]:"support opp f (support opp f s) = support opp f s"
  4087   unfolding support_def by auto
  4381   unfolding support_def by auto
  4089 lemma iterate_support[simp]: "iterate opp (support opp f s) f = iterate opp s f"
  4383 lemma iterate_support[simp]: "iterate opp (support opp f s) f = iterate opp s f"
  4090   unfolding iterate_def support_support by auto
  4384   unfolding iterate_def support_support by auto
  4091 
  4385 
  4092 lemma iterate_expand_cases:
  4386 lemma iterate_expand_cases:
  4093   "iterate opp s f = (if finite(support opp f s) then iterate opp (support opp f s) f else neutral opp)"
  4387   "iterate opp s f = (if finite(support opp f s) then iterate opp (support opp f s) f else neutral opp)"
  4094   apply(cases) apply(subst if_P,assumption) unfolding iterate_def support_support fold'_def by auto
  4388   apply cases
  4095 
  4389   apply (subst if_P, assumption)
  4096 lemma iterate_image: assumes "monoidal opp"  "inj_on f s"
  4390   unfolding iterate_def support_support fold'_def
       
  4391   apply auto
       
  4392   done
       
  4393 
       
  4394 lemma iterate_image:
       
  4395   assumes "monoidal opp"
       
  4396     and "inj_on f s"
  4097   shows "iterate opp (f ` s) g = iterate opp s (g \<circ> f)"
  4397   shows "iterate opp (f ` s) g = iterate opp s (g \<circ> f)"
  4098 proof- have *:"\<And>s. finite s \<Longrightarrow>  \<forall>x\<in>s. \<forall>y\<in>s. f x = f y \<longrightarrow> x = y \<Longrightarrow>
  4398 proof -
  4099      iterate opp (f ` s) g = iterate opp s (g \<circ> f)"
  4399   have *: "\<And>s. finite s \<Longrightarrow>  \<forall>x\<in>s. \<forall>y\<in>s. f x = f y \<longrightarrow> x = y \<Longrightarrow>
  4100   proof- case goal1 show ?case using goal1
  4400     iterate opp (f ` s) g = iterate opp s (g \<circ> f)"
  4101     proof(induct s) case empty thus ?case using assms(1) by auto
  4401   proof -
  4102     next case (insert x s) show ?case unfolding iterate_insert[OF assms(1) insert(1)]
  4402     case goal1
  4103         unfolding if_not_P[OF insert(2)] apply(subst insert(3)[symmetric])
  4403     then show ?case
  4104         unfolding image_insert defer apply(subst iterate_insert[OF assms(1)])
  4404     proof (induct s)
  4105         apply(rule finite_imageI insert)+ apply(subst if_not_P)
  4405       case empty
  4106         unfolding image_iff o_def using insert(2,4) by auto
  4406       then show ?case
  4107     qed qed
  4407         using assms(1) by auto
       
  4408     next
       
  4409       case (insert x s)
       
  4410       show ?case
       
  4411         unfolding iterate_insert[OF assms(1) insert(1)]
       
  4412         unfolding if_not_P[OF insert(2)]
       
  4413         apply (subst insert(3)[symmetric])
       
  4414         unfolding image_insert
       
  4415         defer
       
  4416         apply (subst iterate_insert[OF assms(1)])
       
  4417         apply (rule finite_imageI insert)+
       
  4418         apply (subst if_not_P)
       
  4419         unfolding image_iff o_def
       
  4420         using insert(2,4)
       
  4421         apply auto
       
  4422         done
       
  4423     qed
       
  4424   qed
  4108   show ?thesis
  4425   show ?thesis
  4109     apply(cases "finite (support opp g (f ` s))")
  4426     apply (cases "finite (support opp g (f ` s))")
  4110     apply(subst (1) iterate_support[symmetric],subst (2) iterate_support[symmetric])
  4427     apply (subst (1) iterate_support[symmetric],subst (2) iterate_support[symmetric])
  4111     unfolding support_clauses apply(rule *)apply(rule finite_imageD,assumption) unfolding inj_on_def[symmetric]
  4428     unfolding support_clauses
  4112     apply(rule subset_inj_on[OF assms(2) support_subset])+
  4429     apply (rule *)
  4113     apply(subst iterate_expand_cases) unfolding support_clauses apply(simp only: if_False)
  4430     apply (rule finite_imageD,assumption)
  4114     apply(subst iterate_expand_cases) apply(subst if_not_P) by auto qed
  4431     unfolding inj_on_def[symmetric]
  4115 
  4432     apply (rule subset_inj_on[OF assms(2) support_subset])+
  4116 
  4433     apply (subst iterate_expand_cases)
  4117 (* This lemma about iterations comes up in a few places.                     *)
  4434     unfolding support_clauses
       
  4435     apply (simp only: if_False)
       
  4436     apply (subst iterate_expand_cases)
       
  4437     apply (subst if_not_P)
       
  4438     apply auto
       
  4439     done
       
  4440 qed
       
  4441 
       
  4442 
       
  4443 (* This lemma about iterations comes up in a few places. *)
  4118 lemma iterate_nonzero_image_lemma:
  4444 lemma iterate_nonzero_image_lemma:
  4119   assumes "monoidal opp" "finite s" "g(a) = neutral opp"
  4445   assumes "monoidal opp"
  4120   "\<forall>x\<in>s. \<forall>y\<in>s. f x = f y \<and> x \<noteq> y \<longrightarrow> g(f x) = neutral opp"
  4446     and "finite s" "g(a) = neutral opp"
       
  4447     and "\<forall>x\<in>s. \<forall>y\<in>s. f x = f y \<and> x \<noteq> y \<longrightarrow> g(f x) = neutral opp"
  4121   shows "iterate opp {f x | x. x \<in> s \<and> f x \<noteq> a} g = iterate opp s (g \<circ> f)"
  4448   shows "iterate opp {f x | x. x \<in> s \<and> f x \<noteq> a} g = iterate opp s (g \<circ> f)"
  4122 proof- have *:"{f x |x. x \<in> s \<and> ~(f x = a)} = f ` {x. x \<in> s \<and> ~(f x = a)}" by auto
  4449 proof -
  4123   have **:"support opp (g \<circ> f) {x \<in> s. f x \<noteq> a} = support opp (g \<circ> f) s"
  4450   have *: "{f x |x. x \<in> s \<and> f x \<noteq> a} = f ` {x. x \<in> s \<and> f x \<noteq> a}"
       
  4451     by auto
       
  4452   have **: "support opp (g \<circ> f) {x \<in> s. f x \<noteq> a} = support opp (g \<circ> f) s"
  4124     unfolding support_def using assms(3) by auto
  4453     unfolding support_def using assms(3) by auto
  4125   show ?thesis unfolding *
  4454   show ?thesis
  4126     apply(subst iterate_support[symmetric]) unfolding support_clauses
  4455     unfolding *
  4127     apply(subst iterate_image[OF assms(1)]) defer
  4456     apply (subst iterate_support[symmetric])
  4128     apply(subst(2) iterate_support[symmetric]) apply(subst **)
  4457     unfolding support_clauses
  4129     unfolding inj_on_def using assms(3,4) unfolding support_def by auto qed
  4458     apply (subst iterate_image[OF assms(1)])
       
  4459     defer
       
  4460     apply (subst(2) iterate_support[symmetric])
       
  4461     apply (subst **)
       
  4462     unfolding inj_on_def
       
  4463     using assms(3,4)
       
  4464     unfolding support_def
       
  4465     apply auto
       
  4466     done
       
  4467 qed
  4130 
  4468 
  4131 lemma iterate_eq_neutral:
  4469 lemma iterate_eq_neutral:
  4132   assumes "monoidal opp"  "\<forall>x \<in> s. (f(x) = neutral opp)"
  4470   assumes "monoidal opp"
  4133   shows "(iterate opp s f = neutral opp)"
  4471     and "\<forall>x \<in> s. f x = neutral opp"
  4134 proof- have *:"support opp f s = {}" unfolding support_def using assms(2) by auto
  4472   shows "iterate opp s f = neutral opp"
  4135   show ?thesis apply(subst iterate_support[symmetric])
  4473 proof -
  4136     unfolding * using assms(1) by auto qed
  4474   have *: "support opp f s = {}"
  4137 
       
  4138 lemma iterate_op: assumes "monoidal opp" "finite s"
       
  4139   shows "iterate opp s (\<lambda>x. opp (f x) (g x)) = opp (iterate opp s f) (iterate opp s g)" using assms(2)
       
  4140 proof(induct s) case empty thus ?case unfolding iterate_insert[OF assms(1)] using assms(1) by auto
       
  4141 next case (insert x F) show ?case unfolding iterate_insert[OF assms(1) insert(1)] if_not_P[OF insert(2)] insert(3)
       
  4142     unfolding monoidal_ac[OF assms(1)] by(rule refl) qed
       
  4143 
       
  4144 lemma iterate_eq: assumes "monoidal opp" "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
       
  4145   shows "iterate opp s f = iterate opp s g"
       
  4146 proof- have *:"support opp g s = support opp f s"
       
  4147     unfolding support_def using assms(2) by auto
  4475     unfolding support_def using assms(2) by auto
  4148   show ?thesis
  4476   show ?thesis
  4149   proof(cases "finite (support opp f s)")
  4477     apply (subst iterate_support[symmetric])
  4150     case False thus ?thesis apply(subst iterate_expand_cases,subst(2) iterate_expand_cases)
  4478     unfolding *
  4151       unfolding * by auto
  4479     using assms(1)
  4152   next def su \<equiv> "support opp f s"
  4480     apply auto
       
  4481     done
       
  4482 qed
       
  4483 
       
  4484 lemma iterate_op:
       
  4485   assumes "monoidal opp"
       
  4486     and "finite s"
       
  4487   shows "iterate opp s (\<lambda>x. opp (f x) (g x)) = opp (iterate opp s f) (iterate opp s g)"
       
  4488   using assms(2)
       
  4489 proof (induct s)
       
  4490   case empty
       
  4491   then show ?case
       
  4492     unfolding iterate_insert[OF assms(1)] using assms(1) by auto
       
  4493 next
       
  4494   case (insert x F)
       
  4495   show ?case
       
  4496     unfolding iterate_insert[OF assms(1) insert(1)] if_not_P[OF insert(2)] insert(3)
       
  4497     by (simp add: monoidal_ac[OF assms(1)])
       
  4498 qed
       
  4499 
       
  4500 lemma iterate_eq:
       
  4501   assumes "monoidal opp"
       
  4502     and "\<And>x. x \<in> s \<Longrightarrow> f x = g x"
       
  4503   shows "iterate opp s f = iterate opp s g"
       
  4504 proof -
       
  4505   have *: "support opp g s = support opp f s"
       
  4506     unfolding support_def using assms(2) by auto
       
  4507   show ?thesis
       
  4508   proof (cases "finite (support opp f s)")
       
  4509     case False
       
  4510     then show ?thesis
       
  4511       apply (subst iterate_expand_cases)
       
  4512       apply (subst(2) iterate_expand_cases)
       
  4513       unfolding *
       
  4514       apply auto
       
  4515       done
       
  4516   next
       
  4517     def su \<equiv> "support opp f s"
  4153     case True note support_subset[of opp f s]
  4518     case True note support_subset[of opp f s]
  4154     thus ?thesis apply- apply(subst iterate_support[symmetric],subst(2) iterate_support[symmetric]) unfolding * using True
  4519     then show ?thesis
       
  4520       apply -
       
  4521       apply (subst iterate_support[symmetric])
       
  4522       apply (subst(2) iterate_support[symmetric])
       
  4523       unfolding *
       
  4524       using True
  4155       unfolding su_def[symmetric]
  4525       unfolding su_def[symmetric]
  4156     proof(induct su) case empty show ?case by auto
  4526     proof (induct su)
  4157     next case (insert x s) show ?case unfolding iterate_insert[OF assms(1) insert(1)]
  4527       case empty
  4158         unfolding if_not_P[OF insert(2)] apply(subst insert(3))
  4528       show ?case by auto
  4159         defer apply(subst assms(2)[of x]) using insert by auto qed qed qed
  4529     next
  4160 
  4530       case (insert x s)
  4161 lemma nonempty_witness: assumes "s \<noteq> {}" obtains x where "x \<in> s" using assms by auto
  4531       show ?case
  4162 
  4532         unfolding iterate_insert[OF assms(1) insert(1)]
  4163 lemma operative_division: fixes f::"('a::ordered_euclidean_space) set \<Rightarrow> 'b"
  4533         unfolding if_not_P[OF insert(2)]
  4164   assumes "monoidal opp" "operative opp f" "d division_of {a..b}"
  4534         apply (subst insert(3))
       
  4535         defer
       
  4536         apply (subst assms(2)[of x])
       
  4537         using insert
       
  4538         apply auto
       
  4539         done
       
  4540     qed
       
  4541   qed
       
  4542 qed
       
  4543 
       
  4544 lemma nonempty_witness:
       
  4545   assumes "s \<noteq> {}"
       
  4546   obtains x where "x \<in> s"
       
  4547   using assms by auto
       
  4548 
       
  4549 lemma operative_division:
       
  4550   fixes f :: "'a::ordered_euclidean_space set \<Rightarrow> 'b"
       
  4551   assumes "monoidal opp"
       
  4552     and "operative opp f"
       
  4553     and "d division_of {a..b}"
  4165   shows "iterate opp d f = f {a..b}"
  4554   shows "iterate opp d f = f {a..b}"
  4166 proof- def C \<equiv> "card (division_points {a..b} d)" thus ?thesis using assms
  4555 proof -
  4167   proof(induct C arbitrary:a b d rule:full_nat_induct)
  4556   def C \<equiv> "card (division_points {a..b} d)"
       
  4557   then show ?thesis
       
  4558     using assms
       
  4559   proof (induct C arbitrary: a b d rule: full_nat_induct)
  4168     case goal1
  4560     case goal1
  4169     { presume *:"content {a..b} \<noteq> 0 \<Longrightarrow> ?case"
  4561     { presume *: "content {a..b} \<noteq> 0 \<Longrightarrow> ?case"
  4170       thus ?case apply-apply(cases) defer apply assumption
  4562       then show ?case
  4171       proof- assume as:"content {a..b} = 0"
  4563         apply -
  4172         show ?case unfolding operativeD(1)[OF assms(2) as] apply(rule iterate_eq_neutral[OF goal1(2)])
  4564         apply cases
  4173         proof fix x assume x:"x\<in>d"
  4565         defer
  4174           then guess u v apply(drule_tac division_ofD(4)[OF goal1(4)]) by(erule exE)+
  4566         apply assumption
  4175           thus "f x = neutral opp" using division_of_content_0[OF as goal1(4)]
  4567       proof -
  4176             using operativeD(1)[OF assms(2)] x by auto
  4568         assume as: "content {a..b} = 0"
  4177         qed qed }
  4569         show ?case
       
  4570           unfolding operativeD(1)[OF assms(2) as]
       
  4571           apply(rule iterate_eq_neutral[OF goal1(2)])
       
  4572         proof
       
  4573           fix x
       
  4574           assume x: "x \<in> d"
       
  4575           then guess u v
       
  4576             apply (drule_tac division_ofD(4)[OF goal1(4)])
       
  4577             apply (elim exE)
       
  4578             done
       
  4579           then show "f x = neutral opp"
       
  4580             using division_of_content_0[OF as goal1(4)]
       
  4581             using operativeD(1)[OF assms(2)] x
       
  4582             by auto
       
  4583         qed
       
  4584       qed
       
  4585     }
  4178     assume "content {a..b} \<noteq> 0" note ab = this[unfolded content_lt_nz[symmetric] content_pos_lt_eq]
  4586     assume "content {a..b} \<noteq> 0" note ab = this[unfolded content_lt_nz[symmetric] content_pos_lt_eq]
  4179     hence ab':"\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i" by (auto intro!: less_imp_le) show ?case
  4587     then have ab': "\<forall>i\<in>Basis. a\<bullet>i \<le> b\<bullet>i"
  4180     proof(cases "division_points {a..b} d = {}")
  4588       by (auto intro!: less_imp_le)
  4181       case True have d':"\<forall>i\<in>d. \<exists>u v. i = {u..v} \<and>
  4589     show ?case
       
  4590     proof (cases "division_points {a..b} d = {}")
       
  4591       case True
       
  4592       have d': "\<forall>i\<in>d. \<exists>u v. i = {u..v} \<and>
  4182         (\<forall>j\<in>Basis. u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = a\<bullet>j \<or> u\<bullet>j = b\<bullet>j \<and> v\<bullet>j = b\<bullet>j \<or> u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = b\<bullet>j)"
  4593         (\<forall>j\<in>Basis. u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = a\<bullet>j \<or> u\<bullet>j = b\<bullet>j \<and> v\<bullet>j = b\<bullet>j \<or> u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = b\<bullet>j)"
  4183         unfolding forall_in_division[OF goal1(4)] apply(rule,rule,rule)
  4594         unfolding forall_in_division[OF goal1(4)]
  4184         apply(rule_tac x=a in exI,rule_tac x=b in exI) apply(rule,rule refl)
  4595         apply rule
       
  4596         apply rule
       
  4597         apply rule
       
  4598         apply (rule_tac x=a in exI)
       
  4599         apply (rule_tac x=b in exI)
       
  4600         apply rule
       
  4601         apply (rule refl)
  4185       proof
  4602       proof
  4186         fix u v and j :: 'a assume j:"j\<in>Basis" assume as:"{u..v} \<in> d" note division_ofD(3)[OF goal1(4) this]
  4603         fix u v
  4187         hence uv:"\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i" "u\<bullet>j \<le> v\<bullet>j" using j unfolding interval_ne_empty by auto
  4604         fix j :: 'a
  4188         have *:"\<And>p r Q. \<not> j\<in>Basis \<or> p \<or> r \<or> (\<forall>x\<in>d. Q x) \<Longrightarrow> p \<or> r \<or> (Q {u..v})" using as j by auto
  4605         assume j: "j \<in> Basis"
       
  4606         assume as: "{u..v} \<in> d"
       
  4607         note division_ofD(3)[OF goal1(4) this]
       
  4608         then have uv: "\<forall>i\<in>Basis. u\<bullet>i \<le> v\<bullet>i" "u\<bullet>j \<le> v\<bullet>j"
       
  4609           using j unfolding interval_ne_empty by auto
       
  4610         have *: "\<And>p r Q. \<not> j\<in>Basis \<or> p \<or> r \<or> (\<forall>x\<in>d. Q x) \<Longrightarrow> p \<or> r \<or> Q {u..v}"
       
  4611           using as j by auto
  4189         have "(j, u\<bullet>j) \<notin> division_points {a..b} d"
  4612         have "(j, u\<bullet>j) \<notin> division_points {a..b} d"
  4190           "(j, v\<bullet>j) \<notin> division_points {a..b} d" using True by auto
  4613           "(j, v\<bullet>j) \<notin> division_points {a..b} d" using True by auto
  4191         note this[unfolded de_Morgan_conj division_points_def mem_Collect_eq split_conv interval_bounds[OF ab'] bex_simps]
  4614         note this[unfolded de_Morgan_conj division_points_def mem_Collect_eq split_conv interval_bounds[OF ab'] bex_simps]
  4192         note *[OF this(1)] *[OF this(2)] note this[unfolded interval_bounds[OF uv(1)]]
  4615         note *[OF this(1)] *[OF this(2)] note this[unfolded interval_bounds[OF uv(1)]]
  4193         moreover have "a\<bullet>j \<le> u\<bullet>j" "v\<bullet>j \<le> b\<bullet>j" using division_ofD(2,2,3)[OF goal1(4) as]
  4616         moreover
  4194           unfolding subset_eq apply- apply(erule_tac x=u in ballE,erule_tac[3] x=v in ballE)
  4617         have "a\<bullet>j \<le> u\<bullet>j" "v\<bullet>j \<le> b\<bullet>j"
  4195           unfolding interval_ne_empty mem_interval using j by auto
  4618           using division_ofD(2,2,3)[OF goal1(4) as]
       
  4619           unfolding subset_eq
       
  4620           apply -
       
  4621           apply (erule_tac x=u in ballE,erule_tac[3] x=v in ballE)
       
  4622           unfolding interval_ne_empty mem_interval
       
  4623           using j
       
  4624           apply auto
       
  4625           done
  4196         ultimately show "u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = a\<bullet>j \<or> u\<bullet>j = b\<bullet>j \<and> v\<bullet>j = b\<bullet>j \<or> u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = b\<bullet>j"
  4626         ultimately show "u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = a\<bullet>j \<or> u\<bullet>j = b\<bullet>j \<and> v\<bullet>j = b\<bullet>j \<or> u\<bullet>j = a\<bullet>j \<and> v\<bullet>j = b\<bullet>j"
  4197           unfolding not_less de_Morgan_disj using ab[rule_format,of j] uv(2) j by auto
  4627           unfolding not_less de_Morgan_disj using ab[rule_format,of j] uv(2) j by auto
  4198       qed
  4628       qed
  4199       have "(1/2) *\<^sub>R (a+b) \<in> {a..b}"
  4629       have "(1/2) *\<^sub>R (a+b) \<in> {a..b}"
  4200         unfolding mem_interval using ab by(auto intro!: less_imp_le simp: inner_simps)
  4630         unfolding mem_interval using ab by(auto intro!: less_imp_le simp: inner_simps)
  4201       note this[unfolded division_ofD(6)[OF goal1(4),symmetric] Union_iff]
  4631       note this[unfolded division_ofD(6)[OF goal1(4),symmetric] Union_iff]
  4202       then guess i .. note i=this guess u v using d'[rule_format,OF i(1)] apply-by(erule exE conjE)+ note uv=this
  4632       then guess i .. note i=this
       
  4633       guess u v using d'[rule_format,OF i(1)] by (elim exE conjE) note uv=this
  4203       have "{a..b} \<in> d"
  4634       have "{a..b} \<in> d"
  4204       proof- { presume "i = {a..b}" thus ?thesis using i by auto }
  4635       proof -
  4205         { presume "u = a" "v = b" thus "i = {a..b}" using uv by auto }
  4636         { presume "i = {a..b}" then show ?thesis using i by auto }
  4206         show "u = a" "v = b" unfolding euclidean_eq_iff[where 'a='a]
  4637         { presume "u = a" "v = b" then show "i = {a..b}" using uv by auto }
  4207         proof(safe)
  4638         show "u = a" "v = b"
  4208           fix j :: 'a assume j:"j\<in>Basis"
  4639           unfolding euclidean_eq_iff[where 'a='a]
       
  4640         proof safe
       
  4641           fix j :: 'a
       
  4642           assume j: "j \<in> Basis"
  4209           note i(2)[unfolded uv mem_interval,rule_format,of j]
  4643           note i(2)[unfolded uv mem_interval,rule_format,of j]
  4210           thus "u \<bullet> j = a \<bullet> j" "v \<bullet> j = b \<bullet> j" using uv(2)[rule_format,of j] j by (auto simp: inner_simps)
  4644           then show "u \<bullet> j = a \<bullet> j" and "v \<bullet> j = b \<bullet> j"
  4211         qed qed
  4645             using uv(2)[rule_format,of j] j by (auto simp: inner_simps)
  4212       hence *:"d = insert {a..b} (d - {{a..b}})" by auto
  4646         qed
  4213       have "iterate opp (d - {{a..b}}) f = neutral opp" apply(rule iterate_eq_neutral[OF goal1(2)])
  4647       qed
  4214       proof fix x assume x:"x \<in> d - {{a..b}}" hence "x\<in>d" by auto note d'[rule_format,OF this]
  4648       then have *: "d = insert {a..b} (d - {{a..b}})"
  4215         then guess u v apply-by(erule exE conjE)+ note uv=this
  4649         by auto
  4216         have "u\<noteq>a \<or> v\<noteq>b" using x[unfolded uv] by auto
  4650       have "iterate opp (d - {{a..b}}) f = neutral opp"
  4217         then obtain j where "u\<bullet>j \<noteq> a\<bullet>j \<or> v\<bullet>j \<noteq> b\<bullet>j" and j:"j\<in>Basis" unfolding euclidean_eq_iff[where 'a='a] by auto
  4651         apply (rule iterate_eq_neutral[OF goal1(2)])
  4218         hence "u\<bullet>j = v\<bullet>j" using uv(2)[rule_format,OF j] by auto
  4652       proof
  4219         hence "content {u..v} = 0"  unfolding content_eq_0 apply(rule_tac x=j in bexI) using j by auto
  4653         fix x
  4220         thus "f x = neutral opp" unfolding uv(1) by(rule operativeD(1)[OF goal1(3)])
  4654         assume x: "x \<in> d - {{a..b}}"
  4221       qed thus "iterate opp d f = f {a..b}" apply-apply(subst *)
  4655         then have "x\<in>d"
  4222         apply(subst iterate_insert[OF goal1(2)]) using goal1(2,4) by auto
  4656           by auto note d'[rule_format,OF this]
  4223     next case False hence "\<exists>x. x\<in>division_points {a..b} d" by auto
  4657         then guess u v by (elim exE conjE) note uv=this
  4224       then guess k c unfolding split_paired_Ex apply- unfolding division_points_def mem_Collect_eq split_conv
  4658         have "u \<noteq> a \<or> v \<noteq> b"
  4225         by(erule exE conjE)+ note this(2-4,1) note kc=this[unfolded interval_bounds[OF ab']]
  4659           using x[unfolded uv] by auto
       
  4660         then obtain j where "u\<bullet>j \<noteq> a\<bullet>j \<or> v\<bullet>j \<noteq> b\<bullet>j" and j: "j \<in> Basis"
       
  4661           unfolding euclidean_eq_iff[where 'a='a] by auto
       
  4662         then have "u\<bullet>j = v\<bullet>j"
       
  4663           using uv(2)[rule_format,OF j] by auto
       
  4664         then have "content {u..v} = 0"
       
  4665           unfolding content_eq_0
       
  4666           apply (rule_tac x=j in bexI)
       
  4667           using j
       
  4668           apply auto
       
  4669           done
       
  4670         then show "f x = neutral opp"
       
  4671           unfolding uv(1) by (rule operativeD(1)[OF goal1(3)])
       
  4672       qed
       
  4673       then show "iterate opp d f = f {a..b}"
       
  4674         apply -
       
  4675         apply (subst *)
       
  4676         apply (subst iterate_insert[OF goal1(2)])
       
  4677         using goal1(2,4)
       
  4678         apply auto
       
  4679         done
       
  4680     next
       
  4681       case False
       
  4682       then have "\<exists>x. x \<in> division_points {a..b} d"
       
  4683         by auto
       
  4684       then guess k c
       
  4685         unfolding split_paired_Ex
       
  4686         unfolding division_points_def mem_Collect_eq split_conv
       
  4687         apply (elim exE conjE)
       
  4688         done
       
  4689       note this(2-4,1) note kc=this[unfolded interval_bounds[OF ab']]
  4226       from this(3) guess j .. note j=this
  4690       from this(3) guess j .. note j=this
  4227       def d1 \<equiv> "{l \<inter> {x. x\<bullet>k \<le> c} | l. l \<in> d \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}}"
  4691       def d1 \<equiv> "{l \<inter> {x. x\<bullet>k \<le> c} | l. l \<in> d \<and> l \<inter> {x. x\<bullet>k \<le> c} \<noteq> {}}"
  4228       def d2 \<equiv> "{l \<inter> {x. x\<bullet>k \<ge> c} | l. l \<in> d \<and> l \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}}"
  4692       def d2 \<equiv> "{l \<inter> {x. x\<bullet>k \<ge> c} | l. l \<in> d \<and> l \<inter> {x. x\<bullet>k \<ge> c} \<noteq> {}}"
  4229       def cb \<equiv> "(\<Sum>i\<in>Basis. (if i = k then c else b\<bullet>i) *\<^sub>R i)::'a"
  4693       def cb \<equiv> "(\<Sum>i\<in>Basis. (if i = k then c else b\<bullet>i) *\<^sub>R i)::'a"
  4230       def ca \<equiv> "(\<Sum>i\<in>Basis. (if i = k then c else a\<bullet>i) *\<^sub>R i)::'a"
  4694       def ca \<equiv> "(\<Sum>i\<in>Basis. (if i = k then c else a\<bullet>i) *\<^sub>R i)::'a"
  4231       note division_points_psubset[OF goal1(4) ab kc(1-2) j]
  4695       note division_points_psubset[OF goal1(4) ab kc(1-2) j]
  4232       note psubset_card_mono[OF _ this(1)] psubset_card_mono[OF _ this(2)]
  4696       note psubset_card_mono[OF _ this(1)] psubset_card_mono[OF _ this(2)]
  4233       hence *:"(iterate opp d1 f) = f ({a..b} \<inter> {x. x\<bullet>k \<le> c})" "(iterate opp d2 f) = f ({a..b} \<inter> {x. x\<bullet>k \<ge> c})"
  4697       then have *: "(iterate opp d1 f) = f ({a..b} \<inter> {x. x\<bullet>k \<le> c})"
  4234         apply- unfolding interval_split[OF kc(4)] apply(rule_tac[!] goal1(1)[rule_format])
  4698         "(iterate opp d2 f) = f ({a..b} \<inter> {x. x\<bullet>k \<ge> c})"
       
  4699         unfolding interval_split[OF kc(4)]
       
  4700         apply (rule_tac[!] goal1(1)[rule_format])
  4235         using division_split[OF goal1(4), where k=k and c=c]
  4701         using division_split[OF goal1(4), where k=k and c=c]
  4236         unfolding interval_split[OF kc(4)] d1_def[symmetric] d2_def[symmetric] unfolding goal1(2) Suc_le_mono
  4702         unfolding interval_split[OF kc(4)] d1_def[symmetric] d2_def[symmetric]
  4237         using goal1(2-3) using division_points_finite[OF goal1(4)] using kc(4) by auto
  4703         unfolding goal1(2) Suc_le_mono
       
  4704         using goal1(2-3)
       
  4705         using division_points_finite[OF goal1(4)]
       
  4706         using kc(4)
       
  4707         apply auto
       
  4708         done
  4238       have "f {a..b} = opp (iterate opp d1 f) (iterate opp d2 f)" (is "_ = ?prev")
  4709       have "f {a..b} = opp (iterate opp d1 f) (iterate opp d2 f)" (is "_ = ?prev")
  4239         unfolding * apply(rule operativeD(2)) using goal1(3) using kc(4) by auto
  4710         unfolding *
       
  4711         apply (rule operativeD(2))
       
  4712         using goal1(3)
       
  4713         using kc(4)
       
  4714         apply auto
       
  4715         done
  4240       also have "iterate opp d1 f = iterate opp d (\<lambda>l. f(l \<inter> {x. x\<bullet>k \<le> c}))"
  4716       also have "iterate opp d1 f = iterate opp d (\<lambda>l. f(l \<inter> {x. x\<bullet>k \<le> c}))"
  4241         unfolding d1_def apply(rule iterate_nonzero_image_lemma[unfolded o_def])
  4717         unfolding d1_def
  4242         unfolding empty_as_interval apply(rule goal1 division_of_finite operativeD[OF goal1(3)])+
  4718         apply (rule iterate_nonzero_image_lemma[unfolded o_def])
  4243         unfolding empty_as_interval[symmetric] apply(rule content_empty)
  4719         unfolding empty_as_interval
  4244       proof(rule,rule,rule,erule conjE) fix l y assume as:"l \<in> d" "y \<in> d" "l \<inter> {x. x \<bullet> k \<le> c} = y \<inter> {x. x \<bullet> k \<le> c}" "l \<noteq> y"
  4720         apply (rule goal1 division_of_finite operativeD[OF goal1(3)])+
  4245         from division_ofD(4)[OF goal1(4) this(1)] guess u v apply-by(erule exE)+ note l=this
  4721         unfolding empty_as_interval[symmetric]
  4246         show "f (l \<inter> {x. x \<bullet> k \<le> c}) = neutral opp" unfolding l interval_split[OF kc(4)]
  4722         apply (rule content_empty)
  4247           apply(rule operativeD(1) goal1)+ unfolding interval_split[symmetric,OF kc(4)] apply(rule division_split_left_inj)
  4723       proof (rule, rule, rule, erule conjE)
  4248           apply(rule goal1) unfolding l[symmetric] apply(rule as(1),rule as(2)) by(rule kc(4) as)+
  4724         fix l y
  4249       qed also have "iterate opp d2 f = iterate opp d (\<lambda>l. f(l \<inter> {x. x\<bullet>k \<ge> c}))"
  4725         assume as: "l \<in> d" "y \<in> d" "l \<inter> {x. x \<bullet> k \<le> c} = y \<inter> {x. x \<bullet> k \<le> c}" "l \<noteq> y"
  4250         unfolding d2_def apply(rule iterate_nonzero_image_lemma[unfolded o_def])
  4726         from division_ofD(4)[OF goal1(4) this(1)] guess u v by (elim exE) note l=this
  4251         unfolding empty_as_interval apply(rule goal1 division_of_finite operativeD[OF goal1(3)])+
  4727         show "f (l \<inter> {x. x \<bullet> k \<le> c}) = neutral opp"
  4252         unfolding empty_as_interval[symmetric] apply(rule content_empty)
  4728           unfolding l interval_split[OF kc(4)]
  4253       proof(rule,rule,rule,erule conjE) fix l y assume as:"l \<in> d" "y \<in> d" "l \<inter> {x. c \<le> x \<bullet> k} = y \<inter> {x. c \<le> x \<bullet> k}" "l \<noteq> y"
  4729           apply (rule operativeD(1) goal1)+
  4254         from division_ofD(4)[OF goal1(4) this(1)] guess u v apply-by(erule exE)+ note l=this
  4730           unfolding interval_split[symmetric,OF kc(4)]
  4255         show "f (l \<inter> {x. x \<bullet> k \<ge> c}) = neutral opp" unfolding l interval_split[OF kc(4)]
  4731           apply (rule division_split_left_inj)
  4256           apply(rule operativeD(1) goal1)+ unfolding interval_split[symmetric,OF kc(4)] apply(rule division_split_right_inj)
  4732           apply (rule goal1)
  4257           apply(rule goal1) unfolding l[symmetric] apply(rule as(1),rule as(2)) by(rule as kc(4))+
  4733           unfolding l[symmetric]
  4258       qed also have *:"\<forall>x\<in>d. f x = opp (f (x \<inter> {x. x \<bullet> k \<le> c})) (f (x \<inter> {x. c \<le> x \<bullet> k}))"
  4734           apply (rule as(1), rule as(2))
  4259         unfolding forall_in_division[OF goal1(4)] apply(rule,rule,rule,rule operativeD(2)) using goal1(3) kc by auto
  4735           apply (rule kc(4) as)+
  4260       have "opp (iterate opp d (\<lambda>l. f (l \<inter> {x. x \<bullet> k \<le> c}))) (iterate opp d (\<lambda>l. f (l \<inter> {x. c \<le> x \<bullet> k})))
  4736           done
  4261         = iterate opp d f" apply(subst(3) iterate_eq[OF _ *[rule_format]]) prefer 3
  4737       qed
  4262         apply(rule iterate_op[symmetric]) using goal1 by auto
  4738       also have "iterate opp d2 f = iterate opp d (\<lambda>l. f(l \<inter> {x. x\<bullet>k \<ge> c}))"
       
  4739         unfolding d2_def
       
  4740         apply (rule iterate_nonzero_image_lemma[unfolded o_def])
       
  4741         unfolding empty_as_interval
       
  4742         apply (rule goal1 division_of_finite operativeD[OF goal1(3)])+
       
  4743         unfolding empty_as_interval[symmetric]
       
  4744         apply (rule content_empty)
       
  4745       proof (rule, rule, rule, erule conjE)
       
  4746         fix l y
       
  4747         assume as: "l \<in> d" "y \<in> d" "l \<inter> {x. c \<le> x \<bullet> k} = y \<inter> {x. c \<le> x \<bullet> k}" "l \<noteq> y"
       
  4748         from division_ofD(4)[OF goal1(4) this(1)] guess u v by (elim exE) note l=this
       
  4749         show "f (l \<inter> {x. x \<bullet> k \<ge> c}) = neutral opp"
       
  4750         unfolding l interval_split[OF kc(4)]
       
  4751           apply (rule operativeD(1) goal1)+
       
  4752           unfolding interval_split[symmetric,OF kc(4)]
       
  4753           apply (rule division_split_right_inj)
       
  4754           apply (rule goal1)
       
  4755           unfolding l[symmetric]
       
  4756           apply (rule as(1))
       
  4757           apply (rule as(2))
       
  4758           apply (rule as kc(4))+
       
  4759           done
       
  4760       qed also have *: "\<forall>x\<in>d. f x = opp (f (x \<inter> {x. x \<bullet> k \<le> c})) (f (x \<inter> {x. c \<le> x \<bullet> k}))"
       
  4761         unfolding forall_in_division[OF goal1(4)]
       
  4762         apply (rule, rule, rule, rule operativeD(2))
       
  4763         using goal1(3) kc
       
  4764         by auto
       
  4765       have "opp (iterate opp d (\<lambda>l. f (l \<inter> {x. x \<bullet> k \<le> c}))) (iterate opp d (\<lambda>l. f (l \<inter> {x. c \<le> x \<bullet> k}))) =
       
  4766         iterate opp d f"
       
  4767         apply (subst(3) iterate_eq[OF _ *[rule_format]])
       
  4768         prefer 3
       
  4769         apply (rule iterate_op[symmetric])
       
  4770         using goal1
       
  4771         apply auto
       
  4772         done
  4263       finally show ?thesis by auto
  4773       finally show ?thesis by auto
  4264     qed qed qed
  4774     qed
  4265 
  4775   qed
  4266 lemma iterate_image_nonzero: assumes "monoidal opp"
  4776 qed
  4267   "finite s" "\<forall>x\<in>s. \<forall>y\<in>s. ~(x = y) \<and> f x = f y \<longrightarrow> g(f x) = neutral opp"
  4777 
  4268   shows "iterate opp (f ` s) g = iterate opp s (g \<circ> f)" using assms
  4778 lemma iterate_image_nonzero:
  4269 proof(induct rule:finite_subset_induct[OF assms(2) subset_refl])
  4779   assumes "monoidal opp"
  4270   case goal1 show ?case using assms(1) by auto
  4780     and "finite s"
  4271 next case goal2 have *:"\<And>x y. y = neutral opp \<Longrightarrow> x = opp y x" using assms(1) by auto
  4781     and "\<forall>x\<in>s. \<forall>y\<in>s. x \<noteq> y \<and> f x = f y \<longrightarrow> g (f x) = neutral opp"
  4272   show ?case unfolding image_insert apply(subst iterate_insert[OF assms(1)])
  4782   shows "iterate opp (f ` s) g = iterate opp s (g \<circ> f)"
  4273     apply(rule finite_imageI goal2)+
  4783   using assms
  4274     apply(cases "f a \<in> f ` F") unfolding if_P if_not_P apply(subst goal2(4)[OF assms(1) goal2(1)]) defer
  4784 proof (induct rule: finite_subset_induct[OF assms(2) subset_refl])
  4275     apply(subst iterate_insert[OF assms(1) goal2(1)]) defer
  4785   case goal1
  4276     apply(subst iterate_insert[OF assms(1) goal2(1)])
  4786   show ?case
  4277     unfolding if_not_P[OF goal2(3)] defer unfolding image_iff defer apply(erule bexE)
  4787     using assms(1) by auto
  4278     apply(rule *) unfolding o_def apply(rule_tac y=x in goal2(7)[rule_format])
  4788 next
  4279     using goal2 unfolding o_def by auto qed
  4789   case goal2
  4280 
  4790   have *: "\<And>x y. y = neutral opp \<Longrightarrow> x = opp y x"
  4281 lemma operative_tagged_division: assumes "monoidal opp" "operative opp f" "d tagged_division_of {a..b}"
  4791     using assms(1) by auto
  4282   shows "iterate(opp) d (\<lambda>(x,l). f l) = f {a..b}"
  4792   show ?case
  4283 proof- have *:"(\<lambda>(x,l). f l) = (f o snd)" unfolding o_def by(rule,auto) note assm = tagged_division_ofD[OF assms(3)]
  4793     unfolding image_insert
  4284   have "iterate(opp) d (\<lambda>(x,l). f l) = iterate opp (snd ` d) f" unfolding *
  4794     apply (subst iterate_insert[OF assms(1)])
  4285     apply(rule iterate_image_nonzero[symmetric,OF assms(1)]) apply(rule tagged_division_of_finite assms)+
  4795     apply (rule finite_imageI goal2)+
  4286     unfolding Ball_def split_paired_All snd_conv apply(rule,rule,rule,rule,rule,rule,rule,erule conjE)
  4796     apply (cases "f a \<in> f ` F")
  4287   proof- fix a b aa ba assume as:"(a, b) \<in> d" "(aa, ba) \<in> d" "(a, b) \<noteq> (aa, ba)" "b = ba"
  4797     unfolding if_P if_not_P
  4288     guess u v using assm(4)[OF as(1)] apply-by(erule exE)+ note uv=this
  4798     apply (subst goal2(4)[OF assms(1) goal2(1)])
  4289     show "f b = neutral opp" unfolding uv apply(rule operativeD(1)[OF assms(2)])
  4799     defer
  4290       unfolding content_eq_0_interior using tagged_division_ofD(5)[OF assms(3) as(1-3)]
  4800     apply (subst iterate_insert[OF assms(1) goal2(1)])
  4291       unfolding as(4)[symmetric] uv by auto
  4801     defer
  4292   qed also have "\<dots> = f {a..b}"
  4802     apply (subst iterate_insert[OF assms(1) goal2(1)])
       
  4803     unfolding if_not_P[OF goal2(3)]
       
  4804     defer unfolding image_iff
       
  4805     defer
       
  4806     apply (erule bexE)
       
  4807     apply (rule *)
       
  4808     unfolding o_def
       
  4809     apply (rule_tac y=x in goal2(7)[rule_format])
       
  4810     using goal2
       
  4811     unfolding o_def
       
  4812     apply auto
       
  4813     done
       
  4814 qed
       
  4815 
       
  4816 lemma operative_tagged_division:
       
  4817   assumes "monoidal opp"
       
  4818     and "operative opp f"
       
  4819     and "d tagged_division_of {a..b}"
       
  4820   shows "iterate opp d (\<lambda>(x,l). f l) = f {a..b}"
       
  4821 proof -
       
  4822   have *: "(\<lambda>(x,l). f l) = f \<circ> snd"
       
  4823     unfolding o_def by rule auto note assm = tagged_division_ofD[OF assms(3)]
       
  4824   have "iterate opp d (\<lambda>(x,l). f l) = iterate opp (snd ` d) f"
       
  4825     unfolding *
       
  4826     apply (rule iterate_image_nonzero[symmetric,OF assms(1)])
       
  4827     apply (rule tagged_division_of_finite assms)+
       
  4828     unfolding Ball_def split_paired_All snd_conv
       
  4829     apply (rule, rule, rule, rule, rule, rule, rule, erule conjE)
       
  4830   proof -
       
  4831     fix a b aa ba
       
  4832     assume as: "(a, b) \<in> d" "(aa, ba) \<in> d" "(a, b) \<noteq> (aa, ba)" "b = ba"
       
  4833     guess u v using assm(4)[OF as(1)] by (elim exE) note uv=this
       
  4834     show "f b = neutral opp"
       
  4835       unfolding uv
       
  4836       apply (rule operativeD(1)[OF assms(2)])
       
  4837       unfolding content_eq_0_interior
       
  4838       using tagged_division_ofD(5)[OF assms(3) as(1-3)]
       
  4839       unfolding as(4)[symmetric] uv
       
  4840       apply auto
       
  4841       done
       
  4842   qed
       
  4843   also have "\<dots> = f {a..b}"
  4293     using operative_division[OF assms(1-2) division_of_tagged_division[OF assms(3)]] .
  4844     using operative_division[OF assms(1-2) division_of_tagged_division[OF assms(3)]] .
  4294   finally show ?thesis . qed
  4845   finally show ?thesis .
       
  4846 qed
       
  4847 
  4295 
  4848 
  4296 subsection {* Additivity of content. *}
  4849 subsection {* Additivity of content. *}
  4297 
  4850 
  4298 lemma setsum_iterate:
  4851 lemma setsum_iterate:
  4299   assumes "finite s" shows "setsum f s = iterate op + s f"
  4852   assumes "finite s"
       
  4853   shows "setsum f s = iterate op + s f"
  4300 proof -
  4854 proof -
  4301   have *: "setsum f s = setsum f (support op + f s)"
  4855   have *: "setsum f s = setsum f (support op + f s)"
  4302     apply (rule setsum_mono_zero_right)
  4856     apply (rule setsum_mono_zero_right)
  4303     unfolding support_def neutral_monoid using assms by auto
  4857     unfolding support_def neutral_monoid
       
  4858     using assms
       
  4859     apply auto
       
  4860     done
  4304   then show ?thesis unfolding * iterate_def fold'_def setsum.eq_fold
  4861   then show ?thesis unfolding * iterate_def fold'_def setsum.eq_fold
  4305     unfolding neutral_monoid by (simp add: comp_def)
  4862     unfolding neutral_monoid by (simp add: comp_def)
  4306 qed
  4863 qed
  4307 
  4864 
  4308 lemma additive_content_division: assumes "d division_of {a..b}"
  4865 lemma additive_content_division:
  4309   shows "setsum content d = content({a..b})"
  4866   assumes "d division_of {a..b}"
       
  4867   shows "setsum content d = content {a..b}"
  4310   unfolding operative_division[OF monoidal_monoid operative_content assms,symmetric]
  4868   unfolding operative_division[OF monoidal_monoid operative_content assms,symmetric]
  4311   apply(subst setsum_iterate) using assms by auto
  4869   apply (subst setsum_iterate)
       
  4870   using assms
       
  4871   apply auto
       
  4872   done
  4312 
  4873 
  4313 lemma additive_content_tagged_division:
  4874 lemma additive_content_tagged_division:
  4314   assumes "d tagged_division_of {a..b}"
  4875   assumes "d tagged_division_of {a..b}"
  4315   shows "setsum (\<lambda>(x,l). content l) d = content({a..b})"
  4876   shows "setsum (\<lambda>(x,l). content l) d = content {a..b}"
  4316   unfolding operative_tagged_division[OF monoidal_monoid operative_content assms,symmetric]
  4877   unfolding operative_tagged_division[OF monoidal_monoid operative_content assms,symmetric]
  4317   apply(subst setsum_iterate) using assms by auto
  4878   apply (subst setsum_iterate)
       
  4879   using assms
       
  4880   apply auto
       
  4881   done
       
  4882 
  4318 
  4883 
  4319 subsection {* Finally, the integral of a constant *}
  4884 subsection {* Finally, the integral of a constant *}
  4320 
  4885 
  4321 lemma has_integral_const[intro]:
  4886 lemma has_integral_const[intro]:
  4322   "((\<lambda>x. c) has_integral (content({a..b::'a::ordered_euclidean_space}) *\<^sub>R c)) ({a..b})"
  4887   fixes a b :: "'a::ordered_euclidean_space"
  4323   unfolding has_integral apply(rule,rule,rule_tac x="\<lambda>x. ball x 1" in exI)
  4888   shows "((\<lambda>x. c) has_integral (content {a..b} *\<^sub>R c)) {a..b}"
  4324   apply(rule,rule gauge_trivial)apply(rule,rule,erule conjE)
  4889   unfolding has_integral
  4325   unfolding split_def apply(subst scaleR_left.setsum[symmetric, unfolded o_def])
  4890   apply rule
  4326   defer apply(subst additive_content_tagged_division[unfolded split_def]) apply assumption by auto
  4891   apply rule
       
  4892   apply (rule_tac x="\<lambda>x. ball x 1" in exI)
       
  4893   apply rule
       
  4894   apply (rule gauge_trivial)
       
  4895   apply rule
       
  4896   apply rule
       
  4897   apply (erule conjE)
       
  4898   unfolding split_def
       
  4899   apply (subst scaleR_left.setsum[symmetric, unfolded o_def])
       
  4900   defer
       
  4901   apply (subst additive_content_tagged_division[unfolded split_def])
       
  4902   apply assumption
       
  4903   apply auto
       
  4904   done
  4327 
  4905 
  4328 lemma integral_const[simp]:
  4906 lemma integral_const[simp]:
  4329   fixes a b :: "'a::ordered_euclidean_space"
  4907   fixes a b :: "'a::ordered_euclidean_space"
  4330   shows "integral {a .. b} (\<lambda>x. c) = content {a .. b} *\<^sub>R c"
  4908   shows "integral {a .. b} (\<lambda>x. c) = content {a .. b} *\<^sub>R c"
  4331   by (rule integral_unique) (rule has_integral_const)
  4909   by (rule integral_unique) (rule has_integral_const)
  4332 
  4910 
       
  4911 
  4333 subsection {* Bounds on the norm of Riemann sums and the integral itself. *}
  4912 subsection {* Bounds on the norm of Riemann sums and the integral itself. *}
  4334 
  4913 
  4335 lemma dsum_bound: assumes "p division_of {a..b}" "norm(c) \<le> e"
  4914 lemma dsum_bound:
  4336   shows "norm(setsum (\<lambda>l. content l *\<^sub>R c) p) \<le> e * content({a..b})" (is "?l \<le> ?r")
  4915   assumes "p division_of {a..b}"
  4337   apply(rule order_trans,rule norm_setsum) unfolding norm_scaleR setsum_left_distrib[symmetric]
  4916     and "norm c \<le> e"
  4338   apply(rule order_trans[OF mult_left_mono],rule assms,rule setsum_abs_ge_zero)
  4917   shows "norm (setsum (\<lambda>l. content l *\<^sub>R c) p) \<le> e * content({a..b})"
  4339   apply(subst mult_commute) apply(rule mult_left_mono)
  4918   apply (rule order_trans)
  4340   apply(rule order_trans[of _ "setsum content p"]) apply(rule eq_refl,rule setsum_cong2)
  4919   apply (rule norm_setsum)
  4341   apply(subst abs_of_nonneg) unfolding additive_content_division[OF assms(1)]
  4920   unfolding norm_scaleR setsum_left_distrib[symmetric]
  4342 proof- from order_trans[OF norm_ge_zero[of c] assms(2)] show "0 \<le> e" .
  4921   apply (rule order_trans[OF mult_left_mono])
  4343   fix x assume "x\<in>p" from division_ofD(4)[OF assms(1) this] guess u v apply-by(erule exE)+
  4922   apply (rule assms)
  4344   thus "0 \<le> content x" using content_pos_le by auto
  4923   apply (rule setsum_abs_ge_zero)
  4345 qed(insert assms,auto)
  4924   apply (subst mult_commute)
  4346 
  4925   apply (rule mult_left_mono)
  4347 lemma rsum_bound: assumes "p tagged_division_of {a..b}" "\<forall>x\<in>{a..b}. norm(f x) \<le> e"
  4926   apply (rule order_trans[of _ "setsum content p"])
  4348   shows "norm(setsum (\<lambda>(x,k). content k *\<^sub>R f x) p) \<le> e * content({a..b})"
  4927   apply (rule eq_refl)
  4349 proof(cases "{a..b} = {}") case True
  4928   apply (rule setsum_cong2)
  4350   show ?thesis using assms(1) unfolding True tagged_division_of_trivial by auto
  4929   apply (subst abs_of_nonneg)
  4351 next case False show ?thesis
  4930   unfolding additive_content_division[OF assms(1)]
  4352     apply(rule order_trans,rule norm_setsum) unfolding split_def norm_scaleR
  4931 proof -
  4353     apply(rule order_trans[OF setsum_mono]) apply(rule mult_left_mono[OF _ abs_ge_zero, of _ e]) defer
  4932   from order_trans[OF norm_ge_zero[of c] assms(2)]
  4354     unfolding setsum_left_distrib[symmetric] apply(subst mult_commute) apply(rule mult_left_mono)
  4933   show "0 \<le> e" .
  4355     apply(rule order_trans[of _ "setsum (content \<circ> snd) p"]) apply(rule eq_refl,rule setsum_cong2)
  4934   fix x assume "x \<in> p"
  4356     apply(subst o_def, rule abs_of_nonneg)
  4935   from division_ofD(4)[OF assms(1) this] guess u v by (elim exE)
  4357   proof- show "setsum (content \<circ> snd) p \<le> content {a..b}" apply(rule eq_refl)
  4936   then show "0 \<le> content x"
  4358       unfolding additive_content_tagged_division[OF assms(1),symmetric] split_def by auto
  4937     using content_pos_le by auto
       
  4938 qed (insert assms, auto)
       
  4939 
       
  4940 lemma rsum_bound:
       
  4941   assumes "p tagged_division_of {a..b}"
       
  4942     and "\<forall>x\<in>{a..b}. norm (f x) \<le> e"
       
  4943   shows "norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p) \<le> e * content {a..b}"
       
  4944 proof (cases "{a..b} = {}")
       
  4945   case True
       
  4946   show ?thesis
       
  4947     using assms(1) unfolding True tagged_division_of_trivial by auto
       
  4948 next
       
  4949   case False
       
  4950   show ?thesis
       
  4951     apply (rule order_trans)
       
  4952     apply (rule norm_setsum)
       
  4953     unfolding split_def norm_scaleR
       
  4954     apply (rule order_trans[OF setsum_mono])
       
  4955     apply (rule mult_left_mono[OF _ abs_ge_zero, of _ e])
       
  4956     defer
       
  4957     unfolding setsum_left_distrib[symmetric]
       
  4958     apply (subst mult_commute)
       
  4959     apply (rule mult_left_mono)
       
  4960     apply (rule order_trans[of _ "setsum (content \<circ> snd) p"])
       
  4961     apply (rule eq_refl)
       
  4962     apply (rule setsum_cong2)
       
  4963     apply (subst o_def)
       
  4964     apply (rule abs_of_nonneg)
       
  4965   proof -
       
  4966     show "setsum (content \<circ> snd) p \<le> content {a..b}"
       
  4967       apply (rule eq_refl)
       
  4968       unfolding additive_content_tagged_division[OF assms(1),symmetric] split_def
       
  4969       apply auto
       
  4970       done
  4359     guess w using nonempty_witness[OF False] .
  4971     guess w using nonempty_witness[OF False] .
  4360     thus "e\<ge>0" apply-apply(rule order_trans) defer apply(rule assms(2)[rule_format],assumption) by auto
  4972     then show "e \<ge> 0"
  4361     fix xk assume *:"xk\<in>p" guess x k  using surj_pair[of xk] apply-by(erule exE)+ note xk = this *[unfolded this]
  4973       apply -
  4362     from tagged_division_ofD(4)[OF assms(1) xk(2)] guess u v apply-by(erule exE)+ note uv=this
  4974       apply (rule order_trans)
  4363     show "0\<le> content (snd xk)" unfolding xk snd_conv uv by(rule content_pos_le)
  4975       defer
  4364     show "norm (f (fst xk)) \<le> e" unfolding xk fst_conv using tagged_division_ofD(2,3)[OF assms(1) xk(2)] assms(2) by auto
  4976       apply (rule assms(2)[rule_format])
  4365   qed qed
  4977       apply assumption
       
  4978       apply auto
       
  4979       done
       
  4980     fix xk
       
  4981     assume *: "xk \<in> p"
       
  4982     guess x k using surj_pair[of xk] by (elim exE) note xk = this *[unfolded this]
       
  4983     from tagged_division_ofD(4)[OF assms(1) xk(2)] guess u v by (elim exE) note uv=this
       
  4984     show "0 \<le> content (snd xk)"
       
  4985       unfolding xk snd_conv uv by(rule content_pos_le)
       
  4986     show "norm (f (fst xk)) \<le> e"
       
  4987       unfolding xk fst_conv using tagged_division_ofD(2,3)[OF assms(1) xk(2)] assms(2) by auto
       
  4988   qed
       
  4989 qed
  4366 
  4990 
  4367 lemma rsum_diff_bound:
  4991 lemma rsum_diff_bound:
  4368   assumes "p tagged_division_of {a..b}"  "\<forall>x\<in>{a..b}. norm(f x - g x) \<le> e"
  4992   assumes "p tagged_division_of {a..b}"
  4369   shows "norm(setsum (\<lambda>(x,k). content k *\<^sub>R f x) p - setsum (\<lambda>(x,k). content k *\<^sub>R g x) p) \<le> e * content({a..b})"
  4993     and "\<forall>x\<in>{a..b}. norm (f x - g x) \<le> e"
  4370   apply(rule order_trans[OF _ rsum_bound[OF assms]]) apply(rule eq_refl) apply(rule arg_cong[where f=norm])
  4994   shows "norm (setsum (\<lambda>(x,k). content k *\<^sub>R f x) p - setsum (\<lambda>(x,k). content k *\<^sub>R g x) p) \<le>
  4371   unfolding setsum_subtractf[symmetric] apply(rule setsum_cong2) unfolding scaleR_diff_right by auto
  4995     e * content {a..b}"
  4372 
  4996   apply (rule order_trans[OF _ rsum_bound[OF assms]])
  4373 lemma has_integral_bound: fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'b::real_normed_vector"
  4997   apply (rule eq_refl)
  4374   assumes "0 \<le> B" "(f has_integral i) ({a..b})" "\<forall>x\<in>{a..b}. norm(f x) \<le> B"
  4998   apply (rule arg_cong[where f=norm])
       
  4999   unfolding setsum_subtractf[symmetric]
       
  5000   apply (rule setsum_cong2)
       
  5001   unfolding scaleR_diff_right
       
  5002   apply auto
       
  5003   done
       
  5004 
       
  5005 lemma has_integral_bound:
       
  5006   fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::real_normed_vector"
       
  5007   assumes "0 \<le> B"
       
  5008     and "(f has_integral i) {a..b}"
       
  5009     and "\<forall>x\<in>{a..b}. norm (f x) \<le> B"
  4375   shows "norm i \<le> B * content {a..b}"
  5010   shows "norm i \<le> B * content {a..b}"
  4376 proof- let ?P = "content {a..b} > 0" { presume "?P \<Longrightarrow> ?thesis"
  5011 proof -
  4377     thus ?thesis proof(cases ?P) case False
  5012   let ?P = "content {a..b} > 0"
  4378       hence *:"content {a..b} = 0" using content_lt_nz by auto
  5013   {
  4379       hence **:"i = 0" using assms(2) apply(subst has_integral_null_eq[symmetric]) by auto
  5014     presume "?P \<Longrightarrow> ?thesis"
  4380       show ?thesis unfolding * ** using assms(1) by auto
  5015     then show ?thesis
  4381     qed auto } assume ab:?P
  5016     proof (cases ?P)
  4382   { presume "\<not> ?thesis \<Longrightarrow> False" thus ?thesis by auto }
  5017       case False
  4383   assume "\<not> ?thesis" hence *:"norm i - B * content {a..b} > 0" by auto
  5018       then have *: "content {a..b} = 0"
  4384   from assms(2)[unfolded has_integral,rule_format,OF *] guess d apply-by(erule exE conjE)+ note d=this[rule_format]
  5019         using content_lt_nz by auto
       
  5020       hence **: "i = 0"
       
  5021         using assms(2)
       
  5022         apply (subst has_integral_null_eq[symmetric])
       
  5023         apply auto
       
  5024         done
       
  5025       show ?thesis
       
  5026         unfolding * ** using assms(1) by auto
       
  5027     qed auto
       
  5028   }
       
  5029   assume ab: ?P
       
  5030   { presume "\<not> ?thesis \<Longrightarrow> False" then show ?thesis by auto }
       
  5031   assume "\<not> ?thesis"
       
  5032   then have *: "norm i - B * content {a..b} > 0"
       
  5033     by auto
       
  5034   from assms(2)[unfolded has_integral,rule_format,OF *]
       
  5035   guess d by (elim exE conjE) note d=this[rule_format]
  4385   from fine_division_exists[OF this(1), of a b] guess p . note p=this
  5036   from fine_division_exists[OF this(1), of a b] guess p . note p=this
  4386   have *:"\<And>s B. norm s \<le> B \<Longrightarrow> \<not> (norm (s - i) < norm i - B)"
  5037   have *: "\<And>s B. norm s \<le> B \<Longrightarrow> \<not> norm (s - i) < norm i - B"
  4387   proof- case goal1 thus ?case unfolding not_less
  5038   proof -
  4388     using norm_triangle_sub[of i s] unfolding norm_minus_commute by auto
  5039     case goal1
  4389   qed show False using d(2)[OF conjI[OF p]] *[OF rsum_bound[OF p(1) assms(3)]] by auto qed
  5040     then show ?case
       
  5041       unfolding not_less
       
  5042       using norm_triangle_sub[of i s]
       
  5043       unfolding norm_minus_commute
       
  5044       by auto
       
  5045   qed
       
  5046   show False
       
  5047     using d(2)[OF conjI[OF p]] *[OF rsum_bound[OF p(1) assms(3)]] by auto
       
  5048 qed
       
  5049 
  4390 
  5050 
  4391 subsection {* Similar theorems about relationship among components. *}
  5051 subsection {* Similar theorems about relationship among components. *}
  4392 
  5052 
  4393 lemma rsum_component_le: fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'b::euclidean_space"
  5053 lemma rsum_component_le:
  4394   assumes "p tagged_division_of {a..b}"  "\<forall>x\<in>{a..b}. (f x)\<bullet>i \<le> (g x)\<bullet>i"
  5054   fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::euclidean_space"
       
  5055   assumes "p tagged_division_of {a..b}"
       
  5056     and "\<forall>x\<in>{a..b}. (f x)\<bullet>i \<le> (g x)\<bullet>i"
  4395   shows "(setsum (\<lambda>(x,k). content k *\<^sub>R f x) p)\<bullet>i \<le> (setsum (\<lambda>(x,k). content k *\<^sub>R g x) p)\<bullet>i"
  5057   shows "(setsum (\<lambda>(x,k). content k *\<^sub>R f x) p)\<bullet>i \<le> (setsum (\<lambda>(x,k). content k *\<^sub>R g x) p)\<bullet>i"
  4396   unfolding inner_setsum_left apply(rule setsum_mono) apply safe
  5058   unfolding inner_setsum_left
  4397 proof- fix a b assume ab:"(a,b) \<in> p" note assm = tagged_division_ofD(2-4)[OF assms(1) ab]
  5059   apply (rule setsum_mono)
  4398   from this(3) guess u v apply-by(erule exE)+ note b=this
  5060   apply safe
  4399   show "(content b *\<^sub>R f a) \<bullet> i \<le> (content b *\<^sub>R g a) \<bullet> i" unfolding b
  5061 proof -
  4400     unfolding inner_simps real_scaleR_def apply(rule mult_left_mono)
  5062   fix a b
  4401     defer apply(rule content_pos_le,rule assms(2)[rule_format]) using assm by auto qed
  5063   assume ab: "(a, b) \<in> p"
       
  5064   note assm = tagged_division_ofD(2-4)[OF assms(1) ab]
       
  5065   from this(3) guess u v by (elim exE) note b=this
       
  5066   show "(content b *\<^sub>R f a) \<bullet> i \<le> (content b *\<^sub>R g a) \<bullet> i"
       
  5067     unfolding b
       
  5068     unfolding inner_simps real_scaleR_def
       
  5069     apply (rule mult_left_mono)
       
  5070     defer
       
  5071     apply (rule content_pos_le,rule assms(2)[rule_format])
       
  5072     using assm
       
  5073     apply auto
       
  5074     done
       
  5075 qed
  4402 
  5076 
  4403 lemma has_integral_component_le:
  5077 lemma has_integral_component_le:
  4404   fixes f g::"'a::ordered_euclidean_space \<Rightarrow> 'b::euclidean_space"
  5078   fixes f g :: "'a::ordered_euclidean_space \<Rightarrow> 'b::euclidean_space"
  4405   assumes k: "k \<in> Basis"
  5079   assumes k: "k \<in> Basis"
  4406   assumes "(f has_integral i) s" "(g has_integral j) s"  "\<forall>x\<in>s. (f x)\<bullet>k \<le> (g x)\<bullet>k"
  5080   assumes "(f has_integral i) s" "(g has_integral j) s"
       
  5081     and "\<forall>x\<in>s. (f x)\<bullet>k \<le> (g x)\<bullet>k"
  4407   shows "i\<bullet>k \<le> j\<bullet>k"
  5082   shows "i\<bullet>k \<le> j\<bullet>k"
  4408 proof -
  5083 proof -
  4409   have lem:"\<And>a b i (j::'b). \<And>g f::'a \<Rightarrow> 'b. (f has_integral i) ({a..b}) \<Longrightarrow>
  5084   have lem:"\<And>a b i (j::'b). \<And>g f::'a \<Rightarrow> 'b. (f has_integral i) ({a..b}) \<Longrightarrow>
  4410     (g has_integral j) ({a..b}) \<Longrightarrow> \<forall>x\<in>{a..b}. (f x)\<bullet>k \<le> (g x)\<bullet>k \<Longrightarrow> i\<bullet>k \<le> j\<bullet>k"
  5085     (g has_integral j) ({a..b}) \<Longrightarrow> \<forall>x\<in>{a..b}. (f x)\<bullet>k \<le> (g x)\<bullet>k \<Longrightarrow> i\<bullet>k \<le> j\<bullet>k"
  4411   proof (rule ccontr)
  5086   proof (rule ccontr)
  4412     case goal1
  5087     case goal1
  4413     then have *: "0 < (i\<bullet>k - j\<bullet>k) / 3" by auto
  5088     then have *: "0 < (i\<bullet>k - j\<bullet>k) / 3"
  4414     guess d1 using goal1(1)[unfolded has_integral,rule_format,OF *] apply-by(erule exE conjE)+ note d1=this[rule_format]
  5089       by auto
  4415     guess d2 using goal1(2)[unfolded has_integral,rule_format,OF *] apply-by(erule exE conjE)+ note d2=this[rule_format]
  5090     guess d1 using goal1(1)[unfolded has_integral,rule_format,OF *] by (elim exE conjE) note d1=this[rule_format]
       
  5091     guess d2 using goal1(2)[unfolded has_integral,rule_format,OF *] by (elim exE conjE) note d2=this[rule_format]
  4416     guess p using fine_division_exists[OF gauge_inter[OF d1(1) d2(1)], of a b] unfolding fine_inter .
  5092     guess p using fine_division_exists[OF gauge_inter[OF d1(1) d2(1)], of a b] unfolding fine_inter .
  4417     note p = this(1) conjunctD2[OF this(2)]
  5093     note p = this(1) conjunctD2[OF this(2)]
  4418     note le_less_trans[OF Basis_le_norm[OF k]]
  5094     note le_less_trans[OF Basis_le_norm[OF k]]
  4419     note this[OF d1(2)[OF conjI[OF p(1,2)]]] this[OF d2(2)[OF conjI[OF p(1,3)]]]
  5095     note this[OF d1(2)[OF conjI[OF p(1,2)]]] this[OF d2(2)[OF conjI[OF p(1,3)]]]
  4420     thus False
  5096     then show False
  4421       unfolding inner_simps
  5097       unfolding inner_simps
  4422       using rsum_component_le[OF p(1) goal1(3)]
  5098       using rsum_component_le[OF p(1) goal1(3)]
  4423       by (simp add: abs_real_def split: split_if_asm)
  5099       by (simp add: abs_real_def split: split_if_asm)
  4424   qed let ?P = "\<exists>a b. s = {a..b}"
  5100   qed
  4425   { presume "\<not> ?P \<Longrightarrow> ?thesis" thus ?thesis proof(cases ?P)
  5101   let ?P = "\<exists>a b. s = {a..b}"
  4426       case True then guess a b apply-by(erule exE)+ note s=this
  5102   {
  4427       show ?thesis apply(rule lem) using assms[unfolded s] by auto
  5103     presume "\<not> ?P \<Longrightarrow> ?thesis"
  4428     qed auto } assume as:"\<not> ?P"
  5104     then show ?thesis
  4429   { presume "\<not> ?thesis \<Longrightarrow> False" thus ?thesis by auto }
  5105     proof (cases ?P)
  4430   assume "\<not> i\<bullet>k \<le> j\<bullet>k" hence ij:"(i\<bullet>k - j\<bullet>k) / 3 > 0" by auto
  5106       case True
       
  5107       then guess a b by (elim exE) note s=this
       
  5108       show ?thesis
       
  5109         apply (rule lem)
       
  5110         using assms[unfolded s]
       
  5111         apply auto
       
  5112         done
       
  5113     qed auto
       
  5114   }
       
  5115   assume as: "\<not> ?P"
       
  5116   { presume "\<not> ?thesis \<Longrightarrow> False" then show ?thesis by auto }
       
  5117   assume "\<not> i\<bullet>k \<le> j\<bullet>k"
       
  5118   then have ij: "(i\<bullet>k - j\<bullet>k) / 3 > 0"
       
  5119     by auto
  4431   note has_integral_altD[OF _ as this]
  5120   note has_integral_altD[OF _ as this]
  4432   from this[OF assms(2)] this[OF assms(3)] guess B1 B2 . note B=this[rule_format]
  5121   from this[OF assms(2)] this[OF assms(3)] guess B1 B2 . note B=this[rule_format]
  4433   have "bounded (ball 0 B1 \<union> ball (0::'a) B2)" unfolding bounded_Un by(rule conjI bounded_ball)+
  5122   have "bounded (ball 0 B1 \<union> ball (0::'a) B2)"
  4434   from bounded_subset_closed_interval[OF this] guess a b apply- by(erule exE)+
  5123     unfolding bounded_Un by(rule conjI bounded_ball)+
       
  5124   from bounded_subset_closed_interval[OF this] guess a b by (elim exE)
  4435   note ab = conjunctD2[OF this[unfolded Un_subset_iff]]
  5125   note ab = conjunctD2[OF this[unfolded Un_subset_iff]]
  4436   guess w1 using B(2)[OF ab(1)] .. note w1=conjunctD2[OF this]
  5126   guess w1 using B(2)[OF ab(1)] .. note w1=conjunctD2[OF this]
  4437   guess w2 using B(4)[OF ab(2)] .. note w2=conjunctD2[OF this]
  5127   guess w2 using B(4)[OF ab(2)] .. note w2=conjunctD2[OF this]
  4438   have *:"\<And>w1 w2 j i::real .\<bar>w1 - i\<bar> < (i - j) / 3 \<Longrightarrow> \<bar>w2 - j\<bar> < (i - j) / 3 \<Longrightarrow> w1 \<le> w2 \<Longrightarrow> False"
  5128   have *: "\<And>w1 w2 j i::real .\<bar>w1 - i\<bar> < (i - j) / 3 \<Longrightarrow> \<bar>w2 - j\<bar> < (i - j) / 3 \<Longrightarrow> w1 \<le> w2 \<Longrightarrow> False"
  4439     by (simp add: abs_real_def split: split_if_asm)
  5129     by (simp add: abs_real_def split: split_if_asm)
  4440   note le_less_trans[OF Basis_le_norm[OF k]] note this[OF w1(2)] this[OF w2(2)] moreover
  5130   note le_less_trans[OF Basis_le_norm[OF k]]
  4441   have "w1\<bullet>k \<le> w2\<bullet>k" apply(rule lem[OF w1(1) w2(1)]) using assms by auto ultimately
  5131   note this[OF w1(2)] this[OF w2(2)]
  4442   show False unfolding inner_simps by(rule *)
  5132   moreover
       
  5133   have "w1\<bullet>k \<le> w2\<bullet>k"
       
  5134     apply (rule lem[OF w1(1) w2(1)])
       
  5135     using assms
       
  5136     apply auto
       
  5137     done
       
  5138   ultimately show False
       
  5139     unfolding inner_simps by(rule *)
  4443 qed
  5140 qed
  4444 
  5141 
  4445 lemma integral_component_le: fixes g f::"'a::ordered_euclidean_space \<Rightarrow> 'b::euclidean_space"
  5142 lemma integral_component_le:
  4446   assumes "k\<in>Basis" "f integrable_on s" "g integrable_on s"  "\<forall>x\<in>s. (f x)\<bullet>k \<le> (g x)\<bullet>k"
  5143   fixes g f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::euclidean_space"
       
  5144   assumes "k \<in> Basis"
       
  5145     and "f integrable_on s" "g integrable_on s"
       
  5146     and "\<forall>x\<in>s. (f x)\<bullet>k \<le> (g x)\<bullet>k"
  4447   shows "(integral s f)\<bullet>k \<le> (integral s g)\<bullet>k"
  5147   shows "(integral s f)\<bullet>k \<le> (integral s g)\<bullet>k"
  4448   apply(rule has_integral_component_le) using integrable_integral assms by auto
  5148   apply (rule has_integral_component_le)
  4449 
  5149   using integrable_integral assms
  4450 lemma has_integral_component_nonneg: fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'b::euclidean_space"
  5150   apply auto
  4451   assumes "k\<in>Basis" "(f has_integral i) s" "\<forall>x\<in>s. 0 \<le> (f x)\<bullet>k" shows "0 \<le> i\<bullet>k"
  5151   done
  4452   using has_integral_component_le[OF assms(1) has_integral_0 assms(2)] using assms(3-) by auto
  5152 
  4453 
  5153 lemma has_integral_component_nonneg:
  4454 lemma integral_component_nonneg: fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'b::euclidean_space"
  5154   fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::euclidean_space"
  4455   assumes "k\<in>Basis" "f integrable_on s" "\<forall>x\<in>s. 0 \<le> (f x)\<bullet>k" shows "0 \<le> (integral s f)\<bullet>k"
  5155   assumes "k \<in> Basis"
  4456   apply(rule has_integral_component_nonneg) using assms by auto
  5156     and "(f has_integral i) s"
  4457 
  5157     and "\<forall>x\<in>s. 0 \<le> (f x)\<bullet>k"
  4458 lemma has_integral_component_neg: fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'b::ordered_euclidean_space"
  5158   shows "0 \<le> i\<bullet>k"
  4459   assumes "k\<in>Basis" "(f has_integral i) s" "\<forall>x\<in>s. (f x)\<bullet>k \<le> 0"shows "i\<bullet>k \<le> 0"
  5159   using has_integral_component_le[OF assms(1) has_integral_0 assms(2)]
  4460   using has_integral_component_le[OF assms(1,2) has_integral_0] assms(2-) by auto
  5160   using assms(3-)
       
  5161   by auto
       
  5162 
       
  5163 lemma integral_component_nonneg:
       
  5164   fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::euclidean_space"
       
  5165   assumes "k \<in> Basis"
       
  5166     and "f integrable_on s" "\<forall>x\<in>s. 0 \<le> (f x)\<bullet>k"
       
  5167   shows "0 \<le> (integral s f)\<bullet>k"
       
  5168   apply (rule has_integral_component_nonneg)
       
  5169   using assms
       
  5170   apply auto
       
  5171   done
       
  5172 
       
  5173 lemma has_integral_component_neg:
       
  5174   fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::ordered_euclidean_space"
       
  5175   assumes "k \<in> Basis"
       
  5176     and "(f has_integral i) s"
       
  5177     and "\<forall>x\<in>s. (f x)\<bullet>k \<le> 0"
       
  5178   shows "i\<bullet>k \<le> 0"
       
  5179   using has_integral_component_le[OF assms(1,2) has_integral_0] assms(2-)
       
  5180   by auto
  4461 
  5181 
  4462 lemma has_integral_component_lbound:
  5182 lemma has_integral_component_lbound:
  4463   fixes f::"'a::ordered_euclidean_space => 'b::ordered_euclidean_space"
  5183   fixes f :: "'a::ordered_euclidean_space => 'b::ordered_euclidean_space"
  4464   assumes "(f has_integral i) {a..b}"  "\<forall>x\<in>{a..b}. B \<le> f(x)\<bullet>k" "k\<in>Basis"
  5184   assumes "(f has_integral i) {a..b}"
       
  5185     and "\<forall>x\<in>{a..b}. B \<le> f(x)\<bullet>k"
       
  5186     and "k \<in> Basis"
  4465   shows "B * content {a..b} \<le> i\<bullet>k"
  5187   shows "B * content {a..b} \<le> i\<bullet>k"
  4466   using has_integral_component_le[OF assms(3) has_integral_const assms(1),of "(\<Sum>i\<in>Basis. B *\<^sub>R i)::'b"] assms(2-)
  5188   using has_integral_component_le[OF assms(3) has_integral_const assms(1),of "(\<Sum>i\<in>Basis. B *\<^sub>R i)::'b"] assms(2-)
  4467   by (auto simp add:field_simps)
  5189   by (auto simp add: field_simps)
  4468 
  5190 
  4469 lemma has_integral_component_ubound:
  5191 lemma has_integral_component_ubound:
  4470   fixes f::"'a::ordered_euclidean_space => 'b::ordered_euclidean_space"
  5192   fixes f::"'a::ordered_euclidean_space => 'b::ordered_euclidean_space"
  4471   assumes "(f has_integral i) {a..b}" "\<forall>x\<in>{a..b}. f x\<bullet>k \<le> B" "k\<in>Basis"
  5193   assumes "(f has_integral i) {a..b}"
  4472   shows "i\<bullet>k \<le> B * content({a..b})"
  5194     and "\<forall>x\<in>{a..b}. f x\<bullet>k \<le> B"
  4473   using has_integral_component_le[OF assms(3,1) has_integral_const, of "\<Sum>i\<in>Basis. B *\<^sub>R i"]  assms(2-)
  5195     and "k \<in> Basis"
  4474   by(auto simp add:field_simps)
  5196   shows "i\<bullet>k \<le> B * content {a..b}"
  4475 
  5197   using has_integral_component_le[OF assms(3,1) has_integral_const, of "\<Sum>i\<in>Basis. B *\<^sub>R i"] assms(2-)
  4476 lemma integral_component_lbound: fixes f::"'a::ordered_euclidean_space => 'b::ordered_euclidean_space"
  5198   by (auto simp add: field_simps)
  4477   assumes "f integrable_on {a..b}" "\<forall>x\<in>{a..b}. B \<le> f(x)\<bullet>k" "k\<in>Basis"
  5199 
  4478   shows "B * content({a..b}) \<le> (integral({a..b}) f)\<bullet>k"
  5200 lemma integral_component_lbound:
  4479   apply(rule has_integral_component_lbound) using assms unfolding has_integral_integral by auto
  5201   fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::ordered_euclidean_space"
  4480 
  5202   assumes "f integrable_on {a..b}"
  4481 lemma integral_component_ubound: fixes f::"'a::ordered_euclidean_space => 'b::ordered_euclidean_space"
  5203     and "\<forall>x\<in>{a..b}. B \<le> f(x)\<bullet>k"
  4482   assumes "f integrable_on {a..b}" "\<forall>x\<in>{a..b}. f(x)\<bullet>k \<le> B" "k\<in>Basis"
  5204     and "k \<in> Basis"
  4483   shows "(integral({a..b}) f)\<bullet>k \<le> B * content({a..b})"
  5205   shows "B * content {a..b} \<le> (integral({a..b}) f)\<bullet>k"
  4484   apply(rule has_integral_component_ubound) using assms unfolding has_integral_integral by auto
  5206   apply (rule has_integral_component_lbound)
       
  5207   using assms
       
  5208   unfolding has_integral_integral
       
  5209   apply auto
       
  5210   done
       
  5211 
       
  5212 lemma integral_component_ubound:
       
  5213   fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::ordered_euclidean_space"
       
  5214   assumes "f integrable_on {a..b}"
       
  5215     and "\<forall>x\<in>{a..b}. f x\<bullet>k \<le> B"
       
  5216     and "k \<in> Basis"
       
  5217   shows "(integral {a..b} f)\<bullet>k \<le> B * content {a..b}"
       
  5218   apply (rule has_integral_component_ubound)
       
  5219   using assms
       
  5220   unfolding has_integral_integral
       
  5221   apply auto
       
  5222   done
       
  5223 
  4485 
  5224 
  4486 subsection {* Uniform limit of integrable functions is integrable. *}
  5225 subsection {* Uniform limit of integrable functions is integrable. *}
  4487 
  5226 
  4488 lemma integrable_uniform_limit: fixes f::"'a::ordered_euclidean_space \<Rightarrow> 'b::banach"
  5227 lemma integrable_uniform_limit:
  4489   assumes "\<forall>e>0. \<exists>g. (\<forall>x\<in>{a..b}. norm(f x - g x) \<le> e) \<and> g integrable_on {a..b}"
  5228   fixes f :: "'a::ordered_euclidean_space \<Rightarrow> 'b::banach"
       
  5229   assumes "\<forall>e>0. \<exists>g. (\<forall>x\<in>{a..b}. norm (f x - g x) \<le> e) \<and> g integrable_on {a..b}"
  4490   shows "f integrable_on {a..b}"
  5230   shows "f integrable_on {a..b}"
  4491 proof- { presume *:"content {a..b} > 0 \<Longrightarrow> ?thesis"
  5231 proof -
  4492     show ?thesis apply cases apply(rule *,assumption)
  5232   {
  4493       unfolding content_lt_nz integrable_on_def using has_integral_null by auto }
  5233     presume *: "content {a..b} > 0 \<Longrightarrow> ?thesis"
  4494   assume as:"content {a..b} > 0"
  5234     show ?thesis
  4495   have *:"\<And>P. \<forall>e>(0::real). P e \<Longrightarrow> \<forall>n::nat. P (inverse (real n+1))" by auto
  5235       apply cases
       
  5236       apply (rule *)
       
  5237       apply assumption
       
  5238       unfolding content_lt_nz integrable_on_def
       
  5239       using has_integral_null
       
  5240       apply auto
       
  5241       done
       
  5242   }
       
  5243   assume as: "content {a..b} > 0"
       
  5244   have *: "\<And>P. \<forall>e>(0::real). P e \<Longrightarrow> \<forall>n::nat. P (inverse (real n + 1))"
       
  5245     by auto
  4496   from choice[OF *[OF assms]] guess g .. note g=conjunctD2[OF this[rule_format],rule_format]
  5246   from choice[OF *[OF assms]] guess g .. note g=conjunctD2[OF this[rule_format],rule_format]
  4497   from choice[OF allI[OF g(2)[unfolded integrable_on_def], of "\<lambda>x. x"]] guess i .. note i=this[rule_format]
  5247   from choice[OF allI[OF g(2)[unfolded integrable_on_def], of "\<lambda>x. x"]] guess i .. note i=this[rule_format]
  4498 
  5248 
  4499   have "Cauchy i" unfolding Cauchy_def
  5249   have "Cauchy i"
  4500   proof(rule,rule) fix e::real assume "e>0"
  5250     unfolding Cauchy_def
  4501     hence "e / 4 / content {a..b} > 0" using as by(auto simp add:field_simps)
  5251   proof (rule, rule)
  4502     then guess M apply-apply(subst(asm) real_arch_inv) by(erule exE conjE)+ note M=this
  5252     fix e :: real
  4503     show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (i m) (i n) < e" apply(rule_tac x=M in exI,rule,rule,rule,rule)
  5253     assume "e>0"
  4504     proof- case goal1 have "e/4>0" using `e>0` by auto note * = i[unfolded has_integral,rule_format,OF this]
  5254     then have "e / 4 / content {a..b} > 0"
  4505       from *[of m] guess gm apply-by(erule conjE exE)+ note gm=this[rule_format]
  5255       using as by (auto simp add: field_simps)
  4506       from *[of n] guess gn apply-by(erule conjE exE)+ note gn=this[rule_format]
  5256     then guess M
       
  5257       apply -
       
  5258       apply (subst(asm) real_arch_inv)
       
  5259       apply (elim exE conjE)
       
  5260       done
       
  5261     note M=this
       
  5262     show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (i m) (i n) < e"
       
  5263       apply (rule_tac x=M in exI,rule,rule,rule,rule)
       
  5264     proof -
       
  5265       case goal1
       
  5266       have "e/4>0" using `e>0` by auto
       
  5267       note * = i[unfolded has_integral,rule_format,OF this]
       
  5268       from *[of m] guess gm by (elim conjE exE) note gm=this[rule_format]
       
  5269       from *[of n] guess gn by (elim conjE exE) note gn=this[rule_format]
  4507       from fine_division_exists[OF gauge_inter[OF gm(1) gn(1)], of a b] guess p . note p=this
  5270       from fine_division_exists[OF gauge_inter[OF gm(1) gn(1)], of a b] guess p . note p=this
  4508       have lem2:"\<And>s1 s2 i1 i2. norm(s2 - s1) \<le> e/2 \<Longrightarrow> norm(s1 - i1) < e / 4 \<Longrightarrow> norm(s2 - i2) < e / 4 \<Longrightarrow>norm(i1 - i2) < e"
  5271       have lem2: "\<And>s1 s2 i1 i2. norm(s2 - s1) \<le> e/2 \<Longrightarrow> norm (s1 - i1) < e / 4 \<Longrightarrow>
  4509       proof- case goal1 have "norm (i1 - i2) \<le> norm (i1 - s1) + norm (s1 - s2) + norm (s2 - i2)"
  5272         norm (s2 - i2) < e / 4 \<Longrightarrow> norm (i1 - i2) < e"
       
  5273       proof -
       
  5274         case goal1
       
  5275         have "norm (i1 - i2) \<le> norm (i1 - s1) + norm (s1 - s2) + norm (s2 - i2)"
  4510           using norm_triangle_ineq[of "i1 - s1" "s1 - i2"]
  5276           using norm_triangle_ineq[of "i1 - s1" "s1 - i2"]
  4511           using norm_triangle_ineq[of "s1 - s2" "s2 - i2"] by(auto simp add:algebra_simps)
  5277           using norm_triangle_ineq[of "s1 - s2" "s2 - i2"]
  4512         also have "\<dots> < e" using goal1 unfolding norm_minus_commute by(auto simp add:algebra_simps)
  5278           by (auto simp add: algebra_simps)
       
  5279         also have "\<dots> < e"
       
  5280           using goal1
       
  5281           unfolding norm_minus_commute
       
  5282           by (auto simp add: algebra_simps)
  4513         finally show ?case .
  5283         finally show ?case .
  4514       qed
  5284       qed
  4515       show ?case unfolding dist_norm apply(rule lem2) defer
  5285       show ?case
  4516         apply(rule gm(2)[OF conjI[OF p(1)]],rule_tac[2] gn(2)[OF conjI[OF p(1)]])
  5286         unfolding dist_norm
  4517         using conjunctD2[OF p(2)[unfolded fine_inter]] apply- apply assumption+ apply(rule order_trans)
  5287         apply (rule lem2)
  4518         apply(rule rsum_diff_bound[OF p(1), where e="2 / real M"])
  5288         defer
  4519       proof show "2 / real M * content {a..b} \<le> e / 2" unfolding divide_inverse
  5289         apply (rule gm(2)[OF conjI[OF p(1)]],rule_tac[2] gn(2)[OF conjI[OF p(1)]])
  4520           using M as by(auto simp add:field_simps)
  5290         using conjunctD2[OF p(2)[unfolded fine_inter]]
  4521         fix x assume x:"x \<in> {a..b}"
  5291         apply -
       
  5292         apply assumption+
       
  5293         apply (rule order_trans)
       
  5294         apply (rule rsum_diff_bound[OF p(1), where e="2 / real M"])
       
  5295       proof
       
  5296         show "2 / real M * content {a..b} \<le> e / 2"
       
  5297           unfolding divide_inverse
       
  5298           using M as
       
  5299           by (auto simp add: field_simps)
       
  5300         fix x
       
  5301         assume x: "x \<in> {a..b}"
  4522         have "norm (f x - g n x) + norm (f x - g m x) \<le> inverse (real n + 1) + inverse (real m + 1)"
  5302         have "norm (f x - g n x) + norm (f x - g m x) \<le> inverse (real n + 1) + inverse (real m + 1)"
  4523             using g(1)[OF x, of n] g(1)[OF x, of m] by auto
  5303           using g(1)[OF x, of n] g(1)[OF x, of m] by auto
  4524         also have "\<dots> \<le> inverse (real M) + inverse (real M)" apply(rule add_mono)
  5304         also have "\<dots> \<le> inverse (real M) + inverse (real M)"
  4525           apply(rule_tac[!] le_imp_inverse_le) using goal1 M by auto
  5305           apply (rule add_mono)
  4526         also have "\<dots> = 2 / real M" unfolding divide_inverse by auto
  5306           apply (rule_tac[!] le_imp_inverse_le)
       
  5307           using goal1 M
       
  5308           apply auto
       
  5309           done
       
  5310         also have "\<dots> = 2 / real M"
       
  5311           unfolding divide_inverse by auto
  4527         finally show "norm (g n x - g m x) \<le> 2 / real M"
  5312         finally show "norm (g n x - g m x) \<le> 2 / real M"
  4528           using norm_triangle_le[of "g n x - f x" "f x - g m x" "2 / real M"]
  5313           using norm_triangle_le[of "g n x - f x" "f x - g m x" "2 / real M"]
  4529           by(auto simp add:algebra_simps simp add:norm_minus_commute)
  5314           by (auto simp add: algebra_simps simp add: norm_minus_commute)
  4530       qed qed qed
  5315       qed
       
  5316     qed
       
  5317   qed
  4531   from this[unfolded convergent_eq_cauchy[symmetric]] guess s .. note s=this
  5318   from this[unfolded convergent_eq_cauchy[symmetric]] guess s .. note s=this
  4532 
  5319 
  4533   show ?thesis unfolding integrable_on_def apply(rule_tac x=s in exI) unfolding has_integral
  5320   show ?thesis
  4534   proof(rule,rule)
  5321     unfolding integrable_on_def
  4535     case goal1 hence *:"e/3 > 0" by auto
  5322     apply (rule_tac x=s in exI)
       
  5323     unfolding has_integral
       
  5324   proof (rule, rule)
       
  5325     case goal1
       
  5326     then have *: "e/3 > 0" by auto
  4536     from LIMSEQ_D [OF s this] guess N1 .. note N1=this
  5327     from LIMSEQ_D [OF s this] guess N1 .. note N1=this
  4537     from goal1 as have "e / 3 / content {a..b} > 0" by(auto simp add:field_simps)
  5328     from goal1 as have "e / 3 / content {a..b} > 0"
  4538     from real_arch_invD[OF this] guess N2 apply-by(erule exE conjE)+ note N2=this
  5329       by (auto simp add: field_simps)
       
  5330     from real_arch_invD[OF this] guess N2 by (elim exE conjE) note N2=this
  4539     from i[of "N1 + N2",unfolded has_integral,rule_format,OF *] guess g' .. note g'=conjunctD2[OF this,rule_format]
  5331     from i[of "N1 + N2",unfolded has_integral,rule_format,OF *] guess g' .. note g'=conjunctD2[OF this,rule_format]
  4540     have lem:"\<And>sf sg i. norm(sf - sg) \<le> e / 3 \<Longrightarrow> norm(i - s) < e / 3 \<Longrightarrow> norm(sg - i) < e / 3 \<Longrightarrow> norm(sf - s) < e"
  5332     have lem: "\<And>sf sg i. norm (sf - sg) \<le> e / 3 \<Longrightarrow>
  4541     proof- case goal1 have "norm (sf - s) \<le> norm (sf - sg) + norm (sg - i) + norm (i - s)"
  5333       norm(i - s) < e / 3 \<Longrightarrow> norm (sg - i) < e / 3 \<Longrightarrow> norm (sf - s) < e"
       
  5334     proof -
       
  5335       case goal1
       
  5336       have "norm (sf - s) \<le> norm (sf - sg) + norm (sg - i) + norm (i - s)"
  4542         using norm_triangle_ineq[of "sf - sg" "sg - s"]
  5337         using norm_triangle_ineq[of "sf - sg" "sg - s"]
  4543         using norm_triangle_ineq[of "sg -  i" " i - s"] by(auto simp add:algebra_simps)
  5338         using norm_triangle_ineq[of "sg -  i" " i - s"]
  4544       also have "\<dots> < e" using goal1 unfolding norm_minus_commute by(auto simp add:algebra_simps)
  5339         by (auto simp add: algebra_simps)
       
  5340       also have "\<dots> < e"
       
  5341         using goal1
       
  5342         unfolding norm_minus_commute
       
  5343         by (auto simp add: algebra_simps)
  4545       finally show ?case .
  5344       finally show ?case .
  4546     qed
  5345     qed
  4547     show ?case apply(rule_tac x=g' in exI) apply(rule,rule g')
  5346     show ?case
  4548     proof(rule,rule) fix p assume p:"p tagged_division_of {a..b} \<and> g' fine p" note * = g'(2)[OF this]
  5347       apply (rule_tac x=g' in exI)
  4549       show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - s) < e" apply-apply(rule lem[OF _ _ *])
  5348       apply rule
  4550         apply(rule order_trans,rule rsum_diff_bound[OF p[THEN conjunct1]]) apply(rule,rule g,assumption)
  5349       apply (rule g')
  4551       proof- have "content {a..b} < e / 3 * (real N2)"
  5350     proof (rule, rule)
  4552           using N2 unfolding inverse_eq_divide using as by(auto simp add:field_simps)
  5351       fix p
  4553         hence "content {a..b} < e / 3 * (real (N1 + N2) + 1)"
  5352       assume p: "p tagged_division_of {a..b} \<and> g' fine p"
  4554           apply-apply(rule less_le_trans,assumption) using `e>0` by auto
  5353       note * = g'(2)[OF this]
  4555         thus "inverse (real (N1 + N2) + 1) * content {a..b} \<le> e / 3"
  5354       show "norm ((\<Sum>(x, k)\<in>p. content k *\<^sub>R f x) - s) < e"
  4556           unfolding inverse_eq_divide by(auto simp add:field_simps)
  5355         apply -
  4557         show "norm (i (N1 + N2) - s) < e / 3" by(rule N1[rule_format],auto)
  5356         apply (rule lem[OF _ _ *])
  4558       qed qed qed qed
  5357         apply (rule order_trans)
       
  5358         apply (rule rsum_diff_bound[OF p[THEN conjunct1]])
       
  5359         apply rule
       
  5360         apply (rule g)
       
  5361         apply assumption
       
  5362       proof -
       
  5363         have "content {a..b} < e / 3 * (real N2)"
       
  5364           using N2 unfolding inverse_eq_divide using as by (auto simp add: field_simps)
       
  5365         then have "content {a..b} < e / 3 * (real (N1 + N2) + 1)"
       
  5366           apply -
       
  5367           apply (rule less_le_trans,assumption)
       
  5368           using `e>0`
       
  5369           apply auto
       
  5370           done
       
  5371         then show "inverse (real (N1 + N2) + 1) * content {a..b} \<le> e / 3"
       
  5372           unfolding inverse_eq_divide
       
  5373           by (auto simp add: field_simps)
       
  5374         show "norm (i (N1 + N2) - s) < e / 3"
       
  5375           by (rule N1[rule_format]) auto
       
  5376       qed
       
  5377     qed
       
  5378   qed
       
  5379 qed
       
  5380 
  4559 
  5381 
  4560 subsection {* Negligible sets. *}
  5382 subsection {* Negligible sets. *}
  4561 
  5383 
  4562 definition "negligible (s::('a::ordered_euclidean_space) set) \<equiv> (\<forall>a b. ((indicator s :: 'a\<Rightarrow>real) has_integral 0) {a..b})"
  5384 definition "negligible (s:: 'a::ordered_euclidean_space set) \<longleftrightarrow>
       
  5385   (\<forall>a b. ((indicator s :: 'a\<Rightarrow>real) has_integral 0) {a..b})"
       
  5386 
  4563 
  5387 
  4564 subsection {* Negligibility of hyperplane. *}
  5388 subsection {* Negligibility of hyperplane. *}
  4565 
  5389 
  4566 lemma vsum_nonzero_image_lemma:
  5390 lemma vsum_nonzero_image_lemma:
  4567   assumes "finite s" "g(a) = 0"
  5391   assumes "finite s"
  4568   "\<forall>x\<in>s. \<forall>y\<in>s. f x = f y \<and> x \<noteq> y \<longrightarrow> g(f x) = 0"
  5392     and "g a = 0"
       
  5393     and "\<forall>x\<in>s. \<forall>y\<in>s. f x = f y \<and> x \<noteq> y \<longrightarrow> g (f x) = 0"
  4569   shows "setsum g {f x |x. x \<in> s \<and> f x \<noteq> a} = setsum (g o f) s"
  5394   shows "setsum g {f x |x. x \<in> s \<and> f x \<noteq> a} = setsum (g o f) s"
  4570   unfolding setsum_iterate[OF assms(1)] apply(subst setsum_iterate) defer
  5395   unfolding setsum_iterate[OF assms(1)]
  4571   apply(rule iterate_nonzero_image_lemma) apply(rule assms monoidal_monoid)+
  5396   apply (subst setsum_iterate)
  4572   unfolding assms using neutral_add unfolding neutral_add using assms by auto
  5397   defer
  4573 
  5398   apply (rule iterate_nonzero_image_lemma)
  4574 lemma interval_doublesplit:  fixes a::"'a::ordered_euclidean_space" assumes "k\<in>Basis"
  5399   apply (rule assms monoidal_monoid)+
       
  5400   unfolding assms
       
  5401   using neutral_add
       
  5402   unfolding neutral_add
       
  5403   using assms
       
  5404   apply auto
       
  5405   done
       
  5406 
       
  5407 lemma interval_doublesplit:
       
  5408   fixes a :: "'a::ordered_euclidean_space"
       
  5409   assumes "k \<in> Basis"
  4575   shows "{a..b} \<inter> {x . abs(x\<bullet>k - c) \<le> (e::real)} =
  5410   shows "{a..b} \<inter> {x . abs(x\<bullet>k - c) \<le> (e::real)} =
  4576   {(\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) (c - e) else a\<bullet>i) *\<^sub>R i) ..
  5411     {(\<Sum>i\<in>Basis. (if i = k then max (a\<bullet>k) (c - e) else a\<bullet>i) *\<^sub>R i) ..
  4577    (\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) (c + e) else b\<bullet>i) *\<^sub>R i)}"
  5412      (\<Sum>i\<in>Basis. (if i = k then min (b\<bullet>k) (c + e) else b\<bullet>i) *\<^sub>R i)}"
  4578 proof- have *:"\<And>x c e::real. abs(x - c) \<le> e \<longleftrightarrow> x \<ge> c - e \<and> x \<le> c + e" by auto
  5413 proof -
  4579   have **:"\<And>s P Q. s \<inter> {x. P x \<and> Q x} = (s \<inter> {x. Q x}) \<inter> {x. P x}" by blast
  5414   have *: "\<And>x c e::real. abs(x - c) \<le> e \<longleftrightarrow> x \<ge> c - e \<and> x \<le> c + e"
  4580   show ?thesis unfolding * ** interval_split[OF assms] by(rule refl) qed
  5415     by auto
       
  5416   have **: "\<And>s P Q. s \<inter> {x. P x \<and> Q x} = (s \<inter> {x. Q x}) \<inter> {x. P x}"
       
  5417     by blast
       
  5418   show ?thesis
       
  5419     unfolding * ** interval_split[OF assms] by (rule refl)
       
  5420 qed
  4581 
  5421 
  4582 lemma division_doublesplit: fixes a::"'a::ordered_euclidean_space" assumes "p division_of {a..b}" and k:"k\<in>Basis"
  5422 lemma division_doublesplit: fixes a::"'a::ordered_euclidean_space" assumes "p division_of {a..b}" and k:"k\<in>Basis"
  4583   shows "{l \<inter> {x. abs(x\<bullet>k - c) \<le> e} |l. l \<in> p \<and> l \<inter> {x. abs(x\<bullet>k - c) \<le> e} \<noteq> {}} division_of ({a..b} \<inter> {x. abs(x\<bullet>k - c) \<le> e})"
  5423   shows "{l \<inter> {x. abs(x\<bullet>k - c) \<le> e} |l. l \<in> p \<and> l \<inter> {x. abs(x\<bullet>k - c) \<le> e} \<noteq> {}} division_of ({a..b} \<inter> {x. abs(x\<bullet>k - c) \<le> e})"
  4584 proof- have *:"\<And>x c. abs(x - c) \<le> e \<longleftrightarrow> x \<ge> c - e \<and> x \<le> c + e" by auto
  5424 proof- have *:"\<And>x c. abs(x - c) \<le> e \<longleftrightarrow> x \<ge> c - e \<and> x \<le> c + e" by auto
  4585   have **:"\<And>p q p' q'. p division_of q \<Longrightarrow> p = p' \<Longrightarrow> q = q' \<Longrightarrow> p' division_of q'" by auto
  5425   have **:"\<And>p q p' q'. p division_of q \<Longrightarrow> p = p' \<Longrightarrow> q = q' \<Longrightarrow> p' division_of q'" by auto