Permalink
Browse files

Update Extraction/extraction.ml

  • Loading branch information...
1 parent b7d8c58 commit 093191ec5e2c8f6baa288b9836e581e928bca9c1 @dezyal dezyal committed Oct 21, 2012
Showing with 371 additions and 12 deletions.
  1. +371 −12 Extraction/extraction.ml
View
@@ -1,16 +1,375 @@
-tupe
+type block_info =
+{
+ mutable c: int; (*classe*)
+ v: int; (*valeur du label*)
+ mutable b: (int*int); (*première position*)
+ mutable e: (int*int); (*dernière position*)
+ mutable w: int; (*largeur*)
+ mutable h: int; (*hauteur*)
+ mutable no: int; (*nombre de pixels dans le bloc binaire*)
+ mutable ns: int; (*nombre de pixels dans le bloc segmenté*)
+ mutable t: int (*nombre de transtition noir/blanc bloc binaire*)
+}
-let cdt mtx p l c = (p = 1) &&
- (mtx.(l-1).(c) = 1 ||
- mtx.(l-1).(c-1) = 1 ||
- mtx.(l).(c-1) = 1 ||
- mtx.(l+1).(c) = 1)
+(*
+ Projection horizontale d'une matrice.
+*)
+let h_prj mtx w h c =
+ if c > w then
+ invalid_arg "C value is higher than the width of the image.";
+ let mtx2 = Array.make_matrix w h 255 and n = ref 0 and min = ref 0 in
+ for y = 0 to h-1 do
+ for x = 0 to w-1 do
+ if mtx.(x).(y) = 255 then
+ begin
+ mtx2.(x).(y) <- 255;
+ n := !n+1
+ end
+ else
+ begin
+ if !min = 0 then
+ begin
+ min := x+1;
+ n := 0;
+ mtx2.(x).(y) <- 0
+ end
+ else
+ if !n <= c then
+ begin
+ for i = !min to x+1 do
+ mtx2.(i).(y) <- 0
+ done;
+ min := x+1;
+ n := 0;
+ end
+ else
+ begin
+ mtx2.(x).(y) <- 0;
+ min := x+1;
+ n := 0
+ end
+ end
+ done;
+ min := 0;
+ n := 0;
+ done;
+ mtx2
+
+(*
+ Projection verticale d'une matrice.
+*)
+let v_prj mtx w h c =
+ if c > h then
+ invalid_arg "C value is higher than the width of the image.";
+ let mtx2 = Array.make_matrix w h 255 and n = ref 0 and min = ref 0 in
+ for x = 0 to w-1 do
+ for y = 0 to h-1 do
+ if mtx.(x).(y) = 255 then
+ begin
+ mtx2.(x).(y) <- 255;
+ n := !n+1
+ end
+ else
+ begin
+ if !min = 0 then
+ begin
+ min := y+1;
+ n := 0;
+ mtx2.(x).(y) <- 0
+ end
+ else
+ if !n <= c then
+ begin
+ for i = !min to y+1 do
+ mtx2.(x).(i) <- 0
+ done;
+ min := y+1;
+ n := 0;
+ end
+ else
+ begin
+ mtx2.(x).(y) <- 0;
+ min := y+1;
+ n := 0
+ end
+ end
+ done;
+ min := 0;
+ n := 0;
+ done;
+ mtx2
-let line_recognition mtx w h =
- let mtx2 = Array.copy mtx in
- for c = 1 to h-2 do
- for l = 1 to h-2 do
- if (cdt mtx2 mtx2.(c).(l) l c) then
- mtx.(l).(c) <- 0
+(*
+ Algorithme de détection des lignes et colonnes.
+*)
+let rlsa mtx w h ch cv ce =
+ print_string "Run Length Smoothing Algorithm ...";
+ let mtx1 = h_prj mtx w h ch and mtx2 = v_prj mtx w h cv and
+ mtx3 = Array.make_matrix w h 0 in
+ for y = 0 to h-1 do
+ for x = 0 to w-1 do
+ if mtx1.(x).(y) = 0 && mtx2.(x).(y) = 0 then
+ mtx3.(x).(y) <- 0
+ else
+ mtx3.(x).(y) <- 255
done
+ done;
+ print_string " done\n";
+ h_prj mtx3 w h ce
+
+let rlsa2 mtx1 mtx2 w h ce =
+ print_string "Run Length Smoothing Algorithm ...";
+ let mtx3 = Array.make_matrix w h 0 in
+ for y = 0 to h-1 do
+ for x = 0 to w-1 do
+ if mtx1.(x).(y) = 0 && mtx2.(x).(y) = 0 then
+ mtx3.(x).(y) <- 0
+ else
+ mtx3.(x).(y) <- 255
+ done
+ done;
+ print_string " done\n";
+ h_prj mtx3 w h ce
+(*
+ Fonction de propagation des 4-connexes.
+*)
+let rec propa mtx1 mtx2 (x, y) v =
+ if mtx1.(x).(y+1) = 0 then
+ begin
+ mtx1.(x).(y+1) <- 1;
+ mtx2.(x).(y+1) <- v;
+ propa mtx1 mtx2 (x, y+1) v
+ end;
+ if mtx1.(x).(y-1) = 0 then
+ begin
+ mtx1.(x).(y-1) <- 1;
+ mtx2.(x).(y-1) <- v;
+ propa mtx1 mtx2 (x, y-1) v
+ end;
+ if mtx1.(x+1).(y) = 0 then
+ begin
+ mtx1.(x+1).(y) <- 1;
+ mtx2.(x+1).(y) <- v;
+ propa mtx1 mtx2 (x+1, y) v
+ end;
+ if mtx1.(x-1).(y) = 0 then
+ begin
+ mtx1.(x-1).(y) <- 1;
+ mtx1.(x-1).(y) <- v;
+ propa mtx1 mtx2 (x-1, y) v
+ end
+
+(*
+ Labellise irécursivement l'image en blocs.
+*)
+let get_lng_rec mtx w h =
+ let mtx2 = Array.make_matrix w h 0 and v = ref 1 in
+ for y = 1 to h-2 do
+ for x = 1 to w-2 do
+ if mtx.(x).(y) = 0 then
+ begin
+ mtx.(x).(y) <- 1;
+ mtx2.(x).(y) <- !v;
+ propa mtx mtx2 (x, y) !v;
+ v := !v+1
+ end
+ done
+ done;
+ (mtx2, !v-1)
+
+(*
+ Labellise itérativement une image en blocs.
+
+let get_lng_iter mtx w h =
+ let mtx2 = Array.make_matrix w h 0 and v = ref 1 and
+ a = ref (-1) and b = ref (-1) and hash = Hashtbl.create 500 in
+ for y = 1 to h-2 do
+ for x = 1 to w-2 do
+ if mtx.(x).(y) = 0 then
+ begin
+ a := mtx2.(x-1).(y); b := mtx2.(x).(y-1);
+ if !a = 0 && !b = 0 then
+ begin
+ mtx2.(x).(y) <- !v;
+ v := !v+1
+ end
+ else if !a <> 0 && !b <> 0 then
+ Hashtbl.add hash !a !b;
+ end
+ done
+ done;
+ for y = h-2 downto 1 do
+ for x = w-2 downto 1 do
+ if mtx2.(x).(y) <> -1 then
+ a := mtx2.(x+1).(y); b := mtx2.(x).(y+1);
+ if !a <> 0 || !b <> 0 then
+ begin
+ mtx2.(x).(y) <- min !a !b
+ end
+ done
+ done;
+ print_newline ();
+ print_int !v;
+ print_newline ();
+ (mtx2, !v-1)*)
+
+(*
+ Détermine la classe d'une forme en fonction des informations sur le bloc.
+*)
+let get_class bi =
+ let rm = (float)bi.no /. (float)bi.t in
+ if bi.h < 130 && rm < 7. && bi.no < (bi.ns / 2) then
+ 1
+ else
+ 2
+
+(*
+ Remplit le label des blocs des informations manquantes.
+*)
+let fill_bi mtx vec =
+ let lnth = (Array.length vec)-1 and bx = ref 0 and by = ref 0 and
+ ex = ref 0 and ey = ref 0 and no = ref 0 and prev = ref (-1) and t = ref 0 in
+ for i = 0 to lnth do
+ bx := fst vec.(i).b; by := snd vec.(i).b;
+ ex := fst vec.(i).e; ey := snd vec.(i).e;
+ vec.(i).w <- (!ex)-(!bx); vec.(i).h <- (!ey)-(!by);
+ for y = !by to !ey do
+ for x = !bx to !ex do
+ if mtx.(x).(y) = 0 then
+ begin
+ no := !no+1;
+ if !prev = 1 then
+ t := !t+1;
+ prev := 0
+ end
+ else
+ begin
+ if !prev = 0 then
+ t := !t+1;
+ prev := 1
+ end
+ done
+ done;
+ vec.(i).no <- !no;
+ vec.(i).t <- !t;
+ t := 0;
+ no := 0;
+ vec.(i).c <- get_class vec.(i)
done
+
+(*
+ Détermine la position des blocks ainsi que d'autres informations utiles.
+*)
+let get_blocks mtxi (mtxs, n) w h is_b =
+ if is_b then
+ print_string "Labelise blocks ..."
+ else
+ print_string "Labelise characters ...";
+ let vec = Array.make n {c=0;v=0;b=(0,0);e=(0,0);w=0;h=0;no=0;ns=0;t=0} and
+ v = ref 0 in
+ for y = 1 to h-2 do
+ for x = 1 to w-2 do
+ v := mtxs.(x).(y)-1;
+ if !v <> (-1) then
+ begin
+ if vec.(!v).v <> 0 then
+ begin
+ vec.(!v).b <- Tools.min vec.(!v).b (x, y);
+ vec.(!v).e <- Tools.max vec.(!v).e (x, y);
+ vec.(!v).ns <-(vec.(!v).ns)+1
+ end
+ else
+ vec.(!v) <- {c=0;v=(!v+1);b=(x,y);e=(x,y);w=0;h=0;no=0;ns=1;t=0}
+ end
+ done
+ done;
+ if is_b then
+ fill_bi mtxi vec;
+ print_string " done\n";
+ vec
+
+(*
+ Renvoi un vecteur de label contenance les informations
+ sur les formes d'une image.
+*)
+let labellise_blocks mtx w h =
+ let mtx2 = rlsa mtx w h 200 300 12 in
+ get_blocks mtx (get_lng_rec mtx2 w h) w h
+
+let labellise_char mtx w h =
+ let mtx2 = v_prj mtx w h 6 in
+ get_blocks mtx2 (get_lng_rec mtx2 w h) w h
+
+(*
+ Efface les images ou lignes inutilee.
+*)
+let clean mtx vec =
+ print_string "Image detection ...";
+ let bx = ref 0 and by = ref 0 and ex = ref 0 and ey = ref 0 and
+ lnth = (Array.length vec)-1 in
+ for i = 0 to lnth do
+ if vec.(i).c <> 1 then
+ begin
+ bx := fst vec.(i).b; by := snd vec.(i).b;
+ ex := fst vec.(i).e; ey := snd vec.(i).e;
+ for y = !by to !ey do
+ for x = !bx to !ex do
+ mtx.(x).(y) <- 255
+ done
+ done
+ end
+ done;
+ print_string " done\n";
+ mtx
+
+let copy mtx1 w h =
+ let mtx2 = Array.make_matrix w h 0 in
+ for y = 0 to h-1 do
+ for x = 0 to w-1 do
+ mtx2.(x).(y) <- mtx1.(x).(y)
+ done
+ done;
+ mtx2
+(*
+ Dessine des rectangles autours des lignes de textes.
+*)
+let draw_rec mtx vec w h =
+ print_string "Draw rectangles ...";
+ let mtx2 = copy mtx w h and b = ref (0, 0) and e = ref (0, 0) and
+ n = (Array.length vec)-1 in
+ for i = 0 to n do
+ b := vec.(i).b;
+ e := vec.(i).e;
+ for x = fst !b to fst !e do
+ mtx2.(x).(snd !b) <- 100;
+ mtx2.(x).(snd !e) <- 100
+ done;
+ for y = snd !b to snd !e do
+ mtx2.(fst !b).(y) <- 100;
+ mtx2.(fst !e).(y) <- 100
+ done
+ done;
+ print_string " done\n";
+ mtx2
+
+(*
+ Résultat de l'extraction des blocs.
+*)
+let result_blocs mtx w h =
+ let vec = labellise_blocks mtx w h true in
+ draw_rec (clean mtx vec) vec w h
+
+let result_blocs2 mtx_grey mtx_seg w h =
+ let vec = labellise_blocks mtx_seg w h true in
+ (draw_rec mtx_grey vec w h,vec)
+(*
+ Résultat de l'extraction des charactères.
+*)
+let result_char1 mtx w h =
+ let vec = labellise_blocks mtx w h true in
+ let vec2 = labellise_char (clean mtx vec) w h false in
+ draw_rec mtx vec2 w h
+
+let result_char2 mtx w h =
+ let vec = labellise_char mtx w h false in
+ draw_rec mtx vec w h

0 comments on commit 093191e

Please sign in to comment.