© 1996 JMy

Exercices sur la répétitive.

(1) Compactez une chaîne de caractères en utilisant la méthode RLE
    (Run Length Encoding).
    Ex: AAAZEEEEA sera codé: A3Z1E4A1
                 A (le caractère) 3 (le nombre de répétition)
                 Z (le caractère) 1 (le nombre de répétition)
                 E (le caractère) 4 (le nombre de répétition)
                 A (le caractère) 1 (le nombre de répétition)
    Appliquez cette technique pour sauver/compacter un écran en mode texte.
    Note: MEMW[$B800:Pos] est un WORD contenant le caractère en position Pos
          et son attribut (couleur). Pour un écran 25 lignes de 80 caractères,
          Pos varie de 0 à 25*80-1=4000-1=3999.


tableau Eli, Nbri i=1, ..., 4000 de entier
entier N


Fonction T(i)
  paramètre i: entier
  à valeur entier


entier Tmp


Tmp <-- MEMW[$B800:i*2]
résultat(Tmp)


Procédure Code_Ecran
entier Pos, Cpt


N <-- 0
Cpt <-- 1
pour Pos de 1 à 2000 faire
si T(Pos)=T(Pos-1) alors Cpt <-- Cpt+1
sinon N <-- N+1
      ElN <-- T(Pos-1)
      NbrN <-- Cpt
      Cpt <-- 1
fsi
fpour
N <-- N+1
ElN <-- T(Pos-1)
NbrN <-- Cpt
fproc


Procédure Ecran
entier Lig,Col


pour Lig de 0 à 24 faire
  pour Col de 0 à 79 faire
    MEMW[$B800:(Lig*80+Col)*2] <-- 216+256*(13+RANDOM(2))
  fpour
fpour
fproc


Procédure DeCode_Ecran
entier i, j, Pos


Pos <-- 1
pour i de 1 à N faire
  pour j de 1 à Nbri faire
    MEMW[$B800:(Pos-1)*2] <-- Eli
    Pos <-- Pos+1
  fpour
fpour
fproc


Ecran
Code_Ecran
écrire "L'écran de 25*80*2 bytes = ",25*80*2, "bytes occupe en mémoire ",N*2, " bytes."
DeCode_Ecran


PROGRAM RLE;

USES CRT;

VAR El,Nbr : ARRAY[1..4000] OF WORD;
    N      : WORD;

FUNCTION T(i:WORD):WORD;
BEGIN
T:=MEMW[$B800:i*2]
END;

PROCEDURE Code_Ecran(VAR N:WORD);
VAR Pos,Cpt : WORD;
BEGIN
N:=0;Cpt:=1;
FOR Pos:=1 TO 2000 DO
  BEGIN
  IF T(Pos)=T(Pos-1) THEN INC(Cpt)
  ELSE BEGIN
       INC(N);
       El[N]:=T(Pos-1);
       Nbr[N]:=Cpt;
       Cpt:=1;
       END;
  END;
INC(N);
El[N]:=T(Pos-1);
Nbr[N]:=Cpt;
END;

PROCEDURE Ecran;
VAR Lig,Col:WORD;
BEGIN
RANDOMIZE;
FOR Lig:=0 TO 24 DO
  FOR Col:=0 TO 79 DO
    MEMW[$B800:(Lig*80+Col)*2]:=216+256*(13+RANDOM(2));
END;

PROCEDURE DeCode_Ecran(N:WORD);
VAR i,j,Pos:WORD;
BEGIN
Pos:=1;
FOR i:=1 TO N DO
  FOR j:=1 TO Nbr[i] DO
    BEGIN
    MEMW[$B800:(Pos-1)*2]:=El[i];
    INC(Pos);
    END;
END;

BEGIN
Ecran;
Code_Ecran(N);
READKEY;
CLRSCR;
WRITELN(' L''écran de 25*80*2 bytes = ',25*80*2,' bytes occupe en mémoire ',N SHL 1,' bytes');
READKEY;
DeCode_Ecran(N);
READKEY;
END.

