examples/apply/kmpalg.log

   1 BLOCK\r
   2 \r
   3   Const noir = 0 ,\r
   4         rouge = 1 ,\r
   5         vert = 2 ,\r
   6         jaune = 3 ,\r
   7         bleu = 4 ,\r
   8         magenta = 5 ,\r
   9         cyan = 6 ,\r
  10         blanc = 7 ;\r
  11 \r
  12 (* Fonction qui attend qu'un caract\8are soit tap\82 au clavier *)\r
  13 (* et le renvoie *)\r
  14    UNIT GetChar:function:char;\r
  15    var a:integer;\r
  16    begin\r
  17       pref IIUWGRAPH block\r
  18          begin\r
  19             a:=0;\r
  20             while a=0\r
  21                do\r
  22                   a:=inkey;\r
  23                od;\r
  24             result:=chr(a);\r
  25          end;\r
  26     End GetChar;\r
  27 \r
  28 (* Fonction qui saisit une chaine de caract\8ares et la place dans un tableau *)\r
  29 (* de caract\8ares *)\r
  30    UNIT SaisieString : function : arrayof char ;\r
  31    var a : char ,\r
  32        s , tmp : arrayof char ,\r
  33        i , long : integer ;\r
  34    Begin\r
  35       a:=getchar;\r
  36       array tmp dim (1:255);\r
  37       long:=1;\r
  38       while (ord(a)<>13)\r
  39       do\r
  40          write(a);\r
  41          tmp(long):=a;\r
  42          long:=long+1;\r
  43          a:=getchar;\r
  44       od;\r
  45       writeln;\r
  46       long:=long-1;\r
  47       array s dim (1:long);\r
  48       for i:=1 to long do s(i):=tmp(i); od ;\r
  49       result:=s;\r
  50    End saisiestring;\r
  51 \r
  52 (* Procedure permettant de choisir la couleur d'\82criture et de fond du texte *)\r
  53   UNIT Couleur : procedure ( texte,fond : integer);\r
  54   var t , f : char ;\r
  55   Begin\r
  56      t:=chr(48+texte);\r
  57      f:=chr(48+fond);\r
  58      Write ( chr(27) , "[1;3",t,";4",f,"m");\r
  59   End couleur;\r
  60 \r
  61 (* Procedure permettant d'effacer la ligne courante *)\r
  62   UNIT EraseLine : procedure;\r
  63   Begin\r
  64     Write( chr(27), "[K")\r
  65   End EraseLine;\r
  66 \r
  67 (* Procedure permettant d'effacer enti\8arement l'\82cran *)\r
  68   UNIT Cls : procedure;\r
  69   Begin\r
  70     Write( chr(27), "[2J");\r
  71     Write( chr(27), "[H");\r
  72   End Cls;\r
  73 \r
  74 (* Procedure permettant de positionner le curseur sur l'\82cran *)\r
  75   UNIT  SetCursor : procedure(column, row : integer);\r
  76     var c,d,e,f  : char,\r
  77         i,j : integer;\r
  78   Begin\r
  79     i := row div 10;\r
  80     j := row mod 10;\r
  81     c := chr(48+i);\r
  82     d := chr(48+j);\r
  83     i := column div 10;\r
  84     j := column mod 10;\r
  85     e := chr(48+i);\r
  86     f := chr(48+j);\r
  87     Write( chr(27), "[", c, d, ";", e, f, "H")\r
  88   End SetCursor;\r
  89 \r
  90 \r
  91 (* Procedure permettant de calculer a exposant b *)\r
  92 UNIT exposant : function (a,b:integer) : integer ;\r
  93    Begin\r
  94       result:=round(exp(b*ln(a)));\r
  95    End exposant;\r
  96 \r
  97 (* Procedure affichant le r\82sultat d'un essai de pattern matching *)\r
  98 UNIT afficheresultat : procedure (resultat : boolean);\r
  99 Begin\r
 100       call couleur(cyan,noir);\r
 101       call setcursor(18,18);\r
 102       if resultat then\r
 103          Writeln("Le pattern a ete trouve dans la chaine");\r
 104       else\r
 105          Writeln("Le pattern n'a pas ete trouve dans la chaine");\r
 106       fi;\r
 107       call couleur(blanc,noir);\r
 108       call setcursor(55,24);\r
 109       Write("Appuyez sur ENTREE");\r
 110       readln;\r
 111 End afficheresultat;\r
 112 \r
 113 (* Procedure mettant en place les differents textes sur l'\82cran *)\r
 114 UNIT afficheecran : procedure (p , s : arrayof char);\r
 115 var t : integer ;\r
 116    Begin\r
 117       call couleur(blanc,noir);\r
 118       call Cls;\r
 119       Write("Pattern : ");\r
 120       call couleur(jaune,noir);\r
 121       for t:=1 to upper(p)\r
 122       do\r
 123          Write(p(t));\r
 124       od ;\r
 125       writeln;\r
 126       call couleur(blanc,noir);\r
 127       Writeln;\r
 128       Writeln("Chaine ou on cherche le pattern :");\r
 129       call couleur(jaune,noir);\r
 130       for t:=1 to upper(s)\r
 131       do\r
 132          Write(s(t));\r
 133       od ;\r
 134    End afficheecran ;\r
 135 \r
 136 \r
 137 (**************************************************************************)\r
 138 (*                                                                        *)\r
 139 (*                       ALGORITHME SIMPLE                                *)\r
 140 (*                                                                        *)\r
 141 (**************************************************************************)\r
 142 UNIT AlgoSimple : procedure ( p , s : arrayof char) ;\r
 143 \r
 144 (* Procedure ecrivant diff\82rents textes sur l'\82cran *)\r
 145 \r
 146    UNIT ecran : procedure ;\r
 147    Begin\r
 148       call couleur(blanc,noir);\r
 149       call setcursor(1,10);\r
 150       Writeln("On compare la premiere lettre de : ");\r
 151       Writeln("      avec la premiere lettre de : ");\r
 152       Writeln;\r
 153       Writeln("Si elles sont egales, on reduit le pattern de 1 caractere");\r
 154    End ecran ;\r
 155 \r
 156 (* Procedure permettant d'afficher les diff\82rentes \82tapes de l'ex\82cution de *)\r
 157 (* l'algorithme *)\r
 158 \r
 159    UNIT AfficheChaine : procedure (p,s:arrayof char; posp,poss : integer);\r
 160    Var t , longs , longp , posx , longtest : integer ;\r
 161    var car : char\r
 162       Begin\r
 163          posx:=35;\r
 164          longp:=upper(p);\r
 165          longs:=upper(s);\r
 166          longtest:=longp-posp+1;\r
 167          call couleur(jaune,bleu);\r
 168          call setcursor(35,10);\r
 169          for t:=posp to longp\r
 170          do\r
 171             Write(p(t));\r
 172          od;\r
 173          call couleur(jaune,noir);\r
 174          Write(" ");\r
 175          for t:=1 to longs\r
 176          do\r
 177             if ( (t>=poss) and (t<poss+longtest) ) then\r
 178                call couleur(jaune,bleu);\r
 179                call setcursor(posx,11);\r
 180                Write(s(t));\r
 181                posx:=posx+1;\r
 182                call couleur(jaune,noir);\r
 183                Write(" ");\r
 184                call couleur(jaune,bleu);\r
 185             else\r
 186                call couleur(jaune,noir);\r
 187             fi;\r
 188             call setcursor(t,4);\r
 189             Write(s(t));\r
 190          od;\r
 191          car:=getchar;\r
 192    End AfficheChaine;\r
 193 \r
 194    Var i , j , m , n : integer ,\r
 195        resultat : boolean ;\r
 196 \r
 197 (* corps de l'algorithme simple *)\r
 198    Begin\r
 199    (* initialisations *)\r
 200       call afficheecran (p,s);\r
 201       call ecran ;\r
 202       m:=upper(p);\r
 203       n:=upper(s);\r
 204       i:=1;\r
 205       j:=1;\r
 206 \r
 207    (* boucle principale *)\r
 208       while ((i<=m) and (j<=n))\r
 209       do\r
 210          call AfficheChaine(p,s,i,j);\r
 211          if p(i)=s(j) then\r
 212             i:=i+1;\r
 213             j:=j+1;\r
 214          else\r
 215             i:=1;\r
 216             j:=j-i+2;\r
 217          fi;\r
 218          resultat:=(i>m);\r
 219       od;\r
 220       call afficheresultat(resultat) ;\r
 221 End AlgoSimple;\r
 222 \r
 223 \r
 224 \r
 225 (**************************************************************************)\r
 226 (*                                                                        *)\r
 227 (*                   ALGORITHME DE KNUTH, MORRIS et PRATT                 *)\r
 228 (*                                                                        *)\r
 229 (**************************************************************************)\r
 230 UNIT AlgoKMP : procedure(p , s : arrayof char) ;\r
 231 \r
 232 (* procedure permettant d'effectuer les affichages *)\r
 233 \r
 234    UNIT ecran : procedure (h:arrayof integer) ;\r
 235    var i : integer ;\r
 236    begin\r
 237       call couleur(blanc,noir);\r
 238       call setcursor(1,7);\r
 239       writeln("On compare le caractere en surbrillance du pattern avec celui de la chaine.");\r
 240       writeln("Quand on trouve un caractere non correspondant, on revient en arriere dans le");\r
 241       writeln("pattern d'un nombre n de positions.");\r
 242       writeln("n est donn\82 par la table suivante:");\r
 243       writeln("caractere num  :");\r
 244       writeln("hash code (=n) :");\r
 245       call couleur(jaune,noir);\r
 246       for i:=1 to upper(h)\r
 247       do\r
 248          call setcursor(13+i*4,11);\r
 249          write(i:4);\r
 250          call setcursor(13+i*4,12);\r
 251          write(h(i):4);\r
 252       od;\r
 253    end ecran ;\r
 254 \r
 255 (* procedure d'affichage du texte *)\r
 256 \r
 257    UNIT AfficheChaine : procedure (p,s:arrayof char; posp,poss : integer);\r
 258    Var t , longs , longp : integer ;\r
 259    Var car : char ;\r
 260       Begin\r
 261          longp:=upper(p);\r
 262          longs:=upper(s);\r
 263          call setcursor(11,1);\r
 264          for t:=1 to longp\r
 265          do\r
 266             if (t=posp) then\r
 267                call couleur(jaune,bleu);\r
 268             else\r
 269                call couleur(jaune,noir);\r
 270             fi;\r
 271             Write(p(t));\r
 272          od;\r
 273          call setcursor(1,4);\r
 274          for t:=1 to longs\r
 275          do\r
 276             if (t=poss) then\r
 277                call couleur(jaune,bleu);\r
 278             else\r
 279                call couleur(jaune,noir);\r
 280             fi;\r
 281             Write(s(t));\r
 282          od;\r
 283          car:=getchar;\r
 284    End AfficheChaine;\r
 285 \r
 286 (* Procedure de calcul de la hash function, stockee dans une table *)\r
 287 \r
 288   UNIT KMPhash : function(p : arrayof char) : arrayof integer;\r
 289   var i, j : integer,\r
 290       h : arrayof integer ,\r
 291       sortie: boolean ;\r
 292 \r
 293     Begin\r
 294     (* initialisations *)\r
 295        i := 1;\r
 296        j := 0;\r
 297        m := upper(p);\r
 298        array h dim (1:m);\r
 299        h(1) := 0;\r
 300 \r
 301     (* boucle principale *)\r
 302        while (i < m)\r
 303        do\r
 304           sortie:=false ;\r
 305           while (not sortie)\r
 306           do\r
 307             sortie:=true;\r
 308             if (j>0) then\r
 309                if (p(j) <> p(i)) then\r
 310                   sortie:=false ;\r
 311                   j:=h(j);\r
 312                fi ;\r
 313             fi ;\r
 314           od;\r
 315 \r
 316           i := i+1;\r
 317           j := j+1;\r
 318           if (p(i) = p(j)) then h(i) := h(j);\r
 319             else h(i) := j;\r
 320           fi;\r
 321        od;\r
 322        result:=h;\r
 323     End KMPhash;\r
 324 \r
 325 var i, j, m, n : integer,\r
 326     h : arrayof integer,\r
 327     sortie , resultat : boolean;\r
 328 \r
 329 (* Corps de l'algorithme KMP *******************)\r
 330 \r
 331 Begin\r
 332    call afficheecran(p,s);\r
 333 \r
 334    (* initialisations *)\r
 335    m := upper(p);\r
 336    n := upper(s);\r
 337    array h dim(1:m);\r
 338    h := KMPhash(p);\r
 339    call ecran(h);\r
 340    i := 1;\r
 341    j := 1;\r
 342 \r
 343    (* boucle principale *)\r
 344    while ((i <= m) and (j <= n))\r
 345    do\r
 346        sortie:=false;\r
 347        while (not sortie)\r
 348        do\r
 349          sortie:=true;\r
 350          if (i>0) then\r
 351             if (p(i) <> s(j)) then\r
 352                sortie:=false ;\r
 353                i:=h(i);\r
 354                call setcursor(1,14);\r
 355                call couleur(blanc,noir);\r
 356                write("On se deplace a la position : ",i);\r
 357             fi ;\r
 358          if (i>0) then\r
 359             call affichechaine(p,s,i,j);\r
 360          else\r
 361             call setcursor(1,14);\r
 362             call couleur(blanc,noir);\r
 363             call eraseline;\r
 364             call affichechaine(p,s,i+1,j);\r
 365          fi;\r
 366          fi;\r
 367        od;\r
 368       i := i+1;\r
 369       j := j+1;\r
 370     od;\r
 371     resultat := (i > m);\r
 372     call afficheresultat(resultat);\r
 373  End AlgoKMP;\r
 374 \r
 375 (**************************************************************************)\r
 376 (*                                                                        *)\r
 377 (*                      ALGORITHME DE KARP et RABIN                       *)\r
 378 (*                                                                        *)\r
 379 (**************************************************************************)\r
 380 UNIT AlgoKarpRabin : procedure (p , s : arrayof char);\r
 381 \r
 382 (* Affichage de l'ecran et des commentaires *)\r
 383 \r
 384    UNIT Ecran : Procedure (hash : integer);\r
 385      begin\r
 386         call couleur(blanc,noir);\r
 387         call setcursor(1,8);\r
 388         write("Hash code du pattern           :");\r
 389         call couleur(jaune,noir);\r
 390         writeln(hash);\r
 391         call couleur(blanc,noir);\r
 392         writeln("Hash code du texte selectionne :");\r
 393    end ecran ;\r
 394 \r
 395 (* procedure d'affichage du texte *)\r
 396 \r
 397    UNIT AfficheChaine : procedure (s:arrayof char ; poss ,longp,hash:integer);\r
 398    Var t , longs : integer ;\r
 399    Var car : char ;\r
 400       Begin\r
 401          longs:=upper(s);\r
 402          call couleur(jaune,noir);\r
 403          call setcursor(33,9);\r
 404          write(hash);\r
 405          call setcursor(1,4);\r
 406          for t:=1 to longs\r
 407          do\r
 408             if ( (t>=poss) and (t<poss+longp) ) then\r
 409                call couleur(jaune,bleu);\r
 410             else\r
 411                call couleur(jaune,noir);\r
 412             fi;\r
 413             Write(s(t));\r
 414          od;\r
 415          car:=getchar;\r
 416    End AfficheChaine;\r
 417 \r
 418 (* Procedure de calcul de la premiere valeur de la hash function *)\r
 419 \r
 420     UNIT hashfunction : function( str : arrayof char, m : integer ):integer;\r
 421       var a : integer;\r
 422       Begin\r
 423          result := 0;\r
 424          for a := 1 to m do\r
 425                 result := result + ord(str(a)) ;\r
 426          od;\r
 427       End hashfunction;\r
 428 \r
 429 (* Procedure de calcul des valeurs suivantes de la hash function *)\r
 430 \r
 431       UNIT newhash : function( oldh , m ,j:integer, str : arrayof char ): integer;\r
 432          Begin\r
 433             result:=oldh + ord(str(j+m)) - ord(str(j)) ;\r
 434          End newhash;\r
 435 \r
 436 var j, m, n, a , d : integer,\r
 437     hpat, hstr : integer ,\r
 438     trouve : boolean;\r
 439 \r
 440 (* Corps de l'algorithme KR ************************)\r
 441 \r
 442    Begin\r
 443 \r
 444     (* initialisations *)\r
 445       call afficheecran(p,s);\r
 446       j := 1;\r
 447       trouve := false;\r
 448       m := upper(p);\r
 449       n := upper(s);\r
 450       hpat := hashfunction(p,m);\r
 451       hstr := hashfunction(s,m);\r
 452       call ecran(hpat);\r
 453       j:=1;\r
 454 \r
 455       (* boucle principale *)\r
 456       do\r
 457          if ( hpat = hstr ) then\r
 458               call couleur(blanc,noir);\r
 459               call setcursor(1,12);\r
 460               write("Les deux hashcodes correspondent, on compare le pattern et la selection");\r
 461               a := 1;\r
 462               trouve :=  true;\r
 463               while ((trouve) and (a <= m))\r
 464               do\r
 465                  if ( p(a) = s(j+a-1) ) then\r
 466                     a := a+1\r
 467                  else\r
 468                     trouve := false;\r
 469                  fi\r
 470               od;\r
 471            else\r
 472               call couleur(blanc,noir);\r
 473               call setcursor(1,12);\r
 474               call eraseline;\r
 475            fi;\r
 476            call affichechaine(s,j,m,hstr);\r
 477            if ( (j>= (n-m+1)) or ( trouve) ) then exit fi;\r
 478            hstr := newhash(hstr , m , j , s);\r
 479            j:=j+1;\r
 480 \r
 481       od;\r
 482       call afficheresultat(trouve);\r
 483    End AlgoKarpRabin;\r
 484 \r
 485 (**************************************************************************)\r
 486 (*                                                                        *)\r
 487 (*         ALGORITHME DE BOYER et MOORE (modifi\82 HORSPOOL)                *)\r
 488 (*                                                                        *)\r
 489 (**************************************************************************)\r
 490 UNIT AlgoBoyerMoore : procedure ( p , s : arrayof char);\r
 491 \r
 492 (* procedure d'affichage du texte *)\r
 493 \r
 494    UNIT AfficheChaine : procedure (s:arrayof char; poss : integer);\r
 495    Var t , longs : integer ;\r
 496    Var car : char ;\r
 497       Begin\r
 498          longs:=upper(s);\r
 499          call setcursor(1,4);\r
 500          for t:=1 to longs\r
 501          do\r
 502             if (t=poss) then\r
 503                call couleur(jaune,bleu);\r
 504             else\r
 505                call couleur(jaune,noir);\r
 506             fi;\r
 507             Write(s(t));\r
 508          od;\r
 509          car:=getchar;\r
 510    End AfficheChaine;\r
 511 \r
 512 (* Procedure de remplissage de la table Delta *)\r
 513 \r
 514 UNIT Delta : function (p : arrayof char) : arrayof integer ;\r
 515 \r
 516 Var d : arrayof integer,\r
 517     a : integer;\r
 518 \r
 519 Begin\r
 520    array d dim(1:127);\r
 521    m:=upper(p);\r
 522    (* initialisation *)\r
 523    for a:=1 to 127 do\r
 524      d(a):=m;\r
 525    od;\r
 526    (* calcul pour le pattern *)\r
 527    for a:=1 to m-1 do\r
 528      d(ord(p(a))):=m-a;\r
 529    od;\r
 530    result:=d;\r
 531 End Delta;\r
 532 \r
 533 var j, m, n, a : integer,\r
 534     trouve : boolean,\r
 535     d : arrayof integer;\r
 536 \r
 537 \r
 538 (* Corps de l'algorithme BM ************************)\r
 539 \r
 540 Begin\r
 541   (* initialisations *)\r
 542    call afficheecran(p,s);\r
 543    m:=upper(p);\r
 544    n:=upper(s);\r
 545    d:=Delta(p);\r
 546    j:=m;\r
 547    trouve:=false;\r
 548 \r
 549    (* boucle principale *)\r
 550    while ( (j<=n) and (not trouve) )\r
 551    do\r
 552       call affichechaine(s,j);\r
 553       if (s(j) = p(m)) then\r
 554          trouve:=true;\r
 555          for a:=1 to m\r
 556          do\r
 557             if (p(a)<>s(j-m+a)) then\r
 558                trouve:=false;\r
 559             fi;\r
 560          od;\r
 561       fi;\r
 562          call couleur(blanc,noir);\r
 563          call setcursor(1,8);\r
 564       if (not trouve) then\r
 565          writeln("La derniere lettre du pattern ne correspond pas avec la lettre de la chaine");\r
 566          writeln("en surbrillance, alors on se deplace de ",d(ord(s(j))):2," positions");\r
 567       else\r
 568          call eraseline;\r
 569          writeln;\r
 570          call eraseline;\r
 571       fi;\r
 572       j:=j+d(ord(s(j)));\r
 573    od;\r
 574    call afficheresultat(trouve);\r
 575 \r
 576 End AlgoBoyerMoore ;\r
 577 \r
 578 \r
 579 (* Procedure affichant le premier ecran et saisissant les choix *)\r
 580 \r
 581 UNIT EcranPrincipal : procedure ;\r
 582 var choix : integer ,\r
 583     p , s : arrayof char ;\r
 584    Begin\r
 585    choix:=0;\r
 586    while (choix<>5)\r
 587    do\r
 588       call couleur(blanc,noir);\r
 589       call cls;\r
 590       call setcursor(27,1);\r
 591       Write("Programme Pattern Matcher");\r
 592       call setcursor(27,2);\r
 593       Write("-------------------------");\r
 594       call setcursor(1,22);\r
 595       writeln("Tous les algorithmes s'executent en pas a pas, il faut appuyer sur une touche");\r
 596       write("pour faire s'executer le pas suivant...");\r
 597 \r
 598       call setcursor(1,6);\r
 599       writeln("   1) Algorithme simple");\r
 600       writeln("   2) Algorithme de Karp et Rabin");\r
 601       writeln("   3) Algorithme de Knuth, Morris et Pratt");\r
 602       writeln("   4) Algorithme de Boyer et Moore");\r
 603       writeln("   5) Quitter le programme");\r
 604       writeln;\r
 605       write("Votre choix : ");\r
 606       readln(choix);\r
 607       if (choix < 5) then\r
 608          writeln;\r
 609          writeln("Saisie de la chaine ou on recherche le pattern :");\r
 610          call couleur(jaune,noir);\r
 611          s:=saisiestring;\r
 612          call couleur(blanc,noir);\r
 613          writeln("Saisie du pattern a rechercher :");\r
 614          call couleur(jaune,noir);\r
 615          p:=saisiestring;\r
 616          call couleur(blanc,noir);\r
 617          case choix\r
 618          when 1 : call algoSimple(p,s);\r
 619          when 2 : call algoKarpRabin(p,s);\r
 620          when 3 : call algoKMP(p,s);\r
 621          when 4 : call algoBoyerMoore(p,s);\r
 622          esac ;\r
 623       fi;\r
 624    od;\r
 625    End EcranPrincipal;\r
 626 \r
 627 \r
 628 (***************************************************************************)\r
 629 (*                        PROGRAMME PRINCIPAL                              *)\r
 630 (***************************************************************************)\r
 631 \r
 632 \r
 633 Begin\r
 634    call ecranprincipal;\r
 635 End;\1a