Produit de topologie en Coq

Voici l’exercice qu’on va abordé dans ce billet :

Soit \((X, T )\) un espace topologique séparé. Montrer que la diagonale \(\Delta\) de \(X ×X\) est fermée dans
\(X × X\).

http://math.univ-lille1.fr/~bodin/exolic1/exolic.pdf

Aparté sur les topologies initiales

Mon livre de topologie définit les produits de topologies comme la topologie initiale des fonctions de projections \(p_i = (x_1, x_2) \in X, X \to x_i\). Ce qui nous amène à regarder ce qu’est une topologie initiale.

Pour être transparent, je vois également le terme de « topologie faible » utilisé ; c’est justement le terme utilisé par coq-topology… Je n’ai pour l’instant pas trouvé s’il y a une différence entre les 2 concepts, dans la suite je pars du principe qu’il s’agit de la même chose.

Une topologie initiale permet de construire une topologie sur un espace qui n’en dispose pas à partir de fonctions de cet espace sur un espace qui, lui, est topologique. Ainsi, si on dispose d’un espace X, et de fonctions \(f_i:X \to Y_i\) avec \(Y_i\) topologique, on définit une topologie sur X comme étant l’ensemble des intersections des \(f_i^{-1}(O_i)\) avec \(O_i\) ouvert de \(Y_i\). Ceci permet d’assurer que, par construction, ces fonctions sont continues.

Dans le cas des fonctions produits, les ouverts sont donc de la forme \(O_1 x O_2\) avec \(O_1\) un ouvert de \(Y_1\) et \(O_2\) un ouvert de \(Y_2\).

Preuve en Coq

Le module coq-topology dispose d’un module ProductTopology qui lui-même se base sur le module WeakTopology qui implémente les définitions du paragraphe précédent.

Comme souvent la principale difficulté n’est pas à trouver dans les mathématiques, il ne s’agit que de dérouler des définitions ; en revanche, ces définitions sont particulièrement peu digestes en Coq.

On va utiliser également les axiomes de séparations déjà définis dans coq-topology.

From Topology Require Import TopologicalSpaces.
From Topology Require Import InteriorsClosures.
From Topology Require Import Neighborhoods.
From Topology Require Import ProductTopology.
From Topology Require Import SeparatednessAxioms.

On dispose de quelques fonctions dans coq-topology pour faciliter l’écriture de produit de 2 topologies, qui se basent sur les fonctions built-in fst et snd de Coq. L’énoncé devient :


Theorem exo (X:TopologicalSpace):
  Hausdorff X -> closed (fun x:point_set (ProductTopology2 X X) => fst x = snd x).
Proof.

On va déplier les définitions :

  unfold Hausdorff.
  intros HypSep.
  unfold closed.

Pour plus de lisibilité, on va associer à l’ensemble \(\Delta\) une variable :

  remember (Complement (fun x : point_set (ProductTopology2 X X) => fst x = snd x)) as ExtDiagonale.

On passe ensuite par un résultat intermédiaire sur cette diagonale pour caractériser les éléments qui y appartiennent :

  assert (forall x y, not (x=y) <-> In ExtDiagonale (x,y)).
  split;intros.
  - rewrite HeqExtDiagonale. eauto with sets.
  - rewrite HeqExtDiagonale in H. eauto with sets.

Pour résoudre l’exercice, on va utiliser une base des ouverts sur le produit de topologie.

  - refine (coverable_by_open_basis_impl_open (ProductTopology2_basis X X) _ _ _). apply ProductTopology2_basis_is_basis.
    intros x0 x0inExtDiag. assert (x0 = (fst x0, snd x0)). apply surjective_pairing. rewrite H0 in x0inExtDiag. pose (tmp:=H (fst x0) (snd x0)). rewrite <- tmp in x0inExtDiag. destruct (HypSep (fst x0) (snd x0) x0inExtDiag) as [U [V ]].
    exists (fun x => In U (fst x) /\ In V (snd x)). inversion H1 as [openU [openV [x0InU [x0inV InterUVEmpty]]]].
    split.
    + replace (fun x : point_set X * point_set X => In U (fst x) /\ In V (snd x)) with [p : point_set (ProductTopology2 X X) | let (x, y) := p in In U x /\ In V y]. constructor ; repeat assumption. simpl. apply functional_extensionality. intros. Search ([_:_ | _]). rewrite characteristic_function_to_ensemble_is_identity. autounfold with *. assert (x=(fst x, snd x)). apply surjective_pairing. rewrite H2. simpl. trivial.
    + split.
      * autounfold with *. intros. pose (tmp2:=surjective_pairing x). rewrite tmp2. rewrite <- H. unfold In in H2. inversion H2. unfold not. intro. rewrite H5 in H3. assert(In (Intersection U V) (snd x)). eauto with *. rewrite InterUVEmpty in H6. Search Empty_set. apply Noone_in_empty in H6. assumption.
      * autounfold with *. eauto with *.
Qed.

Séparation en Coq

On continue dans la série des espaces topologiques avec un exercice sur les axiomes de séparation :

Soit \((X, T )\) un espace topologique.
Montrer que les conditions suivantes sont équivalentes :
(i) \(\forall x, y \in X, x \neq y, \exists V \text{voisinage de}x, y \notin V .\)
(ii) \(\forall x \in X, {x} fermé.\)
(iii) \(\forall x \in X, {V ; V \text{voisinage de }x} = {x}.\)
Soit \((X, T )\) ainsi et \(A \subset X\) tel que \(\overline{A} \neq A\). Montrer que si \(x \in \overline{A}\backslash A\), tout voisinage de \(x\) coupe \(\)A en une infinité de points.

Apparté sur la séparation

Cet exercice m’a donné l’occasion de découvrir le concept de séparation en topologie que je ne connaissais que très vaguement. L’idée derrière la séparation est de caractériser le niveau d’ « indépendance » des voisinages de deux points distincts. Plus exactement, on distingue 3 niveaux de séparations notés T0, T1 et T2:

  • T0 signifie que si on prend deux points distincts, on a au moins un voisinage de l’un qui ne contient pas l’autre,
  • T1 signifie que si on prend deux points distincts, chacun a au moins un voisinage ne contenant pas l’autre,
  • Enfin T2 est le niveau au dessus : si on prend deux points distincts, on a au moins un couple de voisinage respectif qui sont disjoints.

La plupart des espaces usuels (les réels, complexes, espaces vectoriels…) sont T2. Parmi les espaces qui ne sont pas séparés il y a les topologies grossières (ie l’ensemble entier et l’ensemble vide). J’avoue que je ne connais pas la motivation derrière les niveaux T0 et T1 et je n’ai pas d’exemples d’espace vérifiant ces niveaux mais pas les suivants.

Le trio d’équivalence est semble-t-il une propriété fondamentale des axiomes de séparation puisqu’il est directement présenté comme propriété dans mon livre de topologie, qui le démontre de bas en haut. J’ai essayé d’effectuer la démonstration en Coq de haut en bas mais je me suis retrouvé bloquer en cherchant à passer de (ii) à (iii) ; ayant ensuite décidé qu’il était peut-être plus sage de suivre une voie connue, j’ai finalement opté pour la démonstration de bas en haut. Il s’avère que le passage de (iii) à (ii) est aussi compliqué et que dans les autres cas les preuves sont plus ou moins des « miroirs » de celles que j’avais faite dans ma première tentative, j’imagine aisément qu’il est malgré tout possible d’effectuer la preuve dans n’importe quel sens.