(2) Traduisez en Pascal l'algorithme suivant qui détermine les carrés magiques d'ordre multiple de 4



Type Matrice : tableaui,j i, j =1, ..., 100 d'entier


entier: N, i, j
Matrice: Carre


Procedure Magique4 (Mat: Matrice, N: entier) ! Mat est modifié !
entier: r


  Procedure Marquer (i, j :entier)
  entier: lig, col


  pour lig de 3 à 0 par -1 faire
    pour col de 3 à 0 par -1 faire
       si (lig = col) ou (lig + col = 3) alors mati+lig,j+col <-- 1
       sinon mati+lig,j+col <-- 0
       fsi
    fpour
  fpour
  fproc


pour i de 1 à N faire
  pour j de 1 à N faire
    Marquer (1+(i-1)*4, 1+(j-1)*4)
  fpour
fpour
r <-- 0
pour i de 1 à N faire
  pour j de 1 à N faire
    r <-- r + 1
    si mati,j = 0 alors mati,j <-- r
    sinon mati,j <-- n*n +1 - r
    fsi
  fpour
fpour
fproc


répéter
  N <-- 1
  tant que NOT (N mod 4=0) faire
    écrire ("Introduisez le nombre de lignes (multiple de 4) et 0 pour quitter: ")
    lire N
  ftant
  si N<>0 alors Magique4 (Carre,N)
                pour i de 1 à N faire
                  pour j de 1 à N faire
                    écrire Carrei,j
                  fpour
                fpour
  fsi
jusqu'à N=0





PROGRAM Carre_Magique;

TYPE Matrice=ARRAY[1..100,1..100] OF WORD;

VAR N,i,j:WORD;
    Carre:Matrice;

PROCEDURE Magique4(VAR Mat:Matrice; N:WORD);
VAR r:WORD;

  PROCEDURE Marquer (i,j:WORD);
  VAR lig, col:BYTE;

  BEGIN
  FOR lig:=3 DOWNTO 0 DO
    FOR col:=3 DOWNTO 0 DO
      IF (lig = col) OR (lig + col = 3) THEN mat[i+lig,j+col]:=1
      ELSE mat[i+lig,j+col]:=0
  END;

BEGIN
FOR i:=1 TO N DO
  FOR j:=1 TO N DO
    Marquer (1+(i-1)*4, 1+(j-1)*4);
r:=0;
FOR i:=1 TO N DO
  FOR j:=1 TO N DO
    BEGIN
    r:=r + 1;
    IF mat[i,j] = 0 THEN mat[i,j]:=r
    ELSE mat[i,j]:=n*n +1 - r
    END
END;

BEGIN
REPEAT
  N:=1;
  WHILE NOT (N MOD 4 = 0) DO
    BEGIN
    WRITE('Introduisez le nombre de lignes (multiple de 4) et 0 pour quitter: ');
    READLN(N);
    END;
  IF N<>0 THEN BEGIN
               Magique4 (Carre,N);
               FOR i:=1 TO N DO
                 BEGIN
                 FOR j:=1 TO N DO
                    WRITE(Carre[i,j]:4);
                 WRITELN
                 END
               END;
UNTIL N=0
END.




(3) R‚digez en LDA un algorithme qui demande un nombre entier, la base dans
laquelle il exprimé, la base dans laquelle il faut l'exprimer et qui
fasse la conversion.


chaîne: Chiffres, N
entier: Base, NBase
Fonction Verifie(St,Base)
        paramètre: St: chaîne
        Base : entier
        à valeur: booléen

booléen: Verif
entier: i, Cpt
Cpt <-- 0
pour i de 1 à St faire
  si Pos(Sti, Chiffres) > Base alors Cpt <-- Cpt+1
  fsi
fpour
si Cpt>0 alors Verif <-- faux
sinon Verif <-- vrai
fsi
Résultat (Verif)

