Board logo
Détection des contours dans une image
ftbass - 03/07/2004 à 19:29

Ce projet vise à détecter des contours dans une image.

Je travaille pour l'instant sur des .pgm (images à niveaux de gris) de 256x256 pixels.

La première méthode consiste à parcourir tous les pixels de l'image. La valeur du pixel est notée P.
Pour chacun de ces pixels, on récupère la valeur maximale des 8 pixels de son entourage (notée Max).

On marque le pixel dans l'image résultant du traitement si le coefficient  (P/Max) est inférieur à une
valeur donnée, sinon, on le laisse blanc.

Donc plus la tolérance est élevée, plus on a de détails.

code:
--////////////////////////////////////////////////////////////////////////--
--                       Code ecrit par Julien COIGNET              --
--                  Pour le CNAM de Cergy                  --
--                Sujet : Détection de contours                --
--            Traite exclusivement les images au format .pgm        --
--                d'une taille de 256 x 256 pixels              --
--            (intervalle du type TypeEntete à adapter            --
--              selon le logiciel qui a créé le .pgm)            --
--////////////////////////////////////////////////////////////////////////--


--with Paquetage_Image; use Paquetage_Image;
with text_io; use text_io;
with ada.integer_Text_Io; use ada.integer_Text_Io;
with ada.Float_Text_Io; use ada.Float_Text_Io;
with sequential_io;

procedure Contours is

--////////////////////////////////////////////////////////////////////////--
--                                    Paquetages                          --
--////////////////////////////////////////////////////////////////////////--

package fichier_car is new sequential_IO(character); use fichier_car;

--////////////////////////////////////////////////////////////////////////--
--                                    Types                              --
--////////////////////////////////////////////////////////////////////////--

-- Type Entete: Vecteur qui contient l'entete du fichier image
     -- Intervalles de TypeEntete suivant le logiciel :    --
     --        irfanview : 0..37                  --
     --        Paint Shop Pro : 0..42              --
     --        CréationImage (logiciel maison) : 0..42  --
type TypeEntete is array (0..42) of character;

-- Type Matrice: Matrice qui reçoit le contenu d'une image de 256 par 256 pixels
type TypeMatrice is array (0..255, 0..255) of character;

-- Type MatriceTrv : Matrice de plongement
Type TypeMatriceTrv is array (0..257, 0..257) of character;

--////////////////////////////////////////////////////////////////////////--
--                                    Fonctions                            --
--////////////////////////////////////////////////////////////////////////--

-- Fonction qui récupère l'entête du fichier image
function getEntete(fichier : in fichier_car.file_type) return typeEntete is

Car : character;
Resultat : typeEntete;

begin
 for i in TypeEntete'Range loop
   read(Fichier, car);
   resultat(I) := Car;
 end loop;
 return resultat;
end GetEntete;

-- Lit le fichier et le met dans une matrice
function FichierDansMatrice(fichier : in fichier_car.file_type) return typeMatrice is

CarLu : character;
Resultat : TypeMatrice;

begin
 -- On zappe l'entete
 for i in TypeEntete'Range loop
   read(Fichier, carLu);
 end loop;
 -- On remplit la matrice avec le contenu de l'image
 for i in typeMatrice'range(1) loop
   for j in typeMatrice'range(2) loop
     read(Fichier, carLu);
     resultat(i, j) := carLu;
   end loop;
 end loop;
 return resultat;
end FichierDansMatrice;

-- Fonction qui retourne la matrice donnée en argument en matrice plongée
function PlongerMatrice(MatriceIni : in TypeMatrice) return TypeMatriceTrv is
 
Resultat : TypeMatriceTrv;

begin
 -- On initialise les bords à 0
 for i in Resultat'range(1) loop
   Resultat(0, i) := character'val(0);
   Resultat(257, i) := character'val(0);
   Resultat(I, 0) := character'val(0);
   Resultat(i, 257) := character'val(0);
 end loop;
 -- On remplit le reste
 for i in MatriceIni'range(1) loop
   for j in MatriceIni'range(2) loop
     Resultat(I+1, J+1) := MatriceIni(I, J);
   end loop;
 end loop;
 return resultat;
end;

-- Fonction qui détermine les contours selon la première méthode
function ContoursImage1(MatriceI : in typeMatriceTrv; seuil : float := 0.5) return TypeMatrice is

