2 (* auteurs V.Borry et V.Iriart *)
\r
3 (* Licence GR2. 1993/94 *)
\r
14 (* Fonction qui attend qu'un caract
\8are soit tap
\82 au clavier *)
\r
16 UNIT GetChar:function:char;
\r
19 pref IIUWGRAPH block
\r
30 (* Fonction qui saisit une chaine de caract
\8ares et la place dans un tableau *)
\r
31 (* de caract
\8ares *)
\r
32 UNIT SaisieString : function : arrayof char ;
\r
34 s , tmp : arrayof char ,
\r
35 i , long : integer ;
\r
38 array tmp dim (1:255);
\r
49 array s dim (1:long);
\r
50 for i:=1 to long do s(i):=tmp(i); od ;
\r
54 (* Procedure permettant de choisir la couleur d'
\82criture et de fond du texte *)
\r
55 UNIT Couleur : procedure ( texte,fond : integer);
\r
60 Write ( chr(27) , "[1;3",t,";4",f,"m");
\r
63 (* Procedure permettant d'effacer la ligne courante *)
\r
64 UNIT EraseLine : procedure;
\r
66 Write( chr(27), "[K")
\r
69 (* Procedure permettant d'effacer enti
\8arement l'
\82cran *)
\r
70 UNIT Cls : procedure;
\r
72 Write( chr(27), "[2J");
\r
73 Write( chr(27), "[H");
\r
76 (* Procedure permettant de positionner le curseur sur l'
\82cran *)
\r
77 UNIT SetCursor : procedure(column, row : integer);
\r
89 Write( chr(27), "[", c, d, ";", e, f, "H")
\r
93 (* Procedure permettant de calculer a exposant b *)
\r
94 UNIT exposant : function (a,b:integer) : integer ;
\r
96 result:=round(exp(b*ln(a)));
\r
99 (* Procedure affichant le r
\82sultat d'un essai de pattern matching *)
\r
100 UNIT afficheresultat : procedure (resultat : boolean);
\r
102 call couleur(cyan,noir);
\r
103 call setcursor(18,18);
\r
105 Writeln("Le pattern a ete trouve dans la chaine");
\r
107 Writeln("Le pattern n'a pas ete trouve dans la chaine");
\r
109 call couleur(blanc,noir);
\r
110 call setcursor(55,24);
\r
111 Write("Appuyez sur ENTREE");
\r
113 End afficheresultat;
\r
115 (* Procedure mettant en place les differents textes sur l'
\82cran *)
\r
116 UNIT afficheecran : procedure (p , s : arrayof char);
\r
119 call couleur(blanc,noir);
\r
121 Write("Pattern : ");
\r
122 call couleur(jaune,noir);
\r
123 for t:=1 to upper(p)
\r
128 call couleur(blanc,noir);
\r
130 Writeln("Chaine ou on cherche le pattern :");
\r
131 call couleur(jaune,noir);
\r
132 for t:=1 to upper(s)
\r
139 (**************************************************************************)
\r
141 (* ALGORITHME SIMPLE *)
\r
143 (**************************************************************************)
\r
144 UNIT AlgoSimple : procedure ( p , s : arrayof char) ;
\r
146 (* Procedure ecrivant diff
\82rents textes sur l'
\82cran *)
\r
148 UNIT ecran : procedure ;
\r
150 call couleur(blanc,noir);
\r
151 call setcursor(1,10);
\r
152 Writeln("On compare la premiere lettre de : ");
\r
153 Writeln(" avec la premiere lettre de : ");
\r
155 Writeln("Si elles sont egales, on reduit le pattern de 1 caractere");
\r
158 (* Procedure permettant d'afficher les diff
\82rentes
\82tapes de l'ex
\82cution de *)
\r
161 UNIT AfficheChaine : procedure (p,s:arrayof char; posp,poss : integer);
\r
162 Var t , longs , longp , posx , longtest : integer ;
\r
168 longtest:=longp-posp+1;
\r
169 call couleur(jaune,bleu);
\r
170 call setcursor(35,10);
\r
171 for t:=posp to longp
\r
175 call couleur(jaune,noir);
\r
179 if ( (t>=poss) and (t<poss+longtest) ) then
\r
180 call couleur(jaune,bleu);
\r
181 call setcursor(posx,11);
\r
184 call couleur(jaune,noir);
\r
186 call couleur(jaune,bleu);
\r
188 call couleur(jaune,noir);
\r
190 call setcursor(t,4);
\r
196 Var i , j , m , n : integer ,
\r
197 resultat : boolean ;
\r
199 (* corps de l'algorithme simple *)
\r
201 (* initialisations *)
\r
202 call afficheecran (p,s);
\r
209 (* boucle principale *)
\r
210 while ((i<=m) and (j<=n))
\r
212 call AfficheChaine(p,s,i,j);
\r
222 call afficheresultat(resultat) ;
\r
227 (**************************************************************************)
\r
229 (* ALGORITHME DE KNUTH, MORRIS et PRATT *)
\r
231 (**************************************************************************)
\r
232 UNIT AlgoKMP : procedure(p , s : arrayof char) ;
\r
234 (* procedure permettant d'effectuer les affichages *)
\r
236 UNIT ecran : procedure (h:arrayof integer) ;
\r
239 call couleur(blanc,noir);
\r
240 call setcursor(1,7);
\r
241 writeln("On compare le caractere en surbrillance du pattern avec celui de la chaine.");
\r
242 writeln("Quand on trouve un caractere non correspondant, on revient en arriere dans le");
\r
243 writeln("pattern d'un nombre n de positions.");
\r
244 writeln("n est donn
\82 par la table suivante:");
\r
245 writeln("caractere num :");
\r
246 writeln("hash code (=n) :");
\r
247 call couleur(jaune,noir);
\r
248 for i:=1 to upper(h)
\r
250 call setcursor(13+i*4,11);
\r
252 call setcursor(13+i*4,12);
\r
257 (* procedure d'affichage du texte *)
\r
259 UNIT AfficheChaine : procedure (p,s:arrayof char; posp,poss : integer);
\r
260 Var t , longs , longp : integer ;
\r
265 call setcursor(11,1);
\r
269 call couleur(jaune,bleu);
\r
271 call couleur(jaune,noir);
\r
275 call setcursor(1,4);
\r
279 call couleur(jaune,bleu);
\r
281 call couleur(jaune,noir);
\r
288 (* Procedure de calcul de la hash function, stockee dans une table *)
\r
290 UNIT KMPhash : function(p : arrayof char) : arrayof integer;
\r
291 var i, j : integer,
\r
292 h : arrayof integer ,
\r
296 (* initialisations *)
\r
303 (* boucle principale *)
\r
311 if (p(j) <> p(i)) then
\r
320 if (p(i) = p(j)) then h(i) := h(j);
\r
327 var i, j, m, n : integer,
\r
328 h : arrayof integer,
\r
329 sortie , resultat : boolean;
\r
331 (* Corps de l'algorithme KMP *******************)
\r
334 call afficheecran(p,s);
\r
336 (* initialisations *)
\r
345 (* boucle principale *)
\r
346 while ((i <= m) and (j <= n))
\r
353 if (p(i) <> s(j)) then
\r
356 call setcursor(1,14);
\r
357 call couleur(blanc,noir);
\r
358 write("On se deplace a la position : ",i);
\r
361 call affichechaine(p,s,i,j);
\r
363 call setcursor(1,14);
\r
364 call couleur(blanc,noir);
\r
366 call affichechaine(p,s,i+1,j);
\r
373 resultat := (i > m);
\r
374 call afficheresultat(resultat);
\r
377 (**************************************************************************)
\r
379 (* ALGORITHME DE KARP et RABIN *)
\r
381 (**************************************************************************)
\r
382 UNIT AlgoKarpRabin : procedure (p , s : arrayof char);
\r
384 (* Affichage de l'ecran et des commentaires *)
\r
386 UNIT Ecran : Procedure (hash : integer);
\r
388 call couleur(blanc,noir);
\r
389 call setcursor(1,8);
\r
390 write("Hash code du pattern :");
\r
391 call couleur(jaune,noir);
\r
393 call couleur(blanc,noir);
\r
394 writeln("Hash code du texte selectionne :");
\r
397 (* procedure d'affichage du texte *)
\r
399 UNIT AfficheChaine : procedure (s:arrayof char ; poss ,longp,hash:integer);
\r
400 Var t , longs : integer ;
\r
404 call couleur(jaune,noir);
\r
405 call setcursor(33,9);
\r
407 call setcursor(1,4);
\r
410 if ( (t>=poss) and (t<poss+longp) ) then
\r
411 call couleur(jaune,bleu);
\r
413 call couleur(jaune,noir);
\r
420 (* Procedure de calcul de la premiere valeur de la hash function *)
\r
422 UNIT hashfunction : function( str : arrayof char, m : integer ):integer;
\r
427 result := result + ord(str(a)) ;
\r
431 (* Procedure de calcul des valeurs suivantes de la hash function *)
\r
433 UNIT newhash : function( oldh , m ,j:integer, str : arrayof char ): integer;
\r
435 result:=oldh + ord(str(j+m)) - ord(str(j)) ;
\r
438 var j, m, n, a , d : integer,
\r
439 hpat, hstr : integer ,
\r
442 (* Corps de l'algorithme KR ************************)
\r
446 (* initialisations *)
\r
447 call afficheecran(p,s);
\r
452 hpat := hashfunction(p,m);
\r
453 hstr := hashfunction(s,m);
\r
457 (* boucle principale *)
\r
459 if ( hpat = hstr ) then
\r
460 call couleur(blanc,noir);
\r
461 call setcursor(1,12);
\r
462 write("Les deux hashcodes correspondent, on compare le pattern et la selection");
\r
465 while ((trouve) and (a <= m))
\r
467 if ( p(a) = s(j+a-1) ) then
\r
474 call couleur(blanc,noir);
\r
475 call setcursor(1,12);
\r
478 call affichechaine(s,j,m,hstr);
\r
479 if ( (j>= (n-m+1)) or ( trouve) ) then exit fi;
\r
480 hstr := newhash(hstr , m , j , s);
\r
484 call afficheresultat(trouve);
\r
487 (**************************************************************************)
\r
489 (* ALGORITHME DE BOYER et MOORE (modifi
\82 HORSPOOL) *)
\r
491 (**************************************************************************)
\r
492 UNIT AlgoBoyerMoore : procedure ( p , s : arrayof char);
\r
494 (* procedure d'affichage du texte *)
\r
496 UNIT AfficheChaine : procedure (s:arrayof char; poss : integer);
\r
497 Var t , longs : integer ;
\r
501 call setcursor(1,4);
\r
505 call couleur(jaune,bleu);
\r
507 call couleur(jaune,noir);
\r
514 (* Procedure de remplissage de la table Delta *)
\r
516 UNIT Delta : function (p : arrayof char) : arrayof integer ;
\r
518 Var d : arrayof integer,
\r
522 array d dim(1:127);
\r
524 (* initialisation *)
\r
528 (* calcul pour le pattern *)
\r
535 var j, m, n, a : integer,
\r
537 d : arrayof integer;
\r
540 (* Corps de l'algorithme BM ************************)
\r
543 (* initialisations *)
\r
544 call afficheecran(p,s);
\r
551 (* boucle principale *)
\r
552 while ( (j<=n) and (not trouve) )
\r
554 call affichechaine(s,j);
\r
555 if (s(j) = p(m)) then
\r
559 if (p(a)<>s(j-m+a)) then
\r
564 call couleur(blanc,noir);
\r
565 call setcursor(1,8);
\r
566 if (not trouve) then
\r
567 writeln("La derniere lettre du pattern ne correspond pas avec la lettre de la chaine");
\r
568 writeln("en surbrillance, alors on se deplace de ",d(ord(s(j))):2," positions");
\r
576 call afficheresultat(trouve);
\r
578 End AlgoBoyerMoore ;
\r
581 (* Procedure affichant le premier ecran et saisissant les choix *)
\r
583 UNIT EcranPrincipal : procedure ;
\r
584 var choix : integer ,
\r
585 p , s : arrayof char ;
\r
590 call couleur(blanc,noir);
\r
592 call setcursor(27,1);
\r
593 Write("Programme Pattern Matcher");
\r
594 call setcursor(27,2);
\r
595 Write("-------------------------");
\r
596 call setcursor(1,22);
\r
597 writeln("Tous les algorithmes s'executent en pas a pas, il faut appuyer sur une touche");
\r
598 write("pour faire s'executer le pas suivant...");
\r
600 call setcursor(1,6);
\r
601 writeln(" 1) Algorithme simple");
\r
602 writeln(" 2) Algorithme de Karp et Rabin");
\r
603 writeln(" 3) Algorithme de Knuth, Morris et Pratt");
\r
604 writeln(" 4) Algorithme de Boyer et Moore");
\r
605 writeln(" 5) Quitter le programme");
\r
607 write("Votre choix : ");
\r
609 if (choix < 5) then
\r
611 writeln("Saisie de la chaine ou on recherche le pattern :");
\r
612 call couleur(jaune,noir);
\r
614 call couleur(blanc,noir);
\r
615 writeln("Saisie du pattern a rechercher :");
\r
616 call couleur(jaune,noir);
\r
618 call couleur(blanc,noir);
\r
620 when 1 : call algoSimple(p,s);
\r
621 when 2 : call algoKarpRabin(p,s);
\r
622 when 3 : call algoKMP(p,s);
\r
623 when 4 : call algoBoyerMoore(p,s);
\r
627 End EcranPrincipal;
\r
630 (***************************************************************************)
\r
631 (* PROGRAMME PRINCIPAL *)
\r
632 (***************************************************************************)
\r
636 call ecranprincipal;
\r