Fonction Majuscules(St)
        paramètre: St: chaîne
        à valeur: chaîne

entier: i
pour i de 1 à St faire
  si (Sti >= "a") et(Sti >= "z") alors Sti <-- UpCase(Sti)
  fsi
fpour
Résultat (St)

Fonction Base10(St, Base)
        paramètre: St: chaîne
        Base: entier
        à valeur: entier

entier: i, B10
B10 <-- 0
pour i de 1 à St faire
  B10 <-- B10 * Base + Pos(Sti,Chiffres) - 1
fpour
Résultat(B10)

Fonction NewBase(N, Base)
        paramètre: N, Base: entier
        à valeur: chaîne

entier i
chaîne: B
B <-- ""
tant que NOT (N = 0) faire
  i <-- N mod Base
  B <-- Chiffresi+1 // B
  N <-- N \ Base
ftant
Résultat(B)


Chiffres <-- "0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ"
écrire "Introduisez le nombre (0 pour arrêter):"
lire N
tant que NOT ((N="0") ou (N="")) faire
  N <-- Majuscules(N)
  écrire "Dans quelle base est-il exprimé:"
  lire Base
  si NOT Verifie(N,Base) alors écrire "Le nombre n'est pas correct!"
  sinon écrire "Dans quelle base faut-il l'exprimer: "
        lire NBase
        écrire N," en base ",Base, " = ", NewBase(Base10(N,Base),NBase), " en base ",NBase
  fsi
  écrire "Introduisez le nombre (0 pour arrêter):"
  lire N
ftant





PROGRAM Chgt_Base;

VAR Chiffres, N: STRING;
    Base, NBase: BYTE;

FUNCTION Verifie(St:STRING;Base:BYTE):BOOLEAN;
VAR Verif:BOOLEAN;
    i, Cpt: BYTE;
BEGIN
Cpt:=0;
FOR i:=1 TO LENGTH(St) DO
  IF POS(St[i], Chiffres)>Base THEN Cpt:=Cpt+1;
IF Cpt>0 THEN Verif:=FALSE
ELSE Verif:=TRUE;
Verifie:=Verif;
END;

FUNCTION Majuscules(St:STRING):STRING;
VAR i:BYTE;
BEGIN
FOR i:=1 TO LENGTH(St) DO
  IF(St[i]>='a') AND (St[i]<='z') THEN St[i]:=UpCase(St[i]);
Majuscules:=St;
END;

FUNCTION Base10(St:STRING;Base:BYTE):LONGINT;
VAR i:BYTE;
    B10:LONGINT;
BEGIN
B10:=0;
FOR i:=1 TO LENGTH(St) DO
  B10:=B10 * Base + Pos(St[i],Chiffres) - 1;
Base10:=B10
END;

FUNCTION NewBase(N:LONGINT;Base:BYTE):STRING;
VAR i:BYTE;
    B:STRING;
BEGIN
B:='';
WHILE NOT (N = 0) DO
  BEGIN
  i:=N MOD Base;
  B:=Chiffres[i+1] + B;
  N:=N DIV Base;
  END;
NewBase:=B;
END;

BEGIN
Chiffres:='0123456789ABCDEFGHIJKLMNOPQRSTUVWXYZ';
WRITE('Introduisez le nombre (0 pour arrêter):');
READLN(N);
WHILE NOT ((N='0') OR (N='')) DO
  BEGIN
  N:=Majuscules(N);
  WRITE('Dans quelle base est-il exprimé: ');
  READLN(Base);
  IF NOT Verifie(N,Base) THEN WRITELN('Le nombre n''est pas correct!')
  ELSE BEGIN
       WRITE('Dans quelle base faut-il l''exprimer: ');
       READLN(NBase);
       WRITELN(N,' en base ',Base, ' = ', NewBase(Base10(N,Base),NBase), ' en base ',NBase)
       END;
  WRITE('Introduisez le nombre (0 pour arrêter):');
  READLN(N);
  END
END.