Resultat : TypeMatrice;
Valeur, Max : integer;
Coeff : float;

begin
 -- Pour chaque pixel de l'image...
 for i in (MatriceI'First(1) + 1)..(MatriceI'last(1) - 1) loop
   for j in (MatriceI'First(2) + 1)..(MatriceI'last(2) - 1) loop
     Valeur := character'pos(MatriceI(i, j));
     Max := Valeur;
     -- ...on cherche la valeur la plus élevée des 9 pixels
     for k in (i-1)..(i+1) loop
       for l in (j-1)..(j+1) loop
         if Max < character'pos(MatriceI(K, L)) then
           Max := character'pos(matriceI(K, L));
         end if;
       end loop;
     end loop;
     --put(max);
     if Max > 0 then
       if ((float(Valeur) / float(Max)) <= Seuil) then
         Resultat(i-1, j-1) := character'val(0);
       else
         Resultat(i-1, j-1) := character'val(255);
       end if;
     else
       Resultat(i-1, j-1) := character'val(255);
     end if;
   end loop;
 end loop;

 return Resultat;

end;

--////////////////////////////////////////////////////////////////////////--
--                               Procédures                              --
--////////////////////////////////////////////////////////////////////////--

-- Procedure qui lit une matrice (TypeMatrice) et l'ecrit dans un fichier
procedure EcrireMatriceDansFichier(Matrice : in typeMatrice; Fichier : in out fichier_car.file_type) is

begin
 
 for i in typeMatrice'range(1) loop
   for j in typeMatrice'range(2) loop
     write(Fichier, matrice(i, j));
   end loop;
 end loop;
end ecrireMatriceDansFichier;


procedure EcrireMatriceDansFichier(entete : in typeEntete; Matrice : in typeMatrice; Fichier : in out fichier_car.file_type) is

begin
 for i in TypeEntete'Range loop
   write(fichier, entete(i));
 end loop;
 for i in typeMatrice'range(1) loop
   for j in typeMatrice'range(2) loop
     write(Fichier, matrice(i, j));
   end loop;
 end loop;
end ecrireMatriceDansFichier;

--////////////////////////////////////////////////////////////////////////--
--                               Prog principal                            --
--////////////////////////////////////////////////////////////////////////--

MatriceI, MatriceR : TypeMatrice;
MatriceTemp : TypeMatriceTrv;
NomFichierInitial, NomFichierResultat : string(1..30);
comptChaine : integer;
fichierInitial, FichierResultat : fichier_car.file_type;
Entete : TypeEntete;
Tolerance : float;

begin
 put("Donnez le nom du fichier a traiter : ");
 get_line(item => nomFichierInitial, last => comptChaine);
 open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));
 Entete := GetEntete(FichierInitial);
 reset(FichierInitial);
 MatriceI := FichierDansMatrice(FichierInitial);
 MatriceTemp := PlongerMatrice(MatriceI);
 put("Entrez la tolerance (comprise entre 0 et 1) : ");
 get(Tolerance);
 skip_line;
 MatriceR := ContoursImage1(MatriceTemp, Tolerance);

 put("Entrez le nom du fichier de destination : ");
 get_line(item => NomfichierResultat, last => comptChaine);
 create(FichierResultat, name => NomFichierResultat(1..comptChaine));
 EcrireMatriceDansFichier(Entete, MatriceR, FichierResultat);
 close(FichierInitial);
 Close(FichierResultat);
 put("Traitement effectue.");

end Contours;


Comme d'hab', si il y a des commentaires, des améliorations, je suis preneur...

ftbass - 03/07/2004 à 19:50

Pour voir un peu ce que ça donne avec différentes valeurs :

http://Ada95000.free.fr/Images/img.jpg http://Ada95000.free.fr/Images/img2.jpg http://Ada95000.free.fr/Images/img3.jpg

ftbass - 05/07/2004 à 22:45

La meme avec IrfanView :

http://projetblitz.free.fr/Ressources/imgCassis.jpg

Conclusion :
y'a du taff...

ftbass - 09/07/2004 à 14:03

En attendant de déchiffrer les formules que m'a donné mon prof pour améliorer la détection
des contours, j'ai fait en sorte de pouvoir traiter toute image .pgm (quels que soient la taille
et le logiciel qui l'a fait).

code:

--////////////////////////////////////////////////////////////////////////--
-- Code ecrit par Julien COIGNET --
-- Pour le CNAM de Cergy --
-- Sujet : Détection de contours --
-- Traite exclusivement les images au format .pgm --
--////////////////////////////////////////////////////////////////////////--


--with Paquetage_Image; use Paquetage_Image;
with text_io; use text_io;
with ada.integer_Text_Io; use ada.integer_Text_Io;
with ada.Float_Text_Io; use ada.Float_Text_Io;
with sequential_io;

procedure Contours is

--////////////////////////////////////////////////////////////////////////--
-- Paquetages --
--////////////////////////////////////////////////////////////////////////--

package fichier_car is new sequential_IO(character); use fichier_car;

--////////////////////////////////////////////////////////////////////////--
-- Types --
--////////////////////////////////////////////////////////////////////////--

-- Type Entete: Vecteur qui contient l'entete du fichier image
type TypeEntete is array (integer range <>) of character;

-- Type Matrice: Matrice qui reçoit le contenu d'une image de 256 par 256 pixels
type TypeMatrice is array (integer range <>, integer range <>) of character;

-- Type MatriceTrv : Matrice de plongement
Type TypeMatriceTrv is array (integer range <>, integer range <>) of character;

-- Type qui contient la chaine décrivant les dimensions de l'image
type TabDim is array(1..10) of character;

--////////////////////////////////////////////////////////////////////////--
-- Fonctions --
--////////////////////////////////////////////////////////////////////////--

-- Fonction qui récupère l'entête du fichier image
function getEntete(fichier : in fichier_car.file_type; Entete : in TypeEntete) return typeEntete is

