# Theory Function_Topology

theory Function_Topology
imports Finite_Product_Measure
(*  Author:  Sébastien Gouëzel   sebastien.gouezel@univ-rennes1.fr
*)

theory Function_Topology
imports Topology_Euclidean_Space Bounded_Linear_Function Finite_Product_Measure
begin

section ‹Product topology›

text ‹We want to define the product topology.

The product topology on a product of topological spaces is generated by
the sets which are products of open sets along finitely many coordinates, and the whole
space along the other coordinates. This is the coarsest topology for which the projection
to each factor is continuous.

To form a product of objects in Isabelle/HOL, all these objects should be subsets of a common type
'a. The product is then @{term "Pi⇩E I X"}, the set of elements from 'i to 'a such that the $i$-th
coordinate belongs to $X\;i$ for all $i \in I$.

Hence, to form a product of topological spaces, all these spaces should be subsets of a common type.
This means that type classes can not be used to define such a product if one wants to take the
product of different topological spaces (as the type 'a can only be given one structure of
topological space using type classes). On the other hand, one can define different topologies (as
introduced in \verb+thy+) on one type, and these topologies do not need to
share the same maximal open set. Hence, one can form a product of topologies in this sense, and
this works well. The big caveat is that it does not interact well with the main body of
topology in Isabelle/HOL defined in terms of type classes... For instance, continuity of maps
is not defined in this setting.

As the product of different topological spaces is very important in several areas of
mathematics (for instance adeles), I introduce below the product topology in terms of topologies,
and reformulate afterwards the consequences in terms of type classes (which are of course very
handy for applications).

Given this limitation, it looks to me that it would be very beneficial to revamp the theory
of topological spaces in Isabelle/HOL in terms of topologies, and keep the statements involving
type classes as consequences of more general statements in terms of topologies (but I am
probably too naive here).

Here is an example of a reformulation using topologies. Let
\begin{verbatim}
continuous_on_topo T1 T2 f = ((∀ U. openin T2 U ⟶ openin T1 (f-U ∩ topspace(T1)))
∧ (f(topspace T1) ⊆ (topspace T2)))
\end{verbatim}
be the natural continuity definition of a map from the topology $T1$ to the topology $T2$. Then
the current \verb+continuous_on+ (with type classes) can be redefined as
\begin{verbatim}
continuous_on s f = continuous_on_topo (subtopology euclidean s) (topology euclidean) f
\end{verbatim}

In fact, I need \verb+continuous_on_topo+ to express the continuity of the projection on subfactors
for the product topology, in Lemma~\verb+continuous_on_restrict_product_topology+, and I show
the above equivalence in Lemma~\verb+continuous_on_continuous_on_topo+.

I only develop the basics of the product topology in this theory. The most important missing piece
is Tychonov theorem, stating that a product of compact spaces is always compact for the product
topology, even when the product is not finite (or even countable).

I realized afterwards that this theory has a lot in common with \verb+Fin_Map.thy+.
›

subsection ‹Topology without type classes›

subsubsection ‹The topology generated by some (open) subsets›

text ‹In the definition below of a generated topology, the ‹Empty› case is not necessary,
as it follows from ‹UN› taking for $K$ the empty set. However, it is convenient to have,
and is never a problem in proofs, so I prefer to write it down explicitly.

We do not require UNIV to be an open set, as this will not be the case in applications. (We are
thinking of a topology on a subset of UNIV, the remaining part of UNIV being irrelevant.)›

inductive generate_topology_on for S where
Empty: "generate_topology_on S {}"
|Int: "generate_topology_on S a ⟹ generate_topology_on S b ⟹ generate_topology_on S (a ∩ b)"
| UN: "(⋀k. k ∈ K ⟹ generate_topology_on S k) ⟹ generate_topology_on S (⋃K)"
| Basis: "s ∈ S ⟹ generate_topology_on S s"

lemma istopology_generate_topology_on:
"istopology (generate_topology_on S)"
unfolding istopology_def by (auto intro: generate_topology_on.intros)

text ‹The basic property of the topology generated by a set $S$ is that it is the
smallest topology containing all the elements of $S$:›

lemma generate_topology_on_coarsest:
assumes "istopology T"
"⋀s. s ∈ S ⟹ T s"
"generate_topology_on S s0"
shows "T s0"
using assms(3) apply (induct rule: generate_topology_on.induct)
using assms(1) assms(2) unfolding istopology_def by auto

definition topology_generated_by::"('a set set) ⇒ ('a topology)"
where "topology_generated_by S = topology (generate_topology_on S)"

lemma openin_topology_generated_by_iff:
"openin (topology_generated_by S) s ⟷ generate_topology_on S s"
using topology_inverse'[OF istopology_generate_topology_on[of S]]
unfolding topology_generated_by_def by simp

lemma openin_topology_generated_by:
"openin (topology_generated_by S) s ⟹ generate_topology_on S s"
using openin_topology_generated_by_iff by auto

lemma topology_generated_by_topspace:
"topspace (topology_generated_by S) = (⋃S)"
proof
{
fix s assume "openin (topology_generated_by S) s"
then have "generate_topology_on S s" by (rule openin_topology_generated_by)
then have "s ⊆ (⋃S)" by (induct, auto)
}
then show "topspace (topology_generated_by S) ⊆ (⋃S)"
unfolding topspace_def by auto
next
have "generate_topology_on S (⋃S)"
using generate_topology_on.UN[OF generate_topology_on.Basis, of S S] by simp
then show "(⋃S) ⊆ topspace (topology_generated_by S)"
unfolding topspace_def using openin_topology_generated_by_iff by auto
qed

lemma topology_generated_by_Basis:
"s ∈ S ⟹ openin (topology_generated_by S) s"
by (simp only: openin_topology_generated_by_iff, auto simp: generate_topology_on.Basis)

subsubsection ‹Continuity›

text ‹We will need to deal with continuous maps in terms of topologies and not in terms
of type classes, as defined below.›

definition continuous_on_topo::"'a topology ⇒ 'b topology ⇒ ('a ⇒ 'b) ⇒ bool"
where "continuous_on_topo T1 T2 f = ((∀ U. openin T2 U ⟶ openin T1 (f-U ∩ topspace(T1)))
∧ (f(topspace T1) ⊆ (topspace T2)))"

lemma continuous_on_continuous_on_topo:
"continuous_on s f ⟷ continuous_on_topo (subtopology euclidean s) euclidean f"
unfolding continuous_on_open_invariant openin_open vimage_def continuous_on_topo_def
topspace_euclidean_subtopology open_openin topspace_euclidean by fast

lemma continuous_on_topo_UNIV:
"continuous_on UNIV f ⟷ continuous_on_topo euclidean euclidean f"
using continuous_on_continuous_on_topo[of UNIV f] subtopology_UNIV[of euclidean] by auto

lemma continuous_on_topo_open [intro]:
"continuous_on_topo T1 T2 f ⟹ openin T2 U ⟹ openin T1 (f-U ∩ topspace(T1))"
unfolding continuous_on_topo_def by auto

lemma continuous_on_topo_topspace [intro]:
"continuous_on_topo T1 T2 f ⟹ f(topspace T1) ⊆ (topspace T2)"
unfolding continuous_on_topo_def by auto

lemma continuous_on_generated_topo_iff:
"continuous_on_topo T1 (topology_generated_by S) f ⟷
((∀U. U ∈ S ⟶ openin T1 (f-U ∩ topspace(T1))) ∧ (f(topspace T1) ⊆ (⋃ S)))"
unfolding continuous_on_topo_def topology_generated_by_topspace
assume H: "∀U. U ∈ S ⟶ openin T1 (f - U ∩ topspace T1)"
fix U assume "openin (topology_generated_by S) U"
then have "generate_topology_on S U" by (rule openin_topology_generated_by)
then show "openin T1 (f - U ∩ topspace T1)"
proof (induct)
fix a b
assume H: "openin T1 (f - a ∩ topspace T1)" "openin T1 (f - b ∩ topspace T1)"
have "f - (a ∩ b) ∩ topspace T1 = (f-a ∩ topspace T1) ∩ (f-b ∩ topspace T1)"
by auto
then show "openin T1 (f - (a ∩ b) ∩ topspace T1)" using H by auto
next
fix K
assume H: "openin T1 (f - k ∩ topspace T1)" if "k∈ K" for k
define L where "L = {f - k ∩ topspace T1|k. k ∈ K}"
have *: "openin T1 l" if "l ∈L" for l using that H unfolding L_def by auto
have "openin T1 (⋃L)" using openin_Union[OF *] by simp
moreover have "(⋃L) = (f - ⋃K ∩ topspace T1)" unfolding L_def by auto
ultimately show "openin T1 (f - ⋃K ∩ topspace T1)" by simp
qed

lemma continuous_on_generated_topo:
assumes "⋀U. U ∈S ⟹ openin T1 (f-U ∩ topspace(T1))"
"f(topspace T1) ⊆ (⋃ S)"
shows "continuous_on_topo T1 (topology_generated_by S) f"
using assms continuous_on_generated_topo_iff by blast

lemma continuous_on_topo_compose:
assumes "continuous_on_topo T1 T2 f" "continuous_on_topo T2 T3 g"
shows "continuous_on_topo T1 T3 (g o f)"
using assms unfolding continuous_on_topo_def
proof (auto)
fix U :: "'c set"
assume H: "openin T3 U"
have "openin T1 (f - (g - U ∩ topspace T2) ∩ topspace T1)"
using H assms by blast
moreover have "f - (g - U ∩ topspace T2) ∩ topspace T1 = (g ∘ f) - U ∩ topspace T1"
using H assms continuous_on_topo_topspace by fastforce
ultimately show "openin T1 ((g ∘ f) - U ∩ topspace T1)"
by simp
qed (blast)

lemma continuous_on_topo_preimage_topspace [intro]:
assumes "continuous_on_topo T1 T2 f"
shows "f-(topspace T2) ∩ topspace T1 = topspace T1"
using assms unfolding continuous_on_topo_def by auto

subsubsection ‹Pullback topology›

text ‹Pulling back a topology by map gives again a topology. ‹subtopology› is
a special case of this notion, pulling back by the identity. We introduce the general notion as
we will need it to define the strong operator topology on the space of continuous linear operators,
by pulling back the product topology on the space of all functions.›

text ‹\verb+pullback_topology A f T+ is the pullback of the topology $T$ by the map $f$ on
the set $A$.›

definition pullback_topology::"('a set) ⇒ ('a ⇒ 'b) ⇒ ('b topology) ⇒ ('a topology)"
where "pullback_topology A f T = topology (λS. ∃U. openin T U ∧ S = f-U ∩ A)"

lemma istopology_pullback_topology:
"istopology (λS. ∃U. openin T U ∧ S = f-U ∩ A)"
unfolding istopology_def proof (auto)
fix K assume "∀S∈K. ∃U. openin T U ∧ S = f - U ∩ A"
then have "∃U. ∀S∈K. openin T (U S) ∧ S = f-(U S) ∩ A"
by (rule bchoice)
then obtain U where U: "∀S∈K. openin T (U S) ∧ S = f-(U S) ∩ A"
by blast
define V where "V = (⋃S∈K. U S)"
have "openin T V" "⋃K = f - V ∩ A" unfolding V_def using U by auto
then show "∃V. openin T V ∧ ⋃K = f - V ∩ A" by auto
qed

lemma openin_pullback_topology:
"openin (pullback_topology A f T) S ⟷ (∃U. openin T U ∧ S = f-U ∩ A)"
unfolding pullback_topology_def topology_inverse'[OF istopology_pullback_topology] by auto

lemma topspace_pullback_topology:
"topspace (pullback_topology A f T) = f-(topspace T) ∩ A"
by (auto simp add: topspace_def openin_pullback_topology)

lemma continuous_on_topo_pullback [intro]:
assumes "continuous_on_topo T1 T2 g"
shows "continuous_on_topo (pullback_topology A f T1) T2 (g o f)"
unfolding continuous_on_topo_def
proof (auto)
fix U::"'b set" assume "openin T2 U"
then have "openin T1 (g-U ∩ topspace T1)"
using assms unfolding continuous_on_topo_def by auto
have "(g o f)-U ∩ topspace (pullback_topology A f T1) = (g o f)-U ∩ A ∩ f-(topspace T1)"
unfolding topspace_pullback_topology by auto
also have "... = f-(g-U ∩ topspace T1) ∩ A "
by auto
also have "openin (pullback_topology A f T1) (...)"
unfolding openin_pullback_topology using ‹openin T1 (g-U ∩ topspace T1)› by auto
finally show "openin (pullback_topology A f T1) ((g ∘ f) - U ∩ topspace (pullback_topology A f T1))"
by auto
next
fix x assume "x ∈ topspace (pullback_topology A f T1)"
then have "f x ∈ topspace T1"
unfolding topspace_pullback_topology by auto
then show "g (f x) ∈ topspace T2"
using assms unfolding continuous_on_topo_def by auto
qed

lemma continuous_on_topo_pullback' [intro]:
assumes "continuous_on_topo T1 T2 (f o g)" "topspace T1 ⊆ g-A"
shows "continuous_on_topo T1 (pullback_topology A f T2) g"
unfolding continuous_on_topo_def
proof (auto)
fix U assume "openin (pullback_topology A f T2) U"
then have "∃V. openin T2 V ∧ U = f-V ∩ A"
unfolding openin_pullback_topology by auto
then obtain V where "openin T2 V" "U = f-V ∩ A"
by blast
then have "g - U ∩ topspace T1 = g-(f-V ∩ A) ∩ topspace T1"
by blast
also have "... = (f o g)-V ∩ (g-A ∩ topspace T1)"
by auto
also have "... = (f o g)-V ∩ topspace T1"
using assms(2) by auto
also have "openin T1 (...)"
using assms(1) ‹openin T2 V› by auto
finally show "openin T1 (g - U ∩ topspace T1)" by simp
next
fix x assume "x ∈ topspace T1"
have "(f o g) x ∈ topspace T2"
using assms(1) ‹x ∈ topspace T1› unfolding continuous_on_topo_def by auto
then have "g x ∈ f-(topspace T2)"
unfolding comp_def by blast
moreover have "g x ∈ A" using assms(2) ‹x ∈ topspace T1› by blast
ultimately show "g x ∈ topspace (pullback_topology A f T2)"
unfolding topspace_pullback_topology by blast
qed

subsection ‹The product topology›