Préalable

Une propriété particulièrement utile pour cette exercice est la caractérisation de l’adhérence d’un ensemble, appelé closure_impl_meets_every_open_neighborhood dans coq-topology : un point est dans l’adhérence d’un ensemble si tous ses voisinages rencontrent cet ensemble, ou dit autrement si l’intersection de ses voisinages avec cet ensemble n’est jamais vide.

Du point de vue plus pratique, on continue à utiliser quelques astuces qui simplifient la vie sur le long terme : on définit une tactic ensemble_proof_intro pour automatiquement nous fournir les 2 inclusions de l’égalité de l’ensemble à prouver, on se sert d’inversion plutôt que de destruct, et on nomme autant que possible les hypothèses/variables pour faciliter la lecture.

A noter qu’à un moment j’ai eu besoin de définir un axiome sur la décidabilité sur l’égalité de 2 éléments d’un ensemble. Par défaut si deux éléments d’un ensemble ne sont pas égaux, Coq ne déduit pas automatiquement qu’ils sont différents ; en effet la logique constructive sur laquelle est basée Coq se passe de l’axiome du tiers exclu qui stipule qu’une propriété (comme ici l’égalité) est vraie ou sa négation est vraie. Il faut donc manuellement indiqué que dans notre cas, c’est vrai.

Trio d’équivalence

On commence par les imports de circonstances et l’écriture des propriétés :

From Topology Require Import TopologicalSpaces.
From Topology Require Import InteriorsClosures.
From Topology Require Import Neighborhoods.
Require Import Decidable.

Definition P1 (X:TopologicalSpace) :=
  forall x y:point_set X, not (x = y) -> exists N, neighborhood N x /\ not (In N y).

Definition P2 (X:TopologicalSpace) :=
  forall x:point_set X, closed (Singleton x).

Definition P3 (X:TopologicalSpace) :=
  forall x:point_set X, FamilyIntersection [V:Ensemble (point_set X) | neighborhood V x] = Singleton x.

Ltac ensemble_proof_intro:=apply Extensionality_Ensembles; unfold Same_set; split.

On aura également besoin de montrer que si un singleton est contenu dans un autre, alors leur élément est égal :

Theorem Singleton_Inclusion (T:Type): forall x y:T, Included (Singleton x) (Singleton y) -> x = y.
Proof.
  intros.
  unfold Included in H. symmetry. apply Singleton_inv. apply H. eauto with sets.
Qed.

On commence ensuite par l’implication la plus compliqué, P3 vers P2 :

Theorem P3_implies_P2 {X:TopologicalSpace}:
  P3 X -> P2 X.
Proof.
  unfold P3. unfold P2.
  
  intros P3 x0.

La stratégie pour montrer que le singleton x est fermé, est de montrer qu’il est égal à son adhérence. Cette stratégie part de l’intuition que l’écriture de l’ensemble des voisinages est proche d’une intersection en ensemble de fermé contenant un ensemble.

  assert (Included (closure (Singleton x0)) (Singleton x0)).

  unfold Included.
  intros x xInClosure.

On va se servir de la propriété sur la caractérisation des adhérences. Quand on regarde les hypothèses de cette propriété, on voit qu’il va falloir trouver un ouvert, qui contient x, et on en déduira que x0 est dans V (car l’intersection du singleton x0 et V est non vide).

pose (tmp2:=closure_impl_meets_every_open_neighborhood  _ (Singleton x0) x xInClosure).

  assert (forall V, open_neighborhood V x -> Inhabited (Intersection (Singleton x0) V)).
  intros V VNeighbor. inversion VNeighbor. unfold open_neighborhood in VNeighbor.
  apply tmp2. 
  assumption. assumption.
  assert(forall V, open_neighborhood V x -> In V x0).
  intros. pose (tmp3:=H V H0). inversion tmp3. inversion H1. inversion H2. subst. assumption.