Car : character;
Resultat : typeEntete(Entete'range);

begin
  for i in Resultat'Range loop
     read(Fichier, car);
     resultat(I) := Car;
  end loop;
  return resultat;
end GetEntete;

-- Lit le fichier et le met dans une matrice
function FichierDansMatrice(fichier : in fichier_car.file_type; Entete : in TypeEntete; Matrice : in TypeMatrice) return typeMatrice is

CarLu : character;
Resultat : TypeMatrice(Matrice'range(1), Matrice'range(2));

begin
  -- On zappe l'entete
  for i in Entete'Range loop
     read(Fichier, carLu);
  end loop;
  -- On remplit la matrice avec le contenu de l'image
  for i in Matrice'range(1) loop
     for j in Matrice'range(2) loop
        read(Fichier, carLu);
        resultat(i, j) := carLu;
     end loop;
  end loop;
  return resultat;
end FichierDansMatrice;

-- Fonction qui retourne la matrice donnée en argument en matrice plongée
function PlongerMatrice(MatriceIni : in TypeMatrice) return TypeMatriceTrv is

Resultat : TypeMatriceTrv(0..MatriceIni'last(1)+2, 0..MatriceIni'last(2)+2);

begin
  -- On initialise les bords à 0
  for i in Resultat'range(1) loop  
     Resultat(I, 0) := character'val(0);
     Resultat(i, Resultat'last(2)) := character'val(0);
  end loop;
  for i in Resultat'range(2) loop
     Resultat(0, i) := character'val(0);
     Resultat(Resultat'last(1), i) := character'val(0);
  end loop;

  -- On remplit le reste
  for i in MatriceIni'range(1) loop
     for j in MatriceIni'range(2) loop
        Resultat(I+1, J+1) := MatriceIni(I, J);
     end loop;
  end loop;
  return resultat;
end;

-- Fonction qui détermine les contours selon la première méthode
function ContoursImage1(MatriceI : in typeMatriceTrv; seuil : float := 0.5; Matrice : in TypeMatrice) return TypeMatrice is

Resultat : TypeMatrice(Matrice'range(1), Matrice'range(2));
Valeur, Max : integer;
Coeff : float;

begin
  -- Pour chaque pixel de l'image...
  for i in (MatriceI'First(1) + 1)..(MatriceI'last(1) - 1) loop
     for j in (MatriceI'First(2) + 1)..(MatriceI'last(2) - 1) loop
        Valeur := character'pos(MatriceI(i, j));
        Max := Valeur;
        -- ...on cherche la valeur la plus élevée des 9 pixels
        for k in (i-1)..(i+1) loop
           for l in (j-1)..(j+1) loop
              if Max < character'pos(MatriceI(K, L)) then
                 Max := character'pos(matriceI(K, L));
              end if;
           end loop;
        end loop;
        --put(max);
        if Max > 0 then
           if ((float(Valeur) / float(Max)) <= Seuil) then
              Resultat(i-1, j-1) := character'val(0);
           else
              Resultat(i-1, j-1) := character'val(255);
           end if;
        else
           Resultat(i-1, j-1) := character'val(255);
        end if;
     end loop;
  end loop;

return Resultat;

end;


function CarVersNombre(Car : in character; Rang : integer) return integer is

Resultat : integer;
Coeff : integer:= 1;

begin

  case Car is
     when '0' =>
        Resultat := 0;
     when '1' =>
        Resultat := 1;
     when '2' =>
        Resultat := 2;
     when '3' =>
        Resultat := 3;
     when '4' =>
        Resultat := 4;
     when '5' =>
        Resultat := 5;
     when '6' =>
        Resultat := 6;
     when '7' =>
        Resultat := 7;
     when '8' =>
        Resultat := 8;
     when '9' =>
        Resultat := 9;
     when others =>
        Resultat := 0;
  end case;
  if Rang = 0 then
     Coeff := 1;
  else
     for i in 0..(Rang - 1) loop
        Coeff := (Coeff * 10);
     end loop;
  end if;
  Resultat := Resultat * Coeff;

  return Resultat;
 
end CarVersNombre;

-- Fonction qui retourne le nombre de caractères présents dans une entete
function NbCarEntete(Fichier : in fichier_car.file_type) return integer is

Resultat : integer := 0;
CarLu : Character;
ComptChar10 : integer := 0;

begin
  while ComptChar10 < 4 loop
     read(Fichier, Carlu);
     Resultat := Resultat + 1;
     if CarLu = character'val(10) then
        ComptChar10 := ComptChar10 + 1;
     end if;
  end loop;
  return Resultat;
end NbCarEntete;

--////////////////////////////////////////////////////////////////////////--
-- Procédures --
--////////////////////////////////////////////////////////////////////////--

-- Procedure qui lit une matrice (TypeMatrice) et l'ecrit dans un fichier
procedure EcrireMatriceDansFichier(Matrice : in typeMatrice; Fichier : in out fichier_car.file_type) is

begin

  for i in Matrice'range(1) loop
     for j in Matrice'range(2) loop
        write(Fichier, matrice(i, j));
     end loop;
  end loop;
end ecrireMatriceDansFichier;


procedure EcrireMatriceDansFichier(entete : in typeEntete; Matrice : in typeMatrice; Fichier : in out fichier_car.file_type) is

begin
  for i in Entete'Range loop
     write(fichier, entete(i));
  end loop;
  for i in Matrice'range(1) loop
     for j in Matrice'range(2) loop
        write(Fichier, matrice(i, j));
     end loop;
  end loop;
end ecrireMatriceDansFichier;

-- Procédure qui va lire les dimensions d'une imageet les mettre dans DimL, et DimH
procedure LireDimImage(Fichier : in fichier_car.file_type; DimL, DimH : in out integer) is

ComptChar10 : integer := 0;
CarLu : character;
i : integer := 1;
Tab : TabDim := ('a', 'a', 'a', 'a', 'a', 'a', 'a', 'a', 'a', 'a');
rang : integer := 0;
EspaceTrouve : boolean := false;

begin
  DimL := 0;
  DimH := 0;
  --reset(Fichier);
  while ComptChar10 < 3 loop
     read(Fichier, Carlu);
     if ComptChar10 = 2 then
        Tab(i) := CarLu;
        i := i + 1;
     end if;
     if Carlu = character'val(10) then
        ComptChar10 := ComptChar10 + 1;  
     end if;
  end loop;
  for i in reverse 1..10 loop
     if Tab(i) /= 'a' then
        if Tab(i) = ' ' then
           EspaceTrouve := true;
           Rang := 0;
        end if;
        if Tab(i) /= 'a' then
           Rang := Rang + 1;
           if EspaceTrouve = true then
              DimH := DimH + CarVersNombre(Tab(i), rang - 2);
           else
              DimL := DimL + CarVersNombre(Tab(i), rang - 2);
           end if;
        end if;
     end if;
  end loop;
 
end LireDimImage;
--////////////////////////////////////////////////////////////////////////--
-- Prog principal --
--////////////////////////////////////////////////////////////////////////--

NomFichierInitial, NomFichierResultat : string(1..30);
comptChaine : integer;
fichierInitial, FichierResultat : fichier_car.file_type;
Tolerance : float;
DimL, DimH : integer;

begin
  put("Donnez le nom du fichier a traiter : ");
  get_line(item => nomFichierInitial, last => comptChaine);
  open(fichierInitial, in_file, nomFichierInitial(1..comptChaine));

  declare Entete : TypeEntete(0..(NbCarEntete(FichierInitial) - 1));
  begin
     reset(FichierInitial);
     LireDimImage(FichierInitial, DimL, DimH);
     
     declare MatriceI: TypeMatrice(0..DimL-1, 0..DimH-1);
     begin
     
        declare MatriceR: TypeMatrice(0..DimL-1, 0..DimH-1);
        begin
       
        reset(FichierInitial);
        Entete := GetEntete(FichierInitial, Entete);
        reset(FichierInitial);
        MatriceI := FichierDansMatrice(FichierInitial, Entete, MatriceI);

        declare MatriceTemp : TypeMatriceTrv (0..MatriceI'last(1)+2, 0..MatriceI'last(2)+2);
        begin
       
           MatriceTemp := PlongerMatrice(MatriceI);
           put("Entrez la tolerance (comprise entre 0 et 1) : ");
           get(Tolerance);
           skip_line;
           MatriceR := ContoursImage1(MatriceTemp, Tolerance, MatriceR);


           put("Entrez le nom du fichier de destination : ");
           get_line(item => NomfichierResultat, last => comptChaine);
           create(FichierResultat, name => NomFichierResultat(1..comptChaine));
           EcrireMatriceDansFichier(Entete, MatriceR, FichierResultat);
           close(FichierInitial);
           Close(FichierResultat);
           put("Traitement effectue.");
        end;
       end;
     end;
  end;

end Contours;


Je vais mettre le code qui permet de déterminer les dimensions d'une image .pgm dans la partie cours du forum.

ps: Je recherche de l'aide pour déchiffrer les fameuses formules...

ftbass - 08/09/2004 à 11:36

J'ai ajouté une deuxieme methode :

code:

-- Fonction qui détermine les contours selon la -- DEUXIEME -- méthode
function ContoursImage2(MatriceI : in typeMatriceTrv; seuil : float := 0.5; Matrice : in TypeMatrice) return TypeMatrice is

Resultat : TypeMatrice(Matrice'range(1), Matrice'range(2));
ValeurPixel, Max : integer;
Coeff : float;

v : integer;
h : integer;

TabConvolution1 : array(-1..1, -1..1) of integer := ((-1, -1, -1), (0, 0, 0), (1, 1, 1));
TabConvolution2 : array(-1..1, -1..1) of integer := ((1, 0, -1), (1, 0, -1), (1, 0, -1));

begin
 -- Pour chaque pixel de l'image...
 for i in (MatriceI'First(1) + 1)..(MatriceI'last(1) - 1) loop
    for j in (MatriceI'First(2) + 1)..(MatriceI'last(2) - 1) loop
       ValeurPixel := character'pos(MatriceI(i, j));
       
       -- ...on cherche la valeur la plus élevée des 9 pixels
       v := 0;
       h := 0;
       for k in -1..1 loop
          for l in -1..1 loop
             v := v + (TabConvolution1(k, l) * character'pos(MatriceI(i + k, j + l)));
             h := h + (TabConvolution2(k, l) * character'pos(MatriceI(i + k, j + l)));
             
             if (k = 1 and l = 1) then
               if (v * v + h * h) > 8000 then
                 Resultat(i-1, j-1) := character'val(0);
             else
                 Resultat(i-1, j-1) := character'val(255);
               end if;
           end if;
          end loop;
       end loop;
    end loop;
 end loop;

return Resultat;

end;


(la valeur 8000 est fixée arbitrairement suite à des tests.

Ce que j'obtiens :
- image originale :
http://projetblitz.free.fr/Images/prost.jpg

- Méthode 1 :
http://projetblitz.free.fr/Images/prostbis.jpg

- Méthode 2 :
http://projetblitz.free.fr/Images/prost8.jpg