text ‹We can now define the product topology, as generated by
the sets which are products of open sets along finitely many coordinates, and the whole
space along the other coordinates. Equivalently, it is generated by sets which are one open
set along one single coordinate, and the whole space along other coordinates. In fact, this is only
equivalent for nonempty products, but for the empty product the first formulation is better
(the second one gives an empty product space, while an empty product should have exactly one
point, equal to \verb+undefined+ along all coordinates.

So, we use the first formulation, which moreover seems to give rise to more straightforward proofs.
›

definition product_topology::"('i ⇒ ('a topology)) ⇒ ('i set) ⇒ (('i ⇒ 'a) topology)"
where "product_topology T I =
topology_generated_by {(Π⇩E i∈I. X i) |X. (∀i. openin (T i) (X i)) ∧ finite {i. X i ≠ topspace (T i)}}"

text ‹The total set of the product topology is the product of the total sets
along each coordinate.›

lemma product_topology_topspace:
"topspace (product_topology T I) = (Π⇩E i∈I. topspace(T i))"
proof
show "topspace (product_topology T I) ⊆ (Π⇩E i∈I. topspace (T i))"
unfolding product_topology_def apply (simp only: topology_generated_by_topspace)
unfolding topspace_def by auto
have "(Π⇩E i∈I. topspace (T i)) ∈ {(Π⇩E i∈I. X i) |X. (∀i. openin (T i) (X i)) ∧ finite {i. X i ≠ topspace (T i)}}"
using openin_topspace not_finite_existsD by auto
then show "(Π⇩E i∈I. topspace (T i)) ⊆ topspace (product_topology T I)"
unfolding product_topology_def using PiE_def by (auto simp add: topology_generated_by_topspace)
qed

lemma product_topology_basis:
assumes "⋀i. openin (T i) (X i)" "finite {i. X i ≠ topspace (T i)}"
shows "openin (product_topology T I) (Π⇩E i∈I. X i)"
unfolding product_topology_def apply (rule topology_generated_by_Basis) using assms by auto

lemma product_topology_open_contains_basis:
assumes "openin (product_topology T I) U"
"x ∈ U"
shows "∃X. x ∈ (Π⇩E i∈I. X i) ∧ (∀i. openin (T i) (X i)) ∧ finite {i. X i ≠ topspace (T i)} ∧ (Π⇩E i∈I. X i) ⊆ U"
proof -
have "generate_topology_on {(Π⇩E i∈I. X i) |X. (∀i. openin (T i) (X i)) ∧ finite {i. X i ≠ topspace (T i)}} U"
using assms unfolding product_topology_def by (intro openin_topology_generated_by) auto
then have "⋀x. x∈U ⟹ ∃X. x ∈ (Π⇩E i∈I. X i) ∧ (∀i. openin (T i) (X i)) ∧ finite {i. X i ≠ topspace (T i)} ∧ (Π⇩E i∈I. X i) ⊆ U"
proof induction
case (Int U V x)
then obtain XU XV where H:
"x ∈ Pi⇩E I XU" "(∀i. openin (T i) (XU i))" "finite {i. XU i ≠ topspace (T i)}" "Pi⇩E I XU ⊆ U"
"x ∈ Pi⇩E I XV" "(∀i. openin (T i) (XV i))" "finite {i. XV i ≠ topspace (T i)}" "Pi⇩E I XV ⊆ V"
by auto meson
define X where "X = (λi. XU i ∩ XV i)"
have "Pi⇩E I X ⊆ Pi⇩E I XU ∩ Pi⇩E I XV"
unfolding X_def by (auto simp add: PiE_iff)
then have "Pi⇩E I X ⊆ U ∩ V" using H by auto
moreover have "∀i. openin (T i) (X i)"
unfolding X_def using H by auto
moreover have "finite {i. X i ≠ topspace (T i)}"
apply (rule rev_finite_subset[of "{i. XU i ≠ topspace (T i)} ∪ {i. XV i ≠ topspace (T i)}"])
unfolding X_def using H by auto
moreover have "x ∈ Pi⇩E I X"
unfolding X_def using H by auto
ultimately show ?case
by auto
next
case (UN K x)
then obtain k where "k ∈ K" "x ∈ k" by auto
with UN have "∃X. x ∈ Pi⇩E I X ∧ (∀i. openin (T i) (X i)) ∧ finite {i. X i ≠ topspace (T i)} ∧ Pi⇩E I X ⊆ k"
by simp
then obtain X where "x ∈ Pi⇩E I X ∧ (∀i. openin (T i) (X i)) ∧ finite {i. X i ≠ topspace (T i)} ∧ Pi⇩E I X ⊆ k"
by blast
then have "x ∈ Pi⇩E I X ∧ (∀i. openin (T i) (X i)) ∧ finite {i. X i ≠ topspace (T i)} ∧ Pi⇩E I X ⊆ (⋃K)"
using ‹k ∈ K› by auto
then show ?case
by auto
qed auto
then show ?thesis using ‹x ∈ U› by auto
qed

text ‹The basic property of the product topology is the continuity of projections:›

lemma continuous_on_topo_product_coordinates [simp]:
assumes "i ∈ I"
shows "continuous_on_topo (product_topology T I) (T i) (λx. x i)"
proof -
{
fix U assume "openin (T i) U"
define X where "X = (λj. if j = i then U else topspace (T j))"
then have *: "(λx. x i) - U ∩ (Π⇩E i∈I. topspace (T i)) = (Π⇩E j∈I. X j)"
unfolding X_def using assms openin_subset[OF ‹openin (T i) U›]
by (auto simp add: PiE_iff, auto, metis subsetCE)
have **: "(∀i. openin (T i) (X i)) ∧ finite {i. X i ≠ topspace (T i)}"
unfolding X_def using ‹openin (T i) U› by auto
have "openin (product_topology T I) ((λx. x i) - U ∩ (Π⇩E i∈I. topspace (T i)))"
unfolding product_topology_def
apply (rule topology_generated_by_Basis)
apply (subst *)
using ** by auto
}
then show ?thesis unfolding continuous_on_topo_def
by (auto simp add: assms product_topology_topspace PiE_iff)
qed

lemma continuous_on_topo_coordinatewise_then_product [intro]:
assumes "⋀i. i ∈ I ⟹ continuous_on_topo T1 (T i) (λx. f x i)"
"⋀i x. i ∉ I ⟹ x ∈ topspace T1 ⟹ f x i = undefined"
shows "continuous_on_topo T1 (product_topology T I) f"
unfolding product_topology_def
proof (rule continuous_on_generated_topo)
fix U assume "U ∈ {Pi⇩E I X |X. (∀i. openin (T i) (X i)) ∧ finite {i. X i ≠ topspace (T i)}}"
then obtain X where H: "U = Pi⇩E I X" "⋀i. openin (T i) (X i)" "finite {i. X i ≠ topspace (T i)}"
by blast
define J where "J = {i ∈ I. X i ≠ topspace (T i)}"
have "finite J" "J ⊆ I" unfolding J_def using H(3) by auto
have "(λx. f x i)-(topspace(T i)) ∩ topspace T1 = topspace T1" if "i ∈ I" for i
using that assms(1) by (simp add: continuous_on_topo_preimage_topspace)
then have *: "(λx. f x i)-(X i) ∩ topspace T1 = topspace T1" if "i ∈ I-J" for i
using that unfolding J_def by auto
have "f-U ∩ topspace T1 = (⋂i∈I. (λx. f x i)-(X i) ∩ topspace T1) ∩ (topspace T1)"
by (subst H(1), auto simp add: PiE_iff assms)
also have "... = (⋂i∈J. (λx. f x i)-(X i) ∩ topspace T1) ∩ (topspace T1)"
using * ‹J ⊆ I› by auto
also have "openin T1 (...)"
apply (rule openin_INT)
using H(2) assms(1) ‹J ⊆ I› by auto
ultimately show "openin T1 (f-U ∩ topspace T1)" by simp
next
show "f topspace T1 ⊆ ⋃{Pi⇩E I X |X. (∀i. openin (T i) (X i)) ∧ finite {i. X i ≠ topspace (T i)}}"
apply (subst topology_generated_by_topspace[symmetric])
apply (subst product_topology_def[symmetric])
apply (simp only: product_topology_topspace)
using assms unfolding continuous_on_topo_def by auto
qed

lemma continuous_on_topo_product_then_coordinatewise [intro]:
assumes "continuous_on_topo T1 (product_topology T I) f"
shows "⋀i. i ∈ I ⟹ continuous_on_topo T1 (T i) (λx. f x i)"
"⋀i x. i ∉ I ⟹ x ∈ topspace T1 ⟹ f x i = undefined"
proof -
fix i assume "i ∈ I"
have "(λx. f x i) = (λy. y i) o f" by auto
also have "continuous_on_topo T1 (T i) (...)"
apply (rule continuous_on_topo_compose[of _ "product_topology T I"])
using assms ‹i ∈ I› by auto
ultimately show "continuous_on_topo T1 (T i) (λx. f x i)"
by simp
next
fix i x assume "i ∉ I" "x ∈ topspace T1"
have "f x ∈ topspace (product_topology T I)"
using assms ‹x ∈ topspace T1› unfolding continuous_on_topo_def by auto
then have "f x ∈ (Π⇩E i∈I. topspace (T i))"
using product_topology_topspace by metis
then show "f x i = undefined"
using ‹i ∉ I› by (auto simp add: PiE_iff extensional_def)
qed

lemma continuous_on_restrict:
assumes "J ⊆ I"
shows "continuous_on_topo (product_topology T I) (product_topology T J) (λx. restrict x J)"
proof (rule continuous_on_topo_coordinatewise_then_product)
fix i assume "i ∈ J"
then have "(λx. restrict x J i) = (λx. x i)" unfolding restrict_def by auto
then show "continuous_on_topo (product_topology T I) (T i) (λx. restrict x J i)"
using ‹i ∈ J› ‹J ⊆ I› by auto
next
fix i assume "i ∉ J"
then show "restrict x J i = undefined" for x::"'a ⇒ 'b"
unfolding restrict_def by auto
qed

subsubsection ‹Powers of a single topological space as a topological space, using type classes›

instantiation "fun" :: (type, topological_space) topological_space
begin

definition open_fun_def:
"open U = openin (product_topology (λi. euclidean) UNIV) U"

instance proof
have "topspace (product_topology (λ(i::'a). euclidean::('b topology)) UNIV) = UNIV"
unfolding product_topology_topspace topspace_euclidean by auto
then show "open (UNIV::('a ⇒ 'b) set)"
unfolding open_fun_def by (metis openin_topspace)

end

lemma euclidean_product_topology:
"euclidean = product_topology (λi. euclidean::('b::topological_space) topology) UNIV"
by (metis open_openin topology_eq open_fun_def)

lemma product_topology_basis':
fixes x::"'i ⇒ 'a" and U::"'i ⇒ ('b::topological_space) set"
assumes "finite I" "⋀i. i ∈ I ⟹ open (U i)"
shows "open {f. ∀i∈I. f (x i) ∈ U i}"
proof -
define J where "J = xI"
define V where "V = (λy. if y ∈ J then ⋂{U i|i. i∈I ∧ x i = y} else UNIV)"
define X where "X = (λy. if y ∈ J then V y else UNIV)"
have *: "open (X i)" for i
unfolding X_def V_def using assms by auto
have **: "finite {i. X i ≠ UNIV}"
unfolding X_def V_def J_def using assms(1) by auto
have "open (Pi⇩E UNIV X)"
unfolding open_fun_def apply (rule product_topology_basis)
using * ** unfolding open_openin topspace_euclidean by auto
moreover have "Pi⇩E UNIV X = {f. ∀i∈I. f (x i) ∈ U i}"
apply (auto simp add: PiE_iff) unfolding X_def V_def J_def
proof (auto)
fix f :: "'a ⇒ 'b" and i :: 'i
assume a1: "i ∈ I"
assume a2: "∀i. f i ∈ (if i ∈ xI then if i ∈ xI then ⋂{U ia |ia. ia ∈ I ∧ x ia = i} else UNIV else UNIV)"
have f3: "x i ∈ xI"
using a1 by blast
have "U i ∈ {U ia |ia. ia ∈ I ∧ x ia = x i}"
using a1 by blast
then show "f (x i) ∈ U i"
using f3 a2 by (meson Inter_iff)
qed
ultimately show ?thesis by simp
qed

text ‹The results proved in the general situation of products of possibly different
spaces have their counterparts in this simpler setting.›

lemma continuous_on_product_coordinates [simp]:
"continuous_on UNIV (λx. x i::('b::topological_space))"
unfolding continuous_on_topo_UNIV euclidean_product_topology
by (rule continuous_on_topo_product_coordinates, simp)

lemma continuous_on_coordinatewise_then_product [intro, continuous_intros]:
assumes "⋀i. continuous_on UNIV (λx. f x i)"
shows "continuous_on UNIV f"
using assms unfolding continuous_on_topo_UNIV euclidean_product_topology
by (rule continuous_on_topo_coordinatewise_then_product, simp)

lemma continuous_on_product_then_coordinatewise:
assumes "continuous_on UNIV f"
shows "continuous_on UNIV (λx. f x i)"
using assms unfolding continuous_on_topo_UNIV euclidean_product_topology
by (rule continuous_on_topo_product_then_coordinatewise(1), simp)

lemma continuous_on_product_coordinatewise_iff:
"continuous_on UNIV f ⟷ (∀i. continuous_on UNIV (λx. f x i))"
by (auto intro: continuous_on_product_then_coordinatewise)

subsubsection ‹Topological countability for product spaces›

text ‹The next two lemmas are useful to prove first or second countability
of product spaces, but they have more to do with countability and could
be put in the corresponding theory.›

lemma countable_nat_product_event_const:
fixes F::"'a set" and a::'a
assumes "a ∈ F" "countable F"
shows "countable {x::(nat ⇒ 'a). (∀i. x i ∈ F) ∧ finite {i. x i ≠ a}}"
proof -
have *: "{x::(nat ⇒ 'a). (∀i. x i ∈ F) ∧ finite {i. x i ≠ a}}
⊆ (⋃N. {x. (∀i. x i ∈ F) ∧ (∀i≥N. x i = a)})"
using infinite_nat_iff_unbounded_le by fastforce
have "countable {x. (∀i. x i ∈ F) ∧ (∀i≥N. x i = a)}" for N::nat
proof (induction N)
case 0
have "{x. (∀i. x i ∈ F) ∧ (∀i≥(0::nat). x i = a)} = {(λi. a)}"
using ‹a ∈ F› by auto
then show ?case by auto
next
case (Suc N)
define f::"((nat ⇒ 'a) × 'a) ⇒ (nat ⇒ 'a)"
where "f = (λ(x, b). (λi. if i = N then b else x i))"
have "{x. (∀i. x i ∈ F) ∧ (∀i≥Suc N. x i = a)} ⊆ f({x. (∀i. x i ∈ F) ∧ (∀i≥N. x i = a)} × F)"
proof (auto)
fix x assume H: "∀i::nat. x i ∈ F" "∀i≥Suc N. x i = a"
define y where "y = (λi. if i = N then a else x i)"
have "f (y, x N) = x"
unfolding f_def y_def by auto
moreover have "(y, x N) ∈ {x. (∀i. x i ∈ F) ∧ (∀i≥N. x i = a)} × F"
unfolding y_def using H ‹a ∈ F› by auto
ultimately show "x ∈ f({x. (∀i. x i ∈ F) ∧ (∀i≥N. x i = a)} × F)"
by (metis (no_types, lifting) image_eqI)
qed
moreover have "countable ({x. (∀i. x i ∈ F) ∧ (∀i≥N. x i = a)} × F)"
using Suc.IH assms(2) by auto
ultimately show ?case
by (meson countable_image countable_subset)
qed
then show ?thesis using countable_subset[OF *] by auto
qed

lemma countable_product_event_const:
fixes F::"('a::countable) ⇒ 'b set" and b::'b
assumes "⋀i. countable (F i)"
shows "countable {f::('a ⇒ 'b). (∀i. f i ∈ F i) ∧ (finite {i. f i ≠ b})}"
proof -
define G where "G = (⋃i. F i) ∪ {b}"
have "countable G" unfolding G_def using assms by auto
have "b ∈ G" unfolding G_def by auto
define pi where "pi = (λ(x::(nat ⇒ 'b)). (λ i::'a. x ((to_nat::('a ⇒ nat)) i)))"
have "{f::('a ⇒ 'b). (∀i. f i ∈ F i) ∧ (finite {i. f i ≠ b})}
⊆ pi{g::(nat ⇒ 'b). (∀j. g j ∈ G) ∧ (finite {j. g j ≠ b})}"
proof (auto)
fix f assume H: "∀i. f i ∈ F i" "finite {i. f i ≠ b}"
define I where "I = {i. f i ≠ b}"
define g where "g = (λj. if j ∈ to_natI then f (from_nat j) else b)"
have "{j. g j ≠ b} ⊆ to_natI" unfolding g_def by auto
then have "finite {j. g j ≠ b}"
unfolding I_def using H(2) using finite_surj by blast
moreover have "g j ∈ G" for j
unfolding g_def G_def using H by auto
ultimately have "g ∈ {g::(nat ⇒ 'b). (∀j. g j ∈ G) ∧ (finite {j. g j ≠ b})}"
by auto
moreover have "f = pi g"
unfolding pi_def g_def I_def using H by fastforce
ultimately show "f ∈ pi{g. (∀j. g j ∈ G) ∧ finite {j. g j ≠ b}}"
by auto
qed
then show ?thesis
using countable_nat_product_event_const[OF ‹b ∈ G› ‹countable G›]
by (meson countable_image countable_subset)
qed

instance "fun" :: (countable, first_countable_topology) first_countable_topology
proof
fix x::"'a ⇒ 'b"
have "∃A::('b ⇒ nat ⇒ 'b set). ∀x. (∀i. x ∈ A x i ∧ open (A x i)) ∧ (∀S. open S ∧ x ∈ S ⟶ (∃i. A x i ⊆ S))"
apply (rule choice) using first_countable_basis by auto
then obtain A::"('b ⇒ nat ⇒ 'b set)" where A: "⋀x i. x ∈ A x i"
"⋀x i. open (A x i)"
"⋀x S. open S ⟹ x ∈ S ⟹ (∃i. A x i ⊆ S)"
by metis
text ‹$B i$ is a countable basis of neighborhoods of $x_i$.›
define B where "B = (λi. (A (x i))UNIV ∪ {UNIV})"
have "countable (B i)" for i unfolding B_def by auto

define K where "K = {Pi⇩E UNIV X | X. (∀i. X i ∈ B i) ∧ finite {i. X i ≠ UNIV}}"
have "Pi⇩E UNIV (λi. UNIV) ∈ K"
unfolding K_def B_def by auto
then have "K ≠ {}" by auto
have "countable {X. (∀i. X i ∈ B i) ∧ finite {i. X i ≠ UNIV}}"
apply (rule countable_product_event_const) using ‹⋀i. countable (B i)› by auto
moreover have "K = (λX. Pi⇩E UNIV X){X. (∀i. X i ∈ B i) ∧ finite {i. X i ≠ UNIV}}"
unfolding K_def by auto
ultimately have "countable K" by auto
have "x ∈ k" if "k ∈ K" for k
using that unfolding K_def B_def apply auto using A(1) by auto
have "open k" if "k ∈ K" for k
using that unfolding open_fun_def K_def B_def apply (auto)
apply (rule product_topology_basis)
unfolding topspace_euclidean by (auto, metis imageE open_UNIV A(2))

have Inc: "∃k∈K. k ⊆ U" if "open U ∧ x ∈ U" for U
proof -
have "openin (product_topology (λi. euclidean) UNIV) U" "x ∈ U"
using ‹open U ∧ x ∈ U› unfolding open_fun_def by auto
with product_topology_open_contains_basis[OF this]
have "∃X. x ∈ (Π⇩E i∈UNIV. X i) ∧ (∀i. open (X i)) ∧ finite {i. X i ≠ UNIV} ∧ (Π⇩E i∈UNIV. X i) ⊆ U"
unfolding topspace_euclidean open_openin by simp
then obtain X where H: "x ∈ (Π⇩E i∈UNIV. X i)"
"⋀i. open (X i)"
"finite {i. X i ≠ UNIV}"
"(Π⇩E i∈UNIV. X i) ⊆ U"
by auto
define I where "I = {i. X i ≠ UNIV}"
define Y where "Y = (λi. if i ∈ I then (SOME y. y ∈ B i ∧ y ⊆ X i) else UNIV)"
have *: "∃y. y ∈ B i ∧ y ⊆ X i" for i
unfolding B_def using A(3)[OF H(2)] H(1) by (metis PiE_E UNIV_I UnCI image_iff)
have **: "Y i ∈ B i ∧ Y i ⊆ X i" for i
apply (cases "i ∈ I")
unfolding Y_def using * that apply (auto)
apply (metis (no_types, lifting) someI, metis (no_types, lifting) someI_ex subset_iff)
unfolding B_def apply simp
unfolding I_def apply auto
done
have "{i. Y i ≠ UNIV} ⊆ I"
unfolding Y_def by auto
then have ***: "finite {i. Y i ≠ UNIV}"
unfolding I_def using H(3) rev_finite_subset by blast
have "(∀i. Y i ∈ B i) ∧ finite {i. Y i ≠ UNIV}"
using ** *** by auto
then have "Pi⇩E UNIV Y ∈ K"
unfolding K_def by auto

have "Y i ⊆ X i" for i
apply (cases "i ∈ I") using ** apply simp unfolding Y_def I_def by auto
then have "Pi⇩E UNIV Y ⊆ Pi⇩E UNIV X" by auto
then have "Pi⇩E UNIV Y ⊆ U" using H(4) by auto
then show ?thesis using ‹Pi⇩E UNIV Y ∈ K› by auto
qed

show "∃L. (∀(i::nat). x ∈ L i ∧ open (L i)) ∧ (∀U. open U ∧ x ∈ U ⟶ (∃i. L i ⊆ U))"
apply (rule first_countableI[of K])
using ‹countable K› ‹⋀k. k ∈ K ⟹ x ∈ k› ‹⋀k. k ∈ K ⟹ open k› Inc by auto
qed

lemma product_topology_countable_basis:
shows "∃K::(('a::countable ⇒ 'b::second_countable_topology) set set).
topological_basis K ∧ countable K ∧
(∀k∈K. ∃X. (k = Pi⇩E UNIV X) ∧ (∀i. open (X i)) ∧ finite {i. X i ≠ UNIV})"
proof -
obtain B::"'b set set" where B: "countable B ∧ topological_basis B"
using ex_countable_basis by auto
then have "B ≠ {}" by (meson UNIV_I empty_iff open_UNIV topological_basisE)
define B2 where "B2 = B ∪ {UNIV}"
have "countable B2"
unfolding B2_def using B by auto
have "open U" if "U ∈ B2" for U
using that unfolding B2_def using B topological_basis_open by auto

define K where "K = {Pi⇩E UNIV X | X. (∀i::'a. X i ∈ B2) ∧ finite {i. X i ≠ UNIV}}"
have i: "∀k∈K. ∃X. (k = Pi⇩E UNIV X) ∧ (∀i. open (X i)) ∧ finite {i. X i ≠ UNIV}"
unfolding K_def using ‹⋀U. U ∈ B2 ⟹ open U› by auto

have "countable {X. (∀(i::'a). X i ∈ B2) ∧ finite {i. X i ≠ UNIV}}"
apply (rule countable_product_event_const) using ‹countable B2› by auto
moreover have "K = (λX. Pi⇩E UNIV X){X. (∀i. X i ∈ B2) ∧ finite {i. X i ≠ UNIV}}"
unfolding K_def by auto
ultimately have ii: "countable K" by auto

have iii: "topological_basis K"
proof (rule topological_basisI)
fix U and x::"'a⇒'b" assume "open U" "x ∈ U"
then have "openin (product_topology (λi. euclidean) UNIV) U"
unfolding open_fun_def by auto
with product_topology_open_contains_basis[OF this ‹x ∈ U›]
have "∃X. x ∈ (Π⇩E i∈UNIV. X i) ∧ (∀i. open (X i)) ∧ finite {i. X i ≠ UNIV} ∧ (Π⇩E i∈UNIV. X i) ⊆ U"
unfolding topspace_euclidean open_openin by simp
then obtain X where H: "x ∈ (Π⇩E i∈UNIV. X i)"
"⋀i. open (X i)"
"finite {i. X i ≠ UNIV}"
"(Π⇩E i∈UNIV. X i) ⊆ U"
by auto
then have "x i ∈ X i" for i by auto
define I where "I = {i. X i ≠ UNIV}"
define Y where "Y = (λi. if i ∈ I then (SOME y. y ∈ B2 ∧ y ⊆ X i ∧ x i ∈ y) else UNIV)"
have *: "∃y. y ∈ B2 ∧ y ⊆ X i ∧ x i ∈ y" for i
unfolding B2_def using B ‹open (X i)› ‹x i ∈ X i› by (meson UnCI topological_basisE)
have **: "Y i ∈ B2 ∧ Y i ⊆ X i ∧ x i ∈ Y i" for i
using someI_ex[OF *]
apply (cases "i ∈ I")
unfolding Y_def using * apply (auto)
unfolding B2_def I_def by auto
have "{i. Y i ≠ UNIV} ⊆ I"
unfolding Y_def by auto
then have ***: "finite {i. Y i ≠ UNIV}"
unfolding I_def using H(3) rev_finite_subset by blast
have "(∀i. Y i ∈ B2) ∧ finite {i. Y i ≠ UNIV}"
using ** *** by auto
then have "Pi⇩E UNIV Y ∈ K"
unfolding K_def by auto

have "Y i ⊆ X i" for i
apply (cases "i ∈ I") using ** apply simp unfolding Y_def I_def by auto
then have "Pi⇩E UNIV Y ⊆ Pi⇩E UNIV X" by auto
then have "Pi⇩E UNIV Y ⊆ U" using H(4) by auto

have "x ∈ Pi⇩E UNIV Y"
using ** by auto

show "∃V∈K. x ∈ V ∧ V ⊆ U"
using ‹Pi⇩E UNIV Y ∈ K› ‹Pi⇩E UNIV Y ⊆ U› ‹x ∈ Pi⇩E UNIV Y› by auto
next
fix U assume "U ∈ K"
show "open U"
using ‹U ∈ K› unfolding open_fun_def K_def apply (auto)
apply (rule product_topology_basis)
using ‹⋀V. V ∈ B2 ⟹ open V› open_UNIV unfolding topspace_euclidean open_openin[symmetric]
by auto
qed

show ?thesis using i ii iii by auto
qed

instance "fun" :: (countable, second_countable_topology) second_countable_topology
apply standard
using product_topology_countable_basis topological_basis_imp_subbasis by auto

subsection ‹The strong operator topology on continuous linear operators›

text ‹Let 'a and 'b be two normed real vector spaces. Then the space of linear continuous
operators from 'a to 'b has a canonical norm, and therefore a canonical corresponding topology
(the type classes instantiation are given in \verb+Bounded_Linear_Function.thy+).

However, there is another topology on this space, the strong operator topology, where $T_n$ tends to
$T$ iff, for all $x$ in 'a, then $T_n x$ tends to $T x$. This is precisely the product topology
where the target space is endowed with the norm topology. It is especially useful when 'b is the set
of real numbers, since then this topology is compact.

We can not implement it using type classes as there is already a topology, but at least we
can define it as a topology.

Note that there is yet another (common and useful) topology on operator spaces, the weak operator
topology, defined analogously using the product topology, but where the target space is given the
weak-* topology, i.e., the pullback of the weak topology on the bidual of the space under the
canonical embedding of a space into its bidual. We do not define it there, although it could also be
defined analogously.
›

definition strong_operator_topology::"('a::real_normed_vector ⇒⇩L'b::real_normed_vector) topology"
where "strong_operator_topology = pullback_topology UNIV blinfun_apply euclidean"

lemma strong_operator_topology_topspace:
"topspace strong_operator_topology = UNIV"
unfolding strong_operator_topology_def topspace_pullback_topology topspace_euclidean by auto

lemma strong_operator_topology_basis:
fixes f::"('a::real_normed_vector ⇒⇩L'b::real_normed_vector)" and U::"'i ⇒ 'b set" and x::"'i ⇒ 'a"
assumes "finite I" "⋀i. i ∈ I ⟹ open (U i)"
shows "openin strong_operator_topology {f. ∀i∈I. blinfun_apply f (x i) ∈ U i}"
proof -
have "open {g::('a⇒'b). ∀i∈I. g (x i) ∈ U i}"
by (rule product_topology_basis'[OF assms])
moreover have "{f. ∀i∈I. blinfun_apply f (x i) ∈ U i}
= blinfun_apply-{g::('a⇒'b). ∀i∈I. g (x i) ∈ U i} ∩ UNIV"
by auto
ultimately show ?thesis
unfolding strong_operator_topology_def open_openin apply (subst openin_pullback_topology) by auto
qed

lemma strong_operator_topology_continuous_evaluation:
"continuous_on_topo strong_operator_topology euclidean (λf. blinfun_apply f x)"
proof -
have "continuous_on_topo strong_operator_topology euclidean ((λf. f x) o blinfun_apply)"
unfolding strong_operator_topology_def apply (rule continuous_on_topo_pullback)
using continuous_on_topo_UNIV continuous_on_product_coordinates by fastforce
then show ?thesis unfolding comp_def by simp
qed

lemma continuous_on_strong_operator_topo_iff_coordinatewise:
"continuous_on_topo T strong_operator_topology f
⟷ (∀x. continuous_on_topo T euclidean (λy. blinfun_apply (f y) x))"
proof (auto)
fix x::"'b"
assume "continuous_on_topo T strong_operator_topology f"
with continuous_on_topo_compose[OF this strong_operator_topology_continuous_evaluation]
have "continuous_on_topo T euclidean ((λz. blinfun_apply z x) o f)"
by simp
then show "continuous_on_topo T euclidean (λy. blinfun_apply (f y) x)"
unfolding comp_def by auto
next
assume *: "∀x. continuous_on_topo T euclidean (λy. blinfun_apply (f y) x)"
have "continuous_on_topo T euclidean (blinfun_apply o f)"
unfolding euclidean_product_topology
apply (rule continuous_on_topo_coordinatewise_then_product, auto)
using * unfolding comp_def by auto
show "continuous_on_topo T strong_operator_topology f"
unfolding strong_operator_topology_def
apply (rule continuous_on_topo_pullback')
by (auto simp add: ‹continuous_on_topo T euclidean (blinfun_apply o f)›)
qed

lemma strong_operator_topology_weaker_than_euclidean:
"continuous_on_topo euclidean strong_operator_topology (λf. f)"
by (subst continuous_on_strong_operator_topo_iff_coordinatewise,

subsection ‹Metrics on product spaces›

text ‹In general, the product topology is not metrizable, unless the index set is countable.
When the index set is countable, essentially any (convergent) combination of the metrics on the
factors will do. We use below the simplest one, based on $L^1$, but $L^2$ would also work,
for instance.

What is not completely trivial is that the distance thus defined induces the same topology
as the product topology. This is what we have to prove to show that we have an instance
of \verb+metric_space+.

The proofs below would work verbatim for general countable products of metric spaces. However,
since distances are only implemented in terms of type classes, we only develop the theory
for countable products of the same space.›

instantiation "fun" :: (countable, metric_space) metric_space
begin

definition dist_fun_def:
"dist x y = (∑n. (1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"

definition uniformity_fun_def:
"(uniformity::(('a ⇒ 'b) × ('a ⇒ 'b)) filter) = (INF e:{0<..}. principal {(x, y). dist (x::('a⇒'b)) y < e})"

text ‹Except for the first one, the auxiliary lemmas below are only useful when proving the
instance: once it is proved, they become trivial consequences of the general theory of metric
spaces. It would thus be desirable to hide them once the instance is proved, but I do not know how
to do this.›

lemma dist_fun_le_dist_first_terms:
"dist x y ≤ 2 * Max {dist (x (from_nat n)) (y (from_nat n))|n. n ≤ N} + (1/2)^N"
proof -
have "(∑n. (1 / 2) ^ (n+Suc N) * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1)
= (∑n. (1 / 2) ^ (Suc N) * ((1/2) ^ n * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1))"
also have "... = (1/2)^(Suc N) * (∑n. (1 / 2) ^ n * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1)"
apply (rule suminf_mult)
by (rule summable_comparison_test'[of "λn. (1/2)^n"], auto simp add: summable_geometric_iff)
also have "... ≤ (1/2)^(Suc N) * (∑n. (1 / 2) ^ n)"
apply (simp, rule suminf_le, simp)
by (rule summable_comparison_test'[of "λn. (1/2)^n"], auto simp add: summable_geometric_iff)
also have "... = (1/2)^(Suc N) * 2"
using suminf_geometric[of "1/2"] by auto
also have "... = (1/2)^N"
by auto
finally have *: "(∑n. (1 / 2) ^ (n+Suc N) * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1) ≤ (1/2)^N"
by simp

define M where "M = Max {dist (x (from_nat n)) (y (from_nat n))|n. n ≤ N}"
have "dist (x (from_nat 0)) (y (from_nat 0)) ≤ M"
unfolding M_def by (rule Max_ge, auto)
then have [simp]: "M ≥ 0" by (meson dual_order.trans zero_le_dist)
have "dist (x (from_nat n)) (y (from_nat n)) ≤ M" if "n≤N" for n
unfolding M_def apply (rule Max_ge) using that by auto
then have i: "min (dist (x (from_nat n)) (y (from_nat n))) 1 ≤ M" if "n≤N" for n
using that by force
have "(∑n< Suc N. (1 / 2) ^ n * min (dist (x (from_nat n)) (y (from_nat n))) 1) ≤
(∑n< Suc N. M * (1 / 2) ^ n)"
by (rule sum_mono, simp add: i)
also have "... = M * (∑n<Suc N. (1 / 2) ^ n)"
by (rule sum_distrib_left[symmetric])
also have "... ≤ M * (∑n. (1 / 2) ^ n)"
by (rule mult_left_mono, rule sum_le_suminf, auto simp add: summable_geometric_iff)
also have "... = M * 2"
using suminf_geometric[of "1/2"] by auto
finally have **: "(∑n< Suc N. (1 / 2) ^ n * min (dist (x (from_nat n)) (y (from_nat n))) 1) ≤ 2 * M"
by simp

have "dist x y = (∑n. (1 / 2) ^ n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
unfolding dist_fun_def by simp
also have "... = (∑n. (1 / 2) ^ (n+Suc N) * min (dist (x (from_nat (n+Suc N))) (y (from_nat (n+Suc N)))) 1)
+ (∑n<Suc N. (1 / 2) ^ n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
apply (rule suminf_split_initial_segment)
by (rule summable_comparison_test'[of "λn. (1/2)^n"], auto simp add: summable_geometric_iff)
also have "... ≤ 2 * M + (1/2)^N"
using * ** by auto
finally show ?thesis unfolding M_def by simp
qed

lemma open_fun_contains_ball_aux:
assumes "open (U::(('a ⇒ 'b) set))"
"x ∈ U"
shows "∃e>0. {y. dist x y < e} ⊆ U"
proof -
have *: "openin (product_topology (λi. euclidean) UNIV) U"
using open_fun_def assms by auto
obtain X where H: "Pi⇩E UNIV X ⊆ U"
"⋀i. openin euclidean (X i)"
"finite {i. X i ≠ topspace euclidean}"
"x ∈ Pi⇩E UNIV X"
using product_topology_open_contains_basis[OF * ‹x ∈ U›] by auto
define I where "I = {i. X i ≠ topspace euclidean}"
have "finite I" unfolding I_def using H(3) by auto
{
fix i
have "x i ∈ X i" using ‹x ∈ U› H by auto
then have "∃e. e>0 ∧ ball (x i) e ⊆ X i"
using ‹openin euclidean (X i)› open_openin open_contains_ball by blast
then obtain e where "e>0" "ball (x i) e ⊆ X i" by blast
define f where "f = min e (1/2)"
have "f>0" "f<1" unfolding f_def using ‹e>0› by auto
moreover have "ball (x i) f ⊆ X i" unfolding f_def using ‹ball (x i) e ⊆ X i› by auto
ultimately have "∃f. f > 0 ∧ f < 1 ∧ ball (x i) f ⊆ X i" by auto
} note * = this
have "∃e. ∀i. e i > 0 ∧ e i < 1 ∧ ball (x i) (e i) ⊆ X i"
by (rule choice, auto simp add: *)
then obtain e where "⋀i. e i > 0" "⋀i. e i < 1" "⋀i. ball (x i) (e i) ⊆ X i"
by blast
define m where "m = Min {(1/2)^(to_nat i) * e i|i. i ∈ I}"
have "m > 0" if "I≠{}"
unfolding m_def Min_gr_iff using ‹finite I› ‹I ≠ {}› ‹⋀i. e i > 0› by auto
moreover have "{y. dist x y < m} ⊆ U"
proof (auto)
fix y assume "dist x y < m"
have "y i ∈ X i" if "i ∈ I" for i
proof -
have *: "summable (λn. (1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
by (rule summable_comparison_test'[of "λn. (1/2)^n"], auto simp add: summable_geometric_iff)
define n where "n = to_nat i"
have "(1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1 < m"
using ‹dist x y < m› unfolding dist_fun_def using sum_le_suminf[OF *, of "{n}"] by auto
then have "(1/2)^(to_nat i) * min (dist (x i) (y i)) 1 < m"
using ‹n = to_nat i› by auto
also have "... ≤ (1/2)^(to_nat i) * e i"
unfolding m_def apply (rule Min_le) using ‹finite I› ‹i ∈ I› by auto
ultimately have "min (dist (x i) (y i)) 1 < e i"
then have "dist (x i) (y i) < e i"
using ‹e i < 1› by auto
then show "y i ∈ X i" using ‹ball (x i) (e i) ⊆ X i› by auto
qed
then have "y ∈ Pi⇩E UNIV X" using H(1) unfolding I_def topspace_euclidean by (auto simp add: PiE_iff)
then show "y ∈ U" using ‹Pi⇩E UNIV X ⊆ U› by auto
qed
ultimately have *: "∃m>0. {y. dist x y < m} ⊆ U" if "I ≠ {}" using that by auto

have "U = UNIV" if "I = {}"
using that H(1) unfolding I_def topspace_euclidean by (auto simp add: PiE_iff)
then have "∃m>0. {y. dist x y < m} ⊆ U" if "I = {}" using that zero_less_one by blast
then show "∃m>0. {y. dist x y < m} ⊆ U" using * by blast
qed

lemma ball_fun_contains_open_aux:
fixes x::"('a ⇒ 'b)" and e::real
assumes "e>0"
shows "∃U. open U ∧ x ∈ U ∧ U ⊆ {y. dist x y < e}"
proof -
have "∃N::nat. 2^N > 8/e"
then obtain N::nat where "2^N > 8/e" by auto
define f where "f = e/4"
have [simp]: "e>0" "f > 0" unfolding f_def using assms by auto
define X::"('a ⇒ 'b set)" where "X = (λi. if (∃n≤N. i = from_nat n) then {z. dist (x i) z < f} else UNIV)"
have "{i. X i ≠ UNIV} ⊆ from_nat{0..N}"
unfolding X_def by auto
then have "finite {i. X i ≠ topspace euclidean}"
unfolding topspace_euclidean using finite_surj by blast
have "⋀i. open (X i)"
unfolding X_def using metric_space_class.open_ball open_UNIV by auto
then have "⋀i. openin euclidean (X i)"
using open_openin by auto
define U where "U = Pi⇩E UNIV X"
have "open U"
unfolding open_fun_def product_topology_def apply (rule topology_generated_by_Basis)
unfolding U_def using ‹⋀i. openin euclidean (X i)› ‹finite {i. X i ≠ topspace euclidean}›
by auto
moreover have "x ∈ U"
unfolding U_def X_def by (auto simp add: PiE_iff)
moreover have "dist x y < e" if "y ∈ U" for y
proof -
have *: "dist (x (from_nat n)) (y (from_nat n)) ≤ f" if "n ≤ N" for n
using ‹y ∈ U› unfolding U_def apply (auto simp add: PiE_iff)
unfolding X_def using that by (metis less_imp_le mem_Collect_eq)
have **: "Max {dist (x (from_nat n)) (y (from_nat n))|n. n ≤ N} ≤ f"
apply (rule Max.boundedI) using * by auto

have "dist x y ≤ 2 * Max {dist (x (from_nat n)) (y (from_nat n))|n. n ≤ N} + (1/2)^N"
by (rule dist_fun_le_dist_first_terms)
also have "... ≤ 2 * f + e / 8"
apply (rule add_mono) using ** ‹2^N > 8/e› by(auto simp add: algebra_simps divide_simps)
also have "... ≤ e/2 + e/8"
unfolding f_def by auto
also have "... < e"
by auto
finally show "dist x y < e" by simp
qed
ultimately show ?thesis by auto
qed

lemma fun_open_ball_aux:
fixes U::"('a ⇒ 'b) set"
shows "open U ⟷ (∀x∈U. ∃e>0. ∀y. dist x y < e ⟶ y ∈ U)"
proof (auto)
assume "open U"
fix x assume "x ∈ U"
then show "∃e>0. ∀y. dist x y < e ⟶ y ∈ U"
using open_fun_contains_ball_aux[OF ‹open U› ‹x ∈ U›] by auto
next
assume H: "∀x∈U. ∃e>0. ∀y. dist x y < e ⟶ y ∈ U"
define K where "K = {V. open V ∧ V ⊆ U}"
{
fix x assume "x ∈ U"
then obtain e where e: "e>0" "{y. dist x y < e} ⊆ U" using H by blast
then obtain V where V: "open V" "x ∈ V" "V ⊆ {y. dist x y < e}"
using ball_fun_contains_open_aux[OF ‹e>0›, of x] by auto
have "V ∈ K"
unfolding K_def using e(2) V(1) V(3) by auto
then have "x ∈ (⋃K)" using ‹x ∈ V› by auto
}
then have "(⋃K) = U"
unfolding K_def by auto
moreover have "open (⋃K)"
unfolding K_def by auto
ultimately show "open U" by simp
qed

instance proof
fix x y::"'a ⇒ 'b" show "(dist x y = 0) = (x = y)"
proof
assume "x = y"
then show "dist x y = 0" unfolding dist_fun_def using ‹x = y› by auto
next
assume "dist x y = 0"
have *: "summable (λn. (1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
by (rule summable_comparison_test'[of "λn. (1/2)^n"], auto simp add: summable_geometric_iff)
have "(1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1 = 0" for n
using ‹dist x y = 0› unfolding dist_fun_def by (simp add: "*" suminf_eq_zero_iff)
then have "dist (x (from_nat n)) (y (from_nat n)) = 0" for n
by (metis div_0 min_def nonzero_mult_div_cancel_left power_eq_0_iff
zero_eq_1_divide_iff zero_neq_numeral)
then have "x (from_nat n) = y (from_nat n)" for n
by auto
then have "x i = y i" for i
by (metis from_nat_to_nat)
then show "x = y"
by auto
qed
next
text‹The proof of the triangular inequality is trivial, modulo the fact that we are dealing
with infinite series, hence we should justify the convergence at each step. In this
respect, the following simplification rule is extremely handy.›
have [simp]: "summable (λn. (1/2)^n * min (dist (u (from_nat n)) (v (from_nat n))) 1)" for u v::"'a ⇒ 'b"
by (rule summable_comparison_test'[of "λn. (1/2)^n"], auto simp add: summable_geometric_iff)
fix x y z::"'a ⇒ 'b"
{
fix n
have *: "dist (x (from_nat n)) (y (from_nat n)) ≤
dist (x (from_nat n)) (z (from_nat n)) + dist (y (from_nat n)) (z (from_nat n))"
have "0 ≤ dist (y (from_nat n)) (z (from_nat n))"
using zero_le_dist by blast
moreover
{
assume "min (dist (y (from_nat n)) (z (from_nat n))) 1 ≠ dist (y (from_nat n)) (z (from_nat n))"
then have "1 ≤ min (dist (x (from_nat n)) (z (from_nat n))) 1 + min (dist (y (from_nat n)) (z (from_nat n))) 1"
by (metis (no_types) diff_le_eq diff_self min_def zero_le_dist zero_le_one)
}
ultimately have "min (dist (x (from_nat n)) (y (from_nat n))) 1 ≤
min (dist (x (from_nat n)) (z (from_nat n))) 1 + min (dist (y (from_nat n)) (z (from_nat n))) 1"
using * by linarith
} note ineq = this
have "dist x y = (∑n. (1/2)^n * min (dist (x (from_nat n)) (y (from_nat n))) 1)"
unfolding dist_fun_def by simp
also have "... ≤ (∑n. (1/2)^n * min (dist (x (from_nat n)) (z (from_nat n))) 1
+ (1/2)^n * min (dist (y (from_nat n)) (z (from_nat n))) 1)"
apply (rule suminf_le)
using ineq apply (metis (no_types, hide_lams) add.right_neutral distrib_left
le_divide_eq_numeral1(1) mult_2_right mult_left_mono zero_le_one zero_le_power)
also have "... = (∑n. (1/2)^n * min (dist (x (from_nat n)) (z (from_nat n))) 1)
+ (∑n. (1/2)^n * min (dist (y (from_nat n)) (z (from_nat n))) 1)"
also have "... = dist x z + dist y z"
unfolding dist_fun_def by simp
finally show "dist x y ≤ dist x z + dist y z"
by simp
next
text‹Finally, we show that the topology generated by the distance and the product
topology coincide. This is essentially contained in Lemma \verb+fun_open_ball_aux+,
except that the condition to prove is expressed with filters. To deal with this,
we copy some mumbo jumbo from Lemma \verb+eventually_uniformity_metric+ in
\verb+Real_Vector_Spaces.thy+›
fix U::"('a ⇒ 'b) set"
have "eventually P uniformity ⟷ (∃e>0. ∀x (y::('a ⇒ 'b)). dist x y < e ⟶ P (x, y))" for P
unfolding uniformity_fun_def apply (subst eventually_INF_base)
by (auto simp: eventually_principal subset_eq intro: bexI[of _ "min _ _"])
then show "open U = (∀x∈U. ∀⇩F (x', y) in uniformity. x' = x ⟶ y ∈ U)"
unfolding fun_open_ball_aux by simp

end

text ‹Nice properties of spaces are preserved under countable products. In addition
to first countability, second countability and metrizability, as we have seen above,
completeness is also preserved, and therefore being Polish.›

instance "fun" :: (countable, complete_space) complete_space
proof
fix u::"nat ⇒ ('a ⇒ 'b)" assume "Cauchy u"
have "Cauchy (λn. u n i)" for i
unfolding cauchy_def proof (intro impI allI)
fix e assume "e>(0::real)"
obtain k where "i = from_nat k"
using from_nat_to_nat[of i] by metis
have "(1/2)^k * min e 1 > 0" using ‹e>0› by auto
then have "∃N. ∀m n. N ≤ m ∧ N ≤ n ⟶ dist (u m) (u n) < (1/2)^k * min e 1"
using ‹Cauchy u› unfolding cauchy_def by blast
then obtain N::nat where C: "∀m n. N ≤ m ∧ N ≤ n ⟶ dist (u m) (u n) < (1/2)^k * min e 1"
by blast
have "∀m n. N ≤ m ∧ N ≤ n ⟶ dist (u m i) (u n i) < e"
proof (auto)
fix m n::nat assume "m ≥ N" "n ≥ N"
have "(1/2)^k * min (dist (u m i) (u n i)) 1
= sum (λp. (1/2)^p * min (dist (u m (from_nat p)) (u n (from_nat p))) 1) {k}"
using ‹i = from_nat k› by auto
also have "... ≤ (∑p. (1/2)^p * min (dist (u m (from_nat p)) (u n (from_nat p))) 1)"
apply (rule sum_le_suminf)
by (rule summable_comparison_test'[of "λn. (1/2)^n"], auto simp add: summable_geometric_iff)
also have "... = dist (u m) (u n)"
unfolding dist_fun_def by auto
also have "... < (1/2)^k * min e 1"
using C ‹m ≥ N› ‹n ≥ N› by auto
finally have "min (dist (u m i) (u n i)) 1 < min e 1"
by (auto simp add: algebra_simps divide_simps)
then show "dist (u m i) (u n i) < e" by auto
qed
then show "∃N. ∀m n. N ≤ m ∧ N ≤ n ⟶ dist (u m i) (u n i) < e"
by blast
qed
then have "∃x. (λn. u n i) ⇢ x" for i
using Cauchy_convergent convergent_def by auto
then have "∃x. ∀i. (λn. u n i) ⇢ x i"
using choice by force
then obtain x where *: "⋀i. (λn. u n i) ⇢ x i" by blast
have "u ⇢ x"
proof (rule metric_LIMSEQ_I)
fix e assume [simp]: "e>(0::real)"
have i: "∃K. ∀n≥K. dist (u n i) (x i) < e/4" for i
by (rule metric_LIMSEQ_D, auto simp add: *)
have "∃K. ∀i. ∀n≥K i. dist (u n i) (x i) < e/4"
apply (rule choice) using i by auto
then obtain K where K: "⋀i n. n ≥ K i ⟹ dist (u n i) (x i) < e/4"
by blast

have "∃N::nat. 2^N > 4/e"
then obtain N::nat where "2^N > 4/e" by auto
define L where "L = Max {K (from_nat n)|n. n ≤ N}"
have "dist (u k) x < e" if "k ≥ L" for k
proof -
have *: "dist (u k (from_nat n)) (x (from_nat n)) ≤ e / 4" if "n ≤ N" for n
proof -
have "K (from_nat n) ≤ L"
unfolding L_def apply (rule Max_ge) using ‹n ≤ N› by auto
then have "k ≥ K (from_nat n)" using ‹k ≥ L› by auto
then show ?thesis using K less_imp_le by auto
qed
have **: "Max {dist (u k (from_nat n)) (x (from_nat n)) |n. n ≤ N} ≤ e/4"
apply (rule Max.boundedI) using * by auto
have "dist (u k) x ≤ 2 * Max {dist (u k (from_nat n)) (x (from_nat n)) |n. n ≤ N} + (1/2)^N"
using dist_fun_le_dist_first_terms by auto
also have "... ≤ 2 * e/4 + e/4"
using ** ‹2^N > 4/e› less_imp_le by (auto simp add: algebra_simps divide_simps)
also have "... < e" by auto
finally show ?thesis by simp
qed
then show "∃L. ∀k≥L. dist (u k) x < e" by blast
qed
then show "convergent u" using convergent_def by blast
qed

instance "fun" :: (countable, polish_space) polish_space
by standard

subsection ‹Measurability›

text ‹There are two natural sigma-algebras on a product space: the borel sigma algebra,
generated by open sets in the product, and the product sigma algebra, countably generated by
products of measurable sets along finitely many coordinates. The second one is defined and studied
in \verb+Finite_Product_Measure.thy+.

These sigma-algebra share a lot of natural properties (measurability of coordinates, for instance),
but there is a fundamental difference: open sets are generated by arbitrary unions, not only
countable ones, so typically many open sets will not be measurable with respect to the product sigma
algebra (while all sets in the product sigma algebra are borel). The two sigma algebras coincide
only when everything is countable (i.e., the product is countable, and the borel sigma algebra in
the factor is countably generated).

In this paragraph, we develop basic measurability properties for the borel sigma algebra, and
compare it with the product sigma algebra as explained above.
›

lemma measurable_product_coordinates [measurable (raw)]:
"(λx. x i) ∈ measurable borel borel"
by (rule borel_measurable_continuous_on1[OF continuous_on_product_coordinates])

lemma measurable_product_then_coordinatewise:
fixes f::"'a ⇒ 'b ⇒ ('c::topological_space)"
assumes [measurable]: "f ∈ borel_measurable M"
shows "(λx. f x i) ∈ borel_measurable M"
proof -
have "(λx. f x i) = (λy. y i) o f"
unfolding comp_def by auto
then show ?thesis by simp
qed

text ‹To compare the Borel sigma algebra with the product sigma algebra, we give a presentation
of the product sigma algebra that is more similar to the one we used above for the product
topology.›

lemma sets_PiM_finite:
"sets (Pi⇩M I M) = sigma_sets (Π⇩E i∈I. space (M i))
{(Π⇩E i∈I. X i) |X. (∀i. X i ∈ sets (M i)) ∧ finite {i. X i ≠ space (M i)}}"
proof
have "{(Π⇩E i∈I. X i) |X. (∀i. X i ∈ sets (M i)) ∧ finite {i. X i ≠ space (M i)}} ⊆ sets (Pi⇩M I M)"
proof (auto)
fix X assume H: "∀i. X i ∈ sets (M i)" "finite {i. X i ≠ space (M i)}"
then have *: "X i ∈ sets (M i)" for i by simp
define J where "J = {i ∈ I. X i ≠ space (M i)}"
have "finite J" "J ⊆ I" unfolding J_def using H by auto
define Y where "Y = (Π⇩E j∈J. X j)"
have "prod_emb I M J Y ∈ sets (Pi⇩M I M)"
unfolding Y_def apply (rule sets_PiM_I) using ‹finite J› ‹J ⊆ I› * by auto
moreover have "prod_emb I M J Y = (Π⇩E i∈I. X i)"
unfolding prod_emb_def Y_def J_def using H sets.sets_into_space[OF *]
by (auto simp add: PiE_iff, blast)
ultimately show "Pi⇩E I X ∈ sets (Pi⇩M I M)" by simp
qed
then show "sigma_sets (Π⇩E i∈I. space (M i)) {(Π⇩E i∈I. X i) |X. (∀i. X i ∈ sets (M i)) ∧ finite {i. X i ≠ space (M i)}}
⊆ sets (Pi⇩M I M)"
by (metis (mono_tags, lifting) sets.sigma_sets_subset' sets.top space_PiM)

have *: "∃X. {f. (∀i∈I. f i ∈ space (M i)) ∧ f ∈ extensional I ∧ f i ∈ A} = Pi⇩E I X ∧
(∀i. X i ∈ sets (M i)) ∧ finite {i. X i ≠ space (M i)}"
if "i ∈ I" "A ∈ sets (M i)" for i A
proof -
define X where "X = (λj. if j = i then A else space (M j))"
have "{f. (∀i∈I. f i ∈ space (M i)) ∧ f ∈ extensional I ∧ f i ∈ A} = Pi⇩E I X"
unfolding X_def using sets.sets_into_space[OF ‹A ∈ sets (M i)›] ‹i ∈ I›
by (auto simp add: PiE_iff extensional_def, metis subsetCE, metis)
moreover have "X j ∈ sets (M j)" for j
unfolding X_def using ‹A ∈ sets (M i)› by auto
moreover have "finite {j. X j ≠ space (M j)}"
unfolding X_def by simp
ultimately show ?thesis by auto
qed
show "sets (Pi⇩M I M) ⊆ sigma_sets (Π⇩E i∈I. space (M i)) {(Π⇩E i∈I. X i) |X. (∀i. X i ∈ sets (M i)) ∧ finite {i. X i ≠ space (M i)}}"
unfolding sets_PiM_single
apply (rule sigma_sets_mono')
apply (auto simp add: PiE_iff *)
done
qed

lemma sets_PiM_subset_borel:
"sets (Pi⇩M UNIV (λ_. borel)) ⊆ sets borel"
proof -
have *: "Pi⇩E UNIV X ∈ sets borel" if [measurable]: "⋀i. X i ∈ sets borel" "finite {i. X i ≠ UNIV}" for X::"'a ⇒ 'b set"
proof -
define I where "I = {i. X i ≠ UNIV}"
have "finite I" unfolding I_def using that by simp
have "Pi⇩E UNIV X = (⋂i∈I. (λx. x i)-(X i) ∩ space borel) ∩ space borel"
unfolding I_def by auto
also have "... ∈ sets borel"
using that ‹finite I› by measurable
finally show ?thesis by simp
qed
then have "{(Π⇩E i∈UNIV. X i) |X::('a ⇒ 'b set). (∀i. X i ∈ sets borel) ∧ finite {i. X i ≠ space borel}} ⊆ sets borel"
by auto
then show ?thesis unfolding sets_PiM_finite space_borel
qed

lemma sets_PiM_equal_borel:
"sets (Pi⇩M UNIV (λi::('a::countable). borel::('b::second_countable_topology measure))) = sets borel"
proof
obtain K::"('a ⇒ 'b) set set" where K: "topological_basis K" "countable K"
"⋀k. k ∈ K ⟹ ∃X. (k = Pi⇩E UNIV X) ∧ (∀i. open (X i)) ∧ finite {i. X i ≠ UNIV}"
using product_topology_countable_basis by fast
have *: "k ∈ sets (Pi⇩M UNIV (λ_. borel))" if "k ∈ K" for k
proof -
obtain X where H: "k = Pi⇩E UNIV X" "⋀i. open (X i)" "finite {i. X i ≠ UNIV}"
using K(3)[OF ‹k ∈ K›] by blast
show ?thesis unfolding H(1) sets_PiM_finite space_borel using borel_open[OF H(2)] H(3) by auto
qed
have **: "U ∈ sets (Pi⇩M UNIV (λ_. borel))" if "open U" for U::"('a ⇒ 'b) set"
proof -
obtain B where "B ⊆ K" "U = (⋃B)"
using ‹open U› ‹topological_basis K› by (metis topological_basis_def)
have "countable B" using ‹B ⊆ K› ‹countable K› countable_subset by blast
moreover have "k ∈ sets (Pi⇩M UNIV (λ_. borel))" if "k ∈ B" for k
using ‹B ⊆ K› * that by auto
ultimately show ?thesis unfolding ‹U = (⋃B)› by auto
qed
have "sigma_sets UNIV (Collect open) ⊆ sets (Pi⇩M UNIV (λi::'a. (borel::('b measure))))"
apply (rule sets.sigma_sets_subset') using ** by auto
then show "sets (borel::('a ⇒ 'b) measure) ⊆ sets (Pi⇩M UNIV (λ_. borel))"
unfolding borel_def by auto