Pour rappel, on cherche à montrer ici que x est dans le singleton x0, ie que x = x0. Pour l’instant on n’a pas encore utilisé l’hypothèse P3. Pour se simplifier la vie on peut remarquer qu’on peut se servir des voisinages ouverts plutôt que des voisinages quelconques :


  assert( forall x : point_set X,  FamilyIntersection [V : Ensemble (point_set X) | neighborhood V x] =
                              FamilyIntersection [V : Ensemble (point_set X) | open_neighborhood V x]).
  {
    intros x1. ensemble_proof_intro.
   - intros  S SinInters. inversion SinInters.
    constructor. intros. apply H1. inversion H3. constructor. apply open_neighborhood_is_neighborhood. apply H4.
  - intros y yinIntersOpen. inversion yinIntersOpen.
    constructor. intros S SInInters. inversion SInInters as [[S' [OpenS' S'InS]]].
    refine (S'InS _ _). apply H1. split. assumption.
  }

Muni de ce résultat on peut prouver l’égalité:


  assert(Included (Singleton x0) (Singleton x)).
  unfold Included. intros y yisx0. inversion yisx0.
  rewrite <- (P3 x).
  rewrite (H1 x).
  constructor.
  intros. inversion H3. subst. eauto.

et donc l’inclusion inverse :

  apply Singleton_intro.
  refine (Singleton_Inclusion _ _ _ _). assumption.

La suite est relativement directe:


  assert (closure (Singleton x0) = Singleton x0).
  ensemble_proof_intro.
  apply H. apply closure_inflationary.
  rewrite <- H0. apply closure_closed.
Qed.

L’inclusion P2 vers P1 est plus simple:

Theorem P2_implies_P1 {X:TopologicalSpace}:
  P2 X -> P1 X.
Proof.
  unfold P1, P2.
  intros P2 x y xNeqy.
  unfold closed in P2.

  exists (Complement (Singleton y)). split.
  unfold neighborhood. exists (Complement (Singleton y)). split. unfold open_neighborhood. split. apply (P2 y).
  unfold Complement. unfold not. unfold In. intros. destruct xNeqy. inversion H. trivial.
  eauto with sets.
  eauto with sets.
Qed.

Celle de P1 vers P3 n’est pas beaucoup plus compliqué, mais nécessite quand même la décidabilité dont on a préalablement parlé, pour faire une disjonction de cas :

Theorem P1_implies_P3 {X:TopologicalSpace}:
  P1 X -> P3 X.
Proof.
  unfold P1. unfold P3.
  intros P1 x0.
  ensemble_proof_intro.
  - unfold Included. intros x xInIntersNeigh.
    destruct (decT X x0 x).
    + eauto with sets.
    + inversion xInIntersNeigh. destruct (P1 x0 x H). inversion H2. pose (tmp:= H0 x2). autounfold with sets in tmp.
      assert([V : Ensemble (point_set X) | neighborhood V x0] x2).
      constructor. assumption.
      apply tmp in H5. destruct (H4 H5).
  - unfold Included. intros x xIsx0.
    inversion xIsx0.
    constructor. intros. inversion H0. inversion H1. inversion H2. unfold Included in H4. apply H4. inversion H3. assumption.
Qed.

Seconde propriété

Alors là c’est vraiment costaud à démontrer, la faute à la démonstration de l’infinité. Coq dispose de quelques résultats sur les ensembles infinis, mais malheureusement peu nombreux et que nous n’utiliserons donc pas.
En revanche il est beaucoup plus simple de travailler sur les ensembles finis, on va donc procéder par l’absurde.

En particulier une propriété des ouverts qui est vraie dans le cas des ensembles finies mais qui ne l’est plus dans les ensembles infinis est la stabilité par intersection. On va donc prouver cette propriété, par récursion sur la taille de l’ensemble :

Theorem intersection_finite (X:TopologicalSpace):
  forall F:Family (point_set X), Finite _ F /\ (forall S, In F S -> open S) -> open (FamilyIntersection  F).
Proof.
  intros F [F_Finite F_Set_Of_Opens].
  apply finite_cardinal in F_Finite.
  destruct F_Finite as [n cardFn].
  generalize dependent F.
  induction n ; intros F cardFn F_Set_Of_Opens.
  - inversion cardFn. Search FamilyIntersection. rewrite empty_family_intersection.
    Print TopologicalSpace. apply open_full.
  - inversion cardFn. pose (tmp:= IHn A H0).
    assert(FamilyIntersection (Add A x) = Intersection (FamilyIntersection A) x).
    ensemble_proof_intro; unfold Included; intros x0.
    + intros x0InIntersAx.
      inversion x0InIntersAx.
      constructor.
      * constructor. eauto with sets.
      * eauto with sets.
    + intros x0InInters. inversion x0InInters. inversion H3. constructor. unfold Add.
      intros. inversion H8.
      * eauto with sets.
      *  inversion H9. subst. eauto with sets.

    + rewrite H3. apply open_intersection2.

      * apply tmp. intros. apply F_Set_Of_Opens. Search Add.
        unfold Add in H1. rewrite <- H1. eauto with sets.
      * apply F_Set_Of_Opens. rewrite <- H1. unfold Add. eauto with sets.
Qed.   

Un autre résultat qui m’a été utile est que l’égalité est conservée par passage au complément :


Theorem Complement_inv (X:Type) : forall (S1 S2: Ensemble X), Complement S1 = Complement S2 -> S1 = S2.
Proof.
  intros. ensemble_proof_intro; rewrite <- Complement_Complement with (A:=S1); rewrite <- Complement_Complement with (A:=S2); apply complement_inclusion; rewrite H; eauto with sets.
Qed.

On peut ensuite passer à la démonstration en elle-même :

Theorem part2 (X:TopologicalSpace): P2 X -> forall A: Ensemble (point_set X), forall x, In (Setminus (closure A) A) x -> forall N, neighborhood N x -> not (Finite _ (Intersection N A)).
Proof.
  intros P2 A x0 x0inclAminA.
  unfold Top.P2 in P2.
  destruct x0inclAminA as [x0InClA x0NotInA].
  intros N [O [[OpenO x0inO] OInN]].
  
  pose (tmp:=closure_impl_meets_every_open_neighborhood _ A x0 x0InClA).

  unfold not. intros NInterAFinite.
  
  remember (fun E => exists x, In (Intersection N A) x /\ E = Complement (Singleton x)) as SetOfElems.
  (**pose (tmp3:=intersection_finite _ SetOfElems).**)
  assert(Finite _ SetOfElems).
  generalize dependent SetOfElems.
  induction NInterAFinite; intros.
  - assert (SetOfElems = Empty_set). rewrite HeqSetOfElems. ensemble_proof_intro.
    + unfold Included. intros. unfold In in H. destruct H. destruct H. destruct H.
    + eauto with sets.
    + rewrite H. eauto with sets.


  - assert (SetOfElems = Add (fun E : Ensemble (point_set X) => exists x0 : point_set X, In A0 x0 /\ E = Complement (Singleton x0)) (Complement (Singleton x))).
    ensemble_proof_intro ; unfold Included; rewrite HeqSetOfElems.
    + intros. inversion H0. inversion H1.  unfold In. inversion H2 as [x2InA0|]. 
      * left. exists x2. split. assumption. assumption.
      * right. inversion H4. subst. eauto with sets.
    + intros. unfold In. inversion H0.
      * inversion H1. inversion H3. exists x3. split. left. assumption. assumption.
      * exists x. inversion H1. split. right. eauto with sets. trivial.


    + rewrite H0. constructor.
      * remember (fun E : Ensemble (point_set X) => exists x1 : point_set X, In A0 x1 /\ E = Complement (Singleton x1)) as P0.
        apply IHNInterAFinite. trivial.
      * unfold In. unfold not. intros. inversion H1. inversion H2.
        apply Complement_inv in H4. 
        apply Singleton_equal in H4. subst. destruct (H H3).
    
   
  - remember (FamilyIntersection SetOfElems) as ContraGen.
    assert (open ContraGen).
    rewrite HeqContraGen.
    apply intersection_finite. split.
    + assumption.
    + intros S SInSetOfElems. rewrite HeqSetOfElems in SInSetOfElems. unfold In in SInSetOfElems. inversion SInSetOfElems.
      inversion H0. rewrite H2. refine (P2 _).
    + pose (contra:= tmp (Intersection ContraGen O) (open_intersection2 ContraGen O H0 OpenO)).
      assert (In (Intersection ContraGen O) x0).
      rewrite HeqContraGen.
      constructor. constructor. rewrite HeqSetOfElems. intros. unfold In in H1. inversion H1. inversion H2. rewrite H4. Search Intersection. apply Intersection_decreases_r in H3. unfold In. unfold Complement. unfold not. intros. inversion H5. subst. contradiction.
      assumption.

      apply contra in H1. inversion H1. inversion H2. inversion H4. rewrite HeqContraGen in H6. rewrite HeqSetOfElems in H6. unfold In in H6. inversion H6. pose (contra2:= H9 (Complement (Singleton x))). unfold In in contra2.
      assert(exists x0 : point_set X, Intersection N A x0 /\ Complement (Singleton x) = Complement (Singleton x0)). exists x. split. constructor.
      eauto with sets. eauto with sets. trivial. apply contra2 in H11. destruct H11. constructor.
Qed.

Frontières en topologie et coq

Alors celui là, il est costaud malgré son apparente simplicité. Commençons par l’énoncé :

Dans un espace topologique, on définit la frontière d’une partie A comme étant \(\partial A = \overline{A}\backslash \mathring{A}\).


Montrer que \(
\partial A =
\partial (A^c )\) et que \(A =
\partial A \Leftrightarrow A\) fermé d’intérieur vide.


Montrer que \(
\partial (\overline{A})\) et \(
\partial (\mathring{A})\) sont toutes deux incluses dans \(
\partial A\), et donner un exemple où ces inclusions sont strictes.


Montrer que \(
\partial (A \cup B) \subset
\partial A \cup
\partial B\), et que l’inclusion peut-être stricte ; montrer qu’il y a égalité lorsque \(\overline{A} \cup \overline{B} = ∅\) (établir \(\mathring{A \cup B} \subset \mathring{A} \cup \mathring{B}\)).


Montrer que \(\mathring{A \cup B} = \mathring{A} \cup \mathring{B}\) reste vrai lorsque \(
\partial A \cap
\partial B = ∅\) (raisonner par l’absurde)

Il s’agit d’un exercice relativement classique pour un étudiant en topologie, qui permet surtout de manipuler les définitions  d’intérieur et d’adhérence et quelques formules sur les ensembles. Oui mais voilà, la plupart des résultats « intuitifs » sur les ensembles ont besoin d’être prouvé, ce qui donne lieu à des preuves fastidieuses. Pire, il n’est pas rare de se précipiter dans de fausses pistes, en substituant une définition de trop. Bref, cet exercice m’a demandé mine te rien plusieurs jours à effectuer, et surtout à passer par la case papier + crayon alors que je m’en étais passé jusque là. Il est néanmoins très formateur puisqu’il invite à chercher des moyens d’abréger l’écriture de preuve, à découper quelques résultats intermédiaires.

Quelques préalables

On évacue déjà la définition d’une frontière :

Definition frontier (X:TopologicalSpace) (A:Ensemble (point_set X)) :=
  Setminus (closure A) (interior A).

La taille de l’exercice est un bon prétexte pour s’autoriser à essayer les possibilités d’automation que propose Coq. On commence modeste avec une tactique personnalisée « ensemble_proof_intro » qui n’est qu’une espèce de macro sur un enchainement qu’on trouve souvent lorsqu’on travaille avec des ensembles : la réécriture en double inclusion et la génération des 2 objectifs associés.

Ltac ensemble_proof_intro:=
  apply Extensionality_Ensembles; unfold Same_set; split.

Premier point

Muni de ce petit raccourci, le premier résultat est assez direct à prouver :

Theorem frontier_comp (X:TopologicalSpace) (A:Ensemble (point_set X)):
  frontier X A = frontier X (Complement A).
Proof.
  unfold frontier. apply Extensionality_Ensembles. unfold Same_set. split; unfold Included; unfold Setminus in *; rewrite interior_complement; rewrite closure_complement; unfold In in * ;intros; destruct H.
  - split ; unfold Complement.
    + apply H0.
    + unfold not. intros. destruct (H1 H).
  - unfold In.  split. Search (Complement). Print Complement. pose (tmp:= (Complement_Complement _ (closure A))). unfold Complement in tmp. rewrite <- tmp. unfold In. unfold Complement in H0. apply H0. apply H.
Qed.

En revanche pour l’équivalence j’ai eu beaucoup plus de mal. La tentation est grande de remplacer A par sa définition en terme de frontière partout dès le début mais est contre-productive : une façon de prouver est de montrer que si on est dans l’intérieur de A on est aussi dans le complémentaire de l’intérieur de A.

Un autre écueil, certes moins bloquant, est d’unfolder les Included ce qui va rajouter pas mal de « bruits » dans les hypothèses ; une hypothèse de type Included S (interior A) s’est retrouvée « diluée » lors de mes premières tentatives et m’a obligé à la recréer via assert.

La définition de Setminus est toutefois assez peu pratique à utiliser, on va donc utiliser une écriture intermédiaire à base d’intersection et de complémentaire. Une occasion également d’utiliser la tactic eauto (pour une raison que j’ignore, elle fonctionne beaucoup mieux que la tactique auto).

D’après la documentation Coq, cette tactique va essayer d’appliquer la tactique apply (et non des rewrite !) avec des théorèmes groupées dans une base de donnée qui peut être étendue. En pratique, cette tactique marche bien si on a des hypothèses de type « In S x » dans le contexte et peu de Complement.

Theorem setminus_as_intersection (X:Type):
  forall A B:Ensemble X, Setminus A B = Intersection A (Complement B).
Proof.
  intros A B.
  ensemble_proof_intro;  unfold Setminus; unfold Included; unfold Complement; unfold In; intros; destruct H.
  - constructor ; eauto with sets.
  - split; eauto with sets.
Qed.

Quelques mini résultats sur les ensembles qui simplifient la démonstration de la seconde partie du premier point. Bien entendu je n’ai pas planifié à l’avance, j’ai extrait ces résultats quand le besoin s’en ait fait ressentir.

Theorem include_intersection (T:Type): forall (S1 S2 S3:Ensemble T), Included S3 (Intersection S1 S2) <-> Included S3 S1 /\ Included S3 S2.
Proof.
  intros. split.
  - intros. split ; unfold Included in *; intros; pose (tmp:= H x H0); destruct tmp.
    + apply H1.
    + apply H2.
  -  intros.  destruct H. unfold Included in *. intros. constructor. apply H. apply H1. apply H0. apply H1.
Qed.

Theorem Empty_set_intersection (T:Type): forall A: Ensemble T, Intersection A (Complement A) = Empty_set.
Proof.
  intros. ensemble_proof_intro.
  - unfold Included. unfold Complement. intros. destruct H. destruct (H0 H).
  - apply Included_Empty.
Qed.

Theorem Intersection_Complement_Empty_set (T:Type): forall S:Ensemble T,
    Intersection S (Complement Empty_set) = S.
Proof.
  intros. ensemble_proof_intro ;autounfold with sets; intros.
  - destruct H. eauto.
  - constructor.
    * eauto.
    * unfold Complement. unfold In. repeat autounfold in *. intros. destruct H0.
Qed.

Afin de me faciliter la vie j’ai également créé une base de donnée de réécriture ne contenant que le théorème remplaçant Setminus par une intersection. L’intérêt n’est pas de rendre la preuve automatique (autant écrire rewrite setminus_as_intersection directement) mais permet surtout d’effectuer plusieurs réécriture en une seule fois (ce qu’on aurait pu faire avec repeat).

Hint Rewrite -> setminus_as_intersection : sets_helper.

Sur ce voici comment prouver la seconde partie du résultat :

Theorem frontier_equiv (X:TopologicalSpace) (A:Ensemble (point_set X)):
  A = frontier X A <-> closed A /\ (interior A = Empty_set).
Proof.
  autounfold in *. autorewrite with sets_helper. split.
  - intro HypFrontierEgalite. split.
    + rewrite HypFrontierEgalite. apply closed_intersection2; try (rewrite <- closure_complement); apply closure_closed.
    + ensemble_proof_intro.
      * unfold Included. intros x xInInteriorA. destruct xInInteriorA as [S x0 HypS x0InS]. destruct HypS. destruct H as [openS SInA].
         assert (Included S (interior A)).
         unfold Included. intros. unfold interior. eapply family_union_intro with (S:=S). split. split. apply openS. apply SInA. apply H.

         assert (Included S (Complement (interior A))).
         rewrite HypFrontierEgalite in SInA. rewrite include_intersection in SInA. destruct SInA. apply H1.

         assert (Included S (Intersection (interior A) (Complement (interior A)))).
         unfold Included. intros. constructor. apply (H x H1). apply (H0 x H1).

         rewrite Empty_set_intersection in H1. destruct (H1 x0 x0InS).
         * apply Included_Empty.
  - intros [HypClosed HypInteriorEmpty]. rewrite HypInteriorEmpty.
    autorewrite with sets_helper.
    ensemble_proof_intro.
    + apply closure_inflationary.
    + rewrite closure_fixes_closed.  eauto with sets. assumption.
Qed.

Second point

Les inclusions des frontières des intérieurs et des adhérences ne sont pas très compliquées à démontrer, il s’agit surtout d’utiliser les théorèmes de croissance et d’inflation/déflation de ces objets mathématiques :

Theorem incl_frontier (X:TopologicalSpace) (A:Ensemble (point_set X)):
  Included (frontier X (interior A)) (frontier X A).
Proof.
  autounfold. autorewrite with sets_helper.
  unfold Included. 
  intros _ [x xInClosureInteriorA xInComplementClosureInteriorA].
  autounfold with sets.
  constructor.
  - refine (closure_increasing _ _ _ x xInClosureInteriorA).
    apply interior_deflationary.
  - refine (complement_inclusion  _ _ _ x xInComplementClosureInteriorA).
    rewrite <- interior_fixes_open with (S:=interior A) at 1.
    eauto with sets.
    apply interior_open.
Qed.

Theorem incl_frontier2 (X:TopologicalSpace) (A:Ensemble (point_set X)):
  Included (frontier X (closure A)) (frontier X A).
Proof.
  autounfold. autorewrite with sets_helper. autounfold with sets.
  rewrite closure_fixes_closed. intros _ [x xInClosureA xInComplementInteriorClosureA]. constructor.
  + apply xInClosureA.
  + refine (complement_inclusion _ _ _ x xInComplementInteriorClosureA). refine (interior_increasing _ _ _).
    apply closure_inflationary.
  + apply closure_closed.
Qed.

L’inclusion de la frontière de l’union dans l’union des frontières est également assez directe (surtout si on s’autorise des eauto) :

Theorem front_union (X:TopologicalSpace): forall A B, Included (frontier X (Union A B)) (Union (frontier X A) (frontier X B)).
Proof.  
  intros. autounfold. autorewrite with sets_helper.
  rewrite closure_union.

  unfold Included.
  intros _ [x xInUClAClB xInComplementIntUAB].
  destruct xInUClAClB as [x0  xInClosureA | x0 xInClosureB].
  - left. constructor.
    * apply xInClosureA.
    * refine (complement_inclusion _ _ _ x0 xInComplementIntUAB).
      apply interior_increasing. eauto with sets.
  - right. constructor.
    * apply xInClosureB.
    * refine (complement_inclusion _ _ _ x0 xInComplementIntUAB).
      apply interior_increasing. eauto with sets.
Qed.

En revanche les choses se corsent pour démontrer l’inclusion inverse dans le cas de la disjonction des adhérences.

Clang-tidy

Au bureau, on nous a cédé le code source d’un logiciel relativement ancien et dont le précédent propriétaire ne souhaitait pas continuer la maintenance.Si d’ m point de vue business il s’ agissait d’une opportunité des plus lucratives, puisqu’on a hérité d’une base de clients colossales, travailler sur du code qui a dormi parfois pendant près de 10 ans est particulièrement difficile.

Pour dresser une image plus précise, le projet utilise une version antédiluvienne de WxWidgets et de boost, en réimplémentant toutefois les smart pointers (qui étaient probablement encore à l’état de standardisation à l’époque ). On ressent assez rapidement le fait que plusieurs personnes sont passés dessus, avec un étrange mélange de pratique douteuses de développement logiciel (des fichiers entiers copié et collés) qui côtoient les design pattern classiques d’une base de code de taille respectable.

Et bien entendu, il n’y a pas ou peu de tests unitaires rendant chaque tentative de refactoring hasardeuse.

La récente série de posts autour de la customisation de clang-tidy sur le blog de visual c++ tombe à bien nommé :

  • https://blogs.msdn.microsoft.com/vcblog/2018/10/19/exploring-clang-tooling-part-1-extending-clang-tidy/
  • https://blogs.msdn.microsoft.com/vcblog/2018/10/23/exploring-clang-tooling-part-2-examining-the-clang-ast-with-clang-query/
  • https://blogs.msdn.microsoft.com/vcblog/2018/11/06/exploring-clang-tooling-part-3-rewriting-code-with-clang-tidy/

Pour référence pour plus tard je partage le bout de code qui permet de détecter les types std::string, qu’ils apparaissent explicitement ou via un using ou typedef:

auto typeParamMatcher =
		varDecl(hasType(hasUnqualifiedDesugaredType(
     recordType(hasDeclaration(cxxRecordDecl(hasName("basic_string")))))));

Si on supprime le hasUnqualifiedDesugaredType, on peut ne matcher que l’apparition explicite de ce type:

varDecl(hasType(cxxRecordDecl(matchesName("string"))))

Intérieurs et adhérences en Coq

On continue dans la série d’exercice autour de la topologie, cette fois-ci en rentrant un peu plus dans le sujet en manipulant les concepts d’intérieur et d’adhérence.
Le module coq topology fournit une définition de ces concepts, ainsi que plusieurs propriétés usuelles (inclusions diverses, relation avec les compléments, caractérisation par la rencontre non vide etc) ; j’ai senti moins d’absences étranges que dans le cas des unions de familles comme dans les 2 exercices précédents.

Le sujet, toujours tiré de la même feuille d’exercice :

Si \(A\) est une partie de l’espace topologique \(X\), on pose \(\alpha(A) = \mathring{\overline{A}}\) et \(\beta(A) = \overline{\mathring{A}}\).
Montrer que \(\alpha\) et \(\beta]\) sont des applications croissantes pour l’inclusion de \(\mathcal{P}(X)\) dans \(\mathcal{P}(X)\).
Montrer que si \(A\) est ouvert, \(A\subset\alpha(A)\) et si \(A\) est fermé, \(\beta(A)\subset A\). En déduire que
\(\alpha^2 = \alpha\) et \(\beta^2 = \beta\).

On va traduire les définitions en Coq :

From Topology Require Import InteriorsClosures. 

Definition alpha (X:TopologicalSpace) (A:Ensemble (point_set X)) :=
interior (closure A). 

Definition beta (X:TopologicalSpace) (A:Ensemble (point_set X)) := 
closure (interior A).

La croissance est relativement facile à prouver à partir de la croissance des intérieurs fourni par le module topology et adhérences et en tripatouillant les définitions :

Theorem croiss (X:TopologicalSpace) :
    forall A B, Included A B -> Included (alpha X A) (alpha X B).
Proof.
   unfold alpha. unfold Included. intros A B H x.
   apply interior_increasing. apply closure_increasing.
   unfold Included. apply H.
Qed.

Prouver les inclusions est également relativement simple :

Theorem open_alpha (X:TopologicalSpace) :
    forall A: Ensemble (point_set X), open A -> Included A (alpha X A). Proof.
    unfold alpha. intros. Search (interior). apply interior_maximal.
    apply H. apply closure_inflationary.
Qed.

Theorem closure_beta (X:TopologicalSpace) :
    forall A: Ensemble (point_set X), closed A -> Included (beta X A) A.
Proof.
   unfold beta. intros. Search (closure). apply closure_minimal.
   apply H. Search (interior). apply interior_deflationary.
Qed.

La dernière propriété est un peu plus délicate à prouver. Déplier les définitions n’est pas suffisant… Il faut en effet reconnaitre \(\alpha\) dans l’expression de \(\beta^2\) et réciproqement pour appliquer la propriété précédente.

Require Import Coq.Logic.FunctionalExtensionality. 

Theorem alpha_square (X:TopologicalSpace):
    alpha X = fun A => alpha X (alpha X A).
Proof.
   apply functional_extensionality. intros.
   apply Extensionality_Ensembles. unfold Same_set. split.
   - apply open_alpha. Search (interior). apply interior_open.
   - unfold alpha in *. pose(tmp:=closure_beta X (closure x)).
       unfold beta in tmp. Search (interior).
       apply interior_increasing. apply tmp. apply closure_closed.
 Qed.

Encore un peu de topologie en Coq

Seconde partie sur la série autour de quelques preuves d’exercices classiques de topologie en Coq, on va s’attaquer cette fois encore à un exercice de « réécriture » de définitions, toujours tiré de la même feuille d’exercice :

Soit \(X\) un ensemble non vide et \(\Sigma\) une famille de parties de \(X\) stable par intersection finie et contenant \(X\). Montrer que la plus petite topologie \(T\) contenant \(\Sigma\) (la topologie engendrée par \(\Sigma\)) est constituée des unions d’ensembles de \(\Sigma\), ou, de façon équivalente,
\(A\in T \iff \forall x\in A, \exists S \in \Sigma, x\in S \subset A\)
Montrer que l’on peut affaiblir l’hypothèse de stabilité par intersection finie en :
\(\forall S_1, S_2 \in \Sigma, \forall S \in S_1 \cap S_2, \exists S_3 \in \Sigma, x\in S_3 \subset S_1 \cap S_2\).

Là encore on va faire son marché parmi les choses qu’on veut démontrer : en particulier la première partie me semble pas particulièrement passionnante (c’est compliqué pour toutes les topologies y compris la plus petite de pas contenir au moins les unions d’ensemble) et donc on va passer directement à l’hypothèse affaiblie ; il suffit 1 de prouver que cette hypothèse combinée à la stabilité par union implique la stabilité par intersection finie.

En Coq

Dans le code on utilisera la lettre S pour désigner \(\Sigma\)2.

La stabilité par union est relativement simple à écrire:

Definition hypothese_union (T:Type) (S:Family T) :=
    forall S', Included S' S -> S (FamilyUnion S').

De même que l’hypothèse affaiblie de l’énoncé, qui n’est qu’une traduction avec les mots clés Coq qui vont bien :

Definition hypothese_afaiblie (T:Type) (S:Family T) :=
    forall (S1 S2:Ensemble T), 
    In S S1 ->
    In S S2 ->
    forall x, In (Intersection S1 S2) x ->
    (exists S3, In S S3 /\ In S3 x /\ Included S3 (Intersection S1 S2)).

Il faut cependant se méfier de l’apparente simplicité de ces définitions, un des écueils auxquels j’ai été confronté en rédigeant la preuve qui va suivre est la facilité avec laquelle on oublie d’expliciter une appartenance ou une inclusion dans un théorème, et donc casse les preuves qui en découlent.

Le théorème que l’on souhaite prouver :

Theorem exo:
    forall (T:Type) (S:Family T),
    hypothese_union T S ->
    hypothese_afaiblie T S ->
    (forall S1 S2, In S S1 -> In S S2 -> In S (Intersection S1 S2)). 
Proof.

Il peut être utile de prendre un peu de recul sur ce qu’on cherche à montrer : l’hypothèse affaiblie nous dit que, à défaut de stabilité « globale » par intersection finie, cette propriété vaut au moins localement. On peut alors s’en sortir en « découpant » une intersection en morceaux de S, et en réunissant ces morceaux grâces à l’hypothèse de stabilité par union.

Malheureusement je n’ai pas trouvé la plupart des théorèmes « intuitifs » sur les ensembles et leurs éléments dans le module zorns-lemma et il va donc falloir les écrire. Trouver quels sont les théorèmes dont on va avoir besoin est pas forcément facile et j’ai dû passer par pas mal de trial and errors avant de trouver comment m’en sortir, malgré l’apparente facilité de l’exercice.

Le  premier de ces théorèmes : si pour tout élément d’un ensemble E, on peut trouver un ensemble de S l’incluant, alors E est la réunion des éléments de S inclus dans E (si on n’avait pas l’hypothèse de l’implication, il aurait été possible d’avoir des « bouts qui manquent » dans E).

Qed.

Theorem union_of_elem (T:Type) (S:Family T) (E:Ensemble T):
  (forall x, In E x -> exists S', In S S' /\ In S' x /\ Included S' E) ->
  E=FamilyUnion (fun S' => In S S' /\ Included S' E).
Proof.

Là encore on est dans des manipulations de définition donc on va pas mal spammer la tactique unfold. La preuve se déroule alors relativement linéairement.

  intros. apply Extensionality_Ensembles. unfold Same_set. unfold Included in *. split.
  - unfold In. intros. destruct (H x H0). destruct H1. destruct H2.
    apply family_union_intro with (S:=x0). intros. split.
    + apply H1.
    + intros. apply H3. apply H4.
    +  apply H2.
  - intros. destruct H0. unfold In in *. destruct H0. apply H2. apply H1.
Qed.

Le second théorème est peut-être plus dispensable, je pense qu’il est possible de démontrer directement le résultat sur les intersections. Néanmoins par souci de clarté je le reproduis ici : il s’agit de montrer que rajouter l’hypothèse de stabilité des unions au théorème précédent fait que E est dans S :


Theorem function_app (T:Type) (S:Family T) (E:Ensemble T): 
  hypothese_union T S -> (forall x, In E x -> exists S', In S S' /\ In S' x /\ Included S' E) -> In S E.
Proof.

C’est surtout une application du théorème précédent:

  unfold hypothese_union. intros. pose (tmp:= union_of_elem T S E).
  rewrite tmp. apply H. unfold Included at 1. intros. destruct H1. apply H1. apply H0.
Qed.

Enfin la démonstration de l’exercice : ici il suffit de constater que le résultat précédent s’applique à une intersection d’éléments de S, sachant que l’hypothèse affaiblie est vérifiée. La preuve devient :

Proof.
  intros. apply function_app. apply H. intros. unfold hypothese_afaiblie in *. pose (tmp:= H0 S1 S2 H1 H2 x H3). destruct tmp. exists x0. apply H4.
Qed.


Un peu de topologie en Coq

Apprendre un langage de preuve est particulièrement déroutant quand on est habitué aux langages de programmations « classiques » qu’ils soient fonctionnels ou non : la plupart des patterns classiques deviennent perdent leur pertinence pour du code qui ne sera pas exécuté, et il faut adopter une façon différente de « penser » qui s’attachent aux propriétés des choses et non au comment de leur réalisation. Cependant s’il est difficile de transposer les pratiques de programmation pour s’entrainer à manipuler le langage, les maths fournissent beaucoup de matériau qui lui sied particulièrement bien (ce qui n’est pas surprenant). J’ai choisi de m’intéresser à la topologie dans cette série de billets pour voir jusqu’où il est possible d’aller. Je conseille fortement d’avoir lu au moins le premier tome de software foundation pour bien profiter de cette série.

Pour l’instant je m’inspire librement de https://github.com/coq-contribs/topology et en particulier je vais utiliser comme lui le module https://github.com/coq-contribs/zorns-lemma qui contient une implémentation des familles dénombrables ou non d’ensembles, de propriétés sur les fonctions etc. Il existe peut-être d’autres implémentation ailleurs mais je n’en ai pas trouvé.

Installation

Afin de pouvoir utiliser simplement les modules coq public, j’utilise le gestionnaire de paquets opam. Ce dernier n’est pas disponible nativement sur Windows actuellement, il faut donc passer par Windows Subsystem for Linux. L’installation se fait classiquement, via apt install m4 opam pour l’image Debian ou Ubuntu, m4 s’avérant parfois requis par certains paquets opam.

On utilise ensuite opam, qui va installer les paquets dans le répertoire de l’utilisateur, et modifier le fichier profile pour que bash puisse trouver l’exécutable Coq.

opam init
opam repo add coq-released http://coq.inria.fr/opam/released
opam install coq

Un premier exercice

Pour débuter, j’ai préféré rester modeste en choisissant un exercice relativement « tautologique » de topologie classique, trouvé sur cette liste : http://math.univ-lille1.fr/~bodin/exolic1/exolic.pdf :

Soit \(X\) un espace topologique, et \(f\) une application quelconque de \(X\) dans un ensemble \(Y\). On dit qu’une partie \(A\) de \(Y\) est ouverte, si \(f^{− 1}(A)\) est un ouvert de \(X\). Vérifier qu’on a défini ainsi une topologie sur \(Y\).

Sur les 3 axiomes définissant une topologie, celui sur l’appartenance de l’ensemble vide et de Y est relativement évident

1

, celui sur l’intersection fini est déjà défini dans zorns-lemma. Il reste donc l’axiome de stabilité par union.

Définitions d’ensemble, de réunion quelconque etc

La librairie standard de Coq propose une implémentation des ensembles https://coq.inria.fr/library/Coq.Sets.Ensembles.html : ces derniers contiennent juste une fonction d’appartenance de leur élément. On notera surtout la présence de l’axiome d’extensionalité (deux ensembles sont égaux s’ils sont inclus l’un dans l’autre) qu’on va utiliser dans la suite.

Coté zorns-lemma existe une définition de famille d’ensembles https://github.com/coq-contribs/zorns-lemma/blob/master/Families.v, qui correspond, de façon plutôt prévisible, à un alias sur les ensembles d’ensembles. Le type qui nous intéresse en particulier est celui de FamilyUnion, qui va « réduire » une famille en un ensemble. A noter que zorns-lemma propose aussi une version « indexed » des familles, version indexed qui, contrairement à ce que je pensais initialement, peut être indexée par n’importe quoi, et pas seulement par des entiers, et est probablement plus simple à manipuler ; cependant, dans la suite, je me base seulement sur le FamilyUnion classique.

On se lance

Premier point : définir l’ensemble réciproque d’une fonction. On pourrait certes utiliser la définition fournie par zorns-lemma, mais, vu que ce module ne fournit que très peu de propriétés sur les fonctions réciproques, le gain est minime.

From Topology Require Import TopologicalSpaces.

Definition img_recip (X Y:Type) (f:X-&amp;gt;Y) (A: Ensemble Y) : Ensemble X:=

fun x =&amp;gt; In A (f x).

Seconde étape, formuler l’égalité de l’union des images réciproques et de l’image réciproque de l’union. Pour plus de lisibilité, on va définir les deux séparément. D’un coté, on a l’image réciproque d’une union, relativement immédiate :

Definition img_recip_union (X Y:Type) (Fa: Family Y) (f:X-&amp;gt;Y) :=

img_recip X Y f (FamilyUnion Fa).

De l’autre, on a la réunion des images réciproques, et c’est là où les choses commencent à se gâter. Si une FamilyUnion est une ensemble en premier lieu, il faut donc écrire une fonction d’appartenance, sauf que les éléments sont ici eux-mêmes des ensembles…dont la description nécessite quelques circonvolutions : il faut à la fois exprimer qu’on a l’image réciproque de quelque chose, et que ledit quelque chose est dans la famille de départ. J’avoue avoir galéré quelques temps avant de parvenir à écrire la définition, dont l’inélégance augure quelques prises de tête dans les futures preuves qui y seront rattachées :

Definition img_recip_union_as_fu (X Y:Type) (Fa: Family Y) (f:X-&amp;gt;Y) : Ensemble X :=

FamilyUnion (fun S =&amp;gt; exists F, In Fa F /\ S = (img_recip X Y f F)).

Il aurait probablement été plus simple de passer par les familles indexées (la faculté de « nommer » les ensembles qu’on manipule par leurs indices plutôt que par un quantifieur d’existence doit plutôt aider).

On pose enfin le théorème d’égalité des deux quantités :

Theorem union_img_inverse : forall (X Y : Type) (Fa:Family Y) (f:X-&amp;gt;Y),

(img_recip_union_as_fu X Y Fa f) = (img_recip_union X Y Fa f).

Proof.

Comme énoncé préalablement, on reste sur un exercice plutôt tautologique, où on ne fait guère que renommer les choses. Par conséquent une grosse partie de la preuve va consister à utiliser en boucle la tactique unfold, qui va juste expliciter les définitions :

unfold img_recip_union_as_fu. unfold img_recip_union.

intros. unfold img_recip. unfold In.

On se retrouve avec une égalité entre deux ensembles.

apply Extensionality_Ensembles. split.

- unfold Included. unfold In. intros. destruct H eqn:Heqn. unfold In in i. destruct i eqn:ieqn. destruct a.

apply family_union_intro with (S:=x0). subst. apply f0. unfold In in i0. unfold In. subst. apply i0.

- unfold Included. intros. unfold In in H. Print FamilyUnion. remember (f x) as fx. destruct H.

eapply family_union_intro with (S:=fun x1 : X =&amp;gt; S (f x1)). unfold In. exists S. split. apply H. trivial.

unfold In. rewrite &amp;lt;- Heqfx. apply H0.

Qed.

EMGU (OpenCV pour .Net) à la rescousse

Lors de mon précédent billet j’avais présenté comment utiliser les Windows Forms pour afficher une image. J’ai depuis découvert l’existence d’EMGU, un wrapper pour OpenCV qui fournit pas mal de fonctions utilitaires dont certaines pour charger et afficher des images. La plupart des fonctions usuelles de la bibliothèque sont disponibles de façon directe sous le namespace CvInvoke. Ainsi pour charger une image on utilisera imread comme suit :

open Emgu.CV

let img = CvInvoke.Imread(@ »C:\Users\vljno\Desktop\Canardcomission.png »)

Et pour l’afficher on utilisera imshow comme suit :

CvInvoke.Imshow(« nom de fenêtre », img)

CvInvoke.WaitKey(0)

Ce qui ne surprendra pas les personnes ayant déjà utilisé OpenCV dans d’autres langage.

Pour récupérer les données d’une image on utilisera le membre GetData de l’objet Mat retourné par Imread qui donnera un tableau 1d de bytes de l’image. A l’inverse, le membre SetTo permettra de changer le contenu de l’image.

img.GetData ([||])

img.SetTo someArray

Traitement d’image avec Fsharp et OpenCL

En ce moment je découvre les possibilités de F# en matière de scientific computing. F# (prononcé « Fsharp ») est un langage calqué sur OCaml dont il partage la syntaxe de base et une grosse partie de la bibliothèque standard. Quelques fonctionnalités disparaissent (les foncteurs et plus généralement tout ce qui concerne les modules, les types algébriques généralisés), des fonctionnalités sont légèrement retouchées (le quotation mark devient <@… @>, indentation non libre…), en contrepartie le langage a accès à la totalité de l’écosystème DotNet ou leur équivalent Mono et NetCore. Ces environnements étant particulièrement populaires il n’est pas étonnant de voir qu’il existe déjà des bibliothèques pour le calcul statistique, la recherche opérationnelle, les divers algorithmes d’intelligence artificielle, et pour ce qui nous concerne ici l’interfaçage avec des APIs de GPGPU comme OpenCL. Ce qui me donne l’occasion de tester les capacités de F# en tant que langage pour le traitement d’image face à un Python ou à un Matlab.

Commençons déjà par le code permettant de charger une image. De base DotNet fournit la classe Bitmap permettant de charger à peu près n’importe quel format courant et nous proposant d’accéder à ses pixels. Cette dernière est présente dans l’espace System.Drawing (dont il faudra référencer l’assembly) :

open System.Drawing
[<EntryPoint>]
let main argv =
    let img = new Bitmap(@"C:\Users\moi\Documents\fichier.jpg")
    // ….
    0

Afin de vérifier que tout se passe comme attendu il est souhaitable d’afficher cette image. Pour cela nous allons créer un System.Windows.Forms et dessiner l’image dedans via ce code :

open System.Windows.Forms
// ….
let form = new Form(Visible=true)
form.Paint.Add(function e-> e.Graphics.DrawImage(img, e.ClipRectangle, e.ClipRectangle, GraphicsUnit.Pixel))
System.Windows.Forms.Application.Run(form)

Si tout se passe bien vous devriez voir apparaitre votre image à l’écran dans une fenêtre relativement simple.

Maintenant que nous avons chargé notre image nous pouvons nous pencher sur l’utilisation d’OpenCL. Pour cela nous allons passer par la bibliothèque Brahma.OpenCL qui fournit à Fsharp une interface de relativement haut niveau autour d’OpenCL.Net. Cette dernière est disponible via Nuget.
L’initialisation de Brahma est relativement simple, il faut deux objets, un provider (qui représente votre installation OpenCL sur votre machine) et une CommandQueue à laquelle nous soumettrons les tâches que nous voulons effectuer :

open Brahma.OpenCL
open Brahma.FSharp.OpenCL.Core
open Brahma.FSharp.OpenCL.Extensions
open OpenCL.Net
open FSharp.Core
// ….
let provider = ComputeProvider.Create("*", DeviceType.Gpu)
let mutable commandQueue = new Brahma.OpenCL.CommandQueue(provider, provider.Devices |> Seq.head)

Ici nous utiliserons le premier GPU disponible, d’où le Seq.head.

L’avantage de Brahma.OpenCL est qu’elle repose sur les quotations marks pour la création de kernel OpenCL. Une quotation mark est un code F# sous forme d’arbre de syntaxe abstrait, ie une expression qui peut ensuite être passée comme argument à une fonction F#, par exemple pour la modifier, l’interpréter, ou dans le cas de Brahma, la traduire en code OpenCL. Ici nous allons écrire un filtre de Sobel (norme du gradient) prenant en argument un tableau 1d source et un tableau 1d destination (le gradient a besoin des informations des pixels l’entourant, il n’est pas possible de modifier « inplace » les données d’un tableau de façon concurrente. A noter que les quotations mark peuvent capturer des variables comme ici stride.

open Microsoft.FSharp.Quotations
// ….
let stride = img.Height;
let command = <@ fun (range:_2D) (buf:array<byte>) (dst:array<byte>) ->
    let i = range.GlobalID0
    let j = range.GlobalID1
    let mutable h = float32 0.
    if (i > 0 && i < stride) then
        let left = float32 buf.[i - 1 + stride * j]
        let right = float32 buf.[i + 1 + stride * j]
        h <- abs (left - right)
    let mutable v = float32 0.
    if (j > 0) then
        let top = float32 buf.[i + stride * (j - 1)]
        let bottom = float32 buf.[i + stride * (j + 1)]
        v <- abs (top - bottom)
    dst.[i + stride * j] <- byte (sqrt (h * h + v * v)) @>

Bien entendu il n’est pas possible d’écrire n’importe quel code, les kernels OpenCL ne pouvant pas être récursifs par exemple ou appeler des lambdas. La compilation d’une quotation mark sur du code qui ne peut être traduit génèrera une exception.

let kernel, kernelprepare, kernelrun = provider.Compile command

Les valeurs kernelprepare et kernelrun de la compilation permettent respectivement de mettre à disposition les dimensions et arguments (ici les tableaux buf et dst) du kernel au GPU, et d’exécuter ce code kernel via la syntaxe suivante :

kernelprepare d src dst
commandQueue.Add(kernelrun()) |> ignore
commandQueue.Add(dst.ToHost provider).Finish() |> ignore

d est un objet contenant les dimensions du workgroup (global et local) à utilizer pour le kernel, src et dst sont des Arrays F# classiques. On aura au préalable transféré le contenu 2d de img dans src 1d :

let d = _2D(img.Width, img.Height, 8, 8)
let src = Array.init (img.Width * img.Height) (function i -> img.GetPixel(i / stride, i % stride).R)
let dst = Array.zeroCreate (img.Width * img.Height)

Enfin une fois le kernel execute nous copions le contenu de dst dans img :

Array.iteri (fun i (v:byte) -> img.SetPixel(i / stride, i % stride, Color.FromArgb(255, int(v), int(v), int(v)))) dst

Voilà !

Emacs mode for VS 2017

Visual Studio 2008 had an Emacs mode that added most commonly used Emacs keybindings in the IDE. VS 2010 later made the feature available as an optional extension which unfortunaly wasn’t carried over on VS 2013. However the source of the extensions were published so that the communit could carry over : https://github.com/zbrad/EmacsKeys

Porting the extension to the latest version of Visual Studio is actually quite easy. It requires enabling Desktop DotNet and Visual Studio SDK feature in the installer though.

Out of the box the solution won’t compile because of missing assemblies : EnvDTE, Microsoft.VisualStudio.Shell.10*. EnvDTE references should be manually replaced by a reference to the envdte.dll assembly on the disk (in Program Files(x86)\Common Files\Microsoft Shared\MSEnv\PublicAssemblies\) ; I’m not sure why VS2017 doesn’t find it automatically to be honest seems it’s registered in a rather standard location.
Microsoft.VisualStudio.Shell.15 (there’s 2 versions available in the reference browser, both are needed) and Microsoft.VisualStudio.Shell.15.Framework will replace the reference to the older Shell.10 ones ; doing so will make the project target the 4.6.2 Framework.

The last piece of the port is to add a Prerequisites in the vsixmanifest file. I suggest adding the base IDE as the sole one.

Next the extension should build properly.