Algo.tn

Program Nomination;
Uses Wincrt;
Type
  Tab = Array[1..20] Of String[10];
Var
  N,i : Integer;
  Nom: Tab;

Procedure Spirale(Nom:Tab;n:Integer);
Begin
End;
Begin
  Write('Donner le nombre de produits:');
  Readln(N);
  For i:=1 To N Do
    Begin
        Write('Donner le nom du produit n°',i,':');
        Readln(Nom[i]);
    End;
  Spirale(Nom, N);
End.

Program Nomination;
Uses Wincrt;
Type
  Tab = Array[1..20] Of String[10];
Var
  N,i : Integer;
  Nom: Tab;

Function verif(ch:String): Boolean;
Var
  ok: Boolean; i:integer;
Begin
  ok := True;
  i := 0;
  Repeat
    i := i+1;
    If Not(ch[i] In ['A'..'Z']) Then ok := False;
  Until (i=Length(ch)) Or (ok=False);
  verif := ok;
End;
Procedure saisir(Var nom:tab; Var n:Integer);
Var
  i: Integer;
Begin
  Repeat
    Write('Donner le nombre de produits:');
    Readln(N);
  Until n In [3..20];
  For i:=1 To N Do
    Repeat
      Write('Donner le nom du produit n°',i,':');
      Readln(Nom[i]);
    Until (Length(nom[i])=10) And ( verif(nom[i]));
End;
Procedure Spirale(Nom:Tab;n:Integer);
Var
  p,i: Integer;
  ch: String;
  tp: tab;

Function rotation(ch:String): String;
Var
  ch2: String;
  L,i: Integer;
Begin
  L := Length(ch);
  ch2 := '';
  For i:= 1 To l Div 2 Do
    ch2 := ch2+ch[L-i+1]+ch[i];
  If L Mod 2 <>0 Then ch2 := ch2+ch[l Div 2+1];
  rotation := ch2;
End;

Procedure Affichage(TP:tab;N:Integer);
Var
  i: Integer;
Begin
  Write(tp[1]);
  For i:=1 To n Do
    Write('-', tp[i]);
End;
Begin
  Repeat
    Write('P (entre 1 et 10) =');
    Readln(p);
  Until p In [1..10];
  ch := '';
  For i:=1 To n Do
    ch := ch+nom[I][p];
  tp[1] := ch;
  For i:=2 To n Do
    tp[i] := rotation(tp[i-1]);
  affichage(tp,n);
End;
Begin
  saisir(Nom,n);
  Spirale(Nom, N);
End. 

program TirArc ;
uses wincrt;
Type
tab=array[1..20]of String[30];
var
n,i:Integer;
A:tab;

Function Alpha(ch:string):Boolean;
Begin
end;
Procedure score(A:tab;n:Integer);
Begin

end;

Begin
Repeat
Write ('Donner le nombre de joueurs : '); readln (N);
until  (N In [2..20]);
For i:=1 to N Do
Repeat
WriteLn ('Donner le nom du joueur n°', i,' : '); Readln (A[i]);
Until (Alpha (A[i]));
Score (A, N);
end.

Program TirArc ;
Uses Wincrt;
Type
  tab = Array[1..20] Of String[30];
Var
  n,i: Integer;
  A: tab;
Function Alpha(ch:String): Boolean;
Var
  ok: Boolean;
  i: Integer;
Begin
  ok := True;
  If Length(ch)>30 Then ok := False
  Else
    Begin
      i := 0;
      Repeat
        i := i+1;
        If Not(ch[i] In ['A'..'Z','a'..'z',' ']) Then ok := False;
      Until (i=Length(ch)) Or (ok=False);
    End;
  Alpha := ok;
End;
Procedure score(A:tab;n:Integer);
Type
  tab2 = Array[1..20] Of Integer;
Var
  i,j,e,nb: Integer;
  S: tab2;

Procedure Trier(Var A:tab;Var S:tab2;n:Integer);
Var
  i: Integer;
  echange: Boolean;
  aux1: Integer;
  aux2: String;
Begin
  Repeat
    echange := False;
    For i:=1 To n-1 Do
      If (S[i] < S[i+1]) Then
        Begin
          aux1 := S[i];
          S[i] := S[i+1];
          S[i+1] := aux1;
          aux2 := A[i];
          A[i] := A[i+1];
          A[i+1] := aux2;
          Echange := True ;
        End;
    n := n-1;
  Until (Echange = False) Or (n=1);
End;

Procedure Afficher(A:tab;S:tab2;n:Integer);
Var
  i: Integer;
Begin
  For i:=1 To n Do
    Writeln(A[i], ' avec un score de ', S[i]);
End;
Begin
  For i:=1 To n Do
    Begin
      Writeln('Joueur ', i);
      nb := 0;
      For j:=1 To 3 Do
        Begin
          Repeat
            Write('donner essai n°',j,': ');
            Readln(E);
          Until E In [0..10];
          nb := nb+ E;
          S[i] := nb;
        End;
    End;
  trier(A,S,N);
  afficher(A,S,N);
End;
Procedure remplir(Var A:tab;n:Integer);
Var
  i: Integer;
Begin
  For i:=1 To N Do
    Repeat
      Writeln ('Donner le nom du joueur n°', i,' : ');
      Readln (A[i]);
    Until (Alpha (A[i]));
End;
Begin
  Repeat
    Write ('Donner le nombre de joueurs : ');
    Readln (N);
  Until (N In [2..20]);
  remplir(A,n);
  Score (A, N);
End.

Program Plagiat;
uses WinCrt;
var
T1,T2:String; nbc:Integer;

Function Nbmots(ch:string):Integer;
Begin
end;

Function Commun(ch1,ch2:string):Integer;
Begin
end;

Begin
Repeat
 Readln (T1);
 Readln (T2);
Until (Nbmots (T1) = Nbmots (T2));
Nbc:=Commun (T1,T2);
End.

Program Plagiat;
Uses Wincrt;
Var
  T1,T2: String;
  nbc: Integer;
Function Nbmots(ch:String): Integer;
Var
  nb,i: Integer;
Begin
  nb := 0;
  For i:=1 To Length(ch)-2 Do
    If ch[i]=' ' Then nb := nb+1;
  nbmots := nb+1;
End;
Function Commun(ch1,ch2:String): Integer;
Type
  tab = Array[1..100] Of String;
Var
  t11,t22: tab;
  n1,n2,nb,i,j,k: Integer;
  trouve: Boolean;
Procedure extraire_mots(ch:String;Var t:tab;Var n:Integer);
Var
  i: Integer;
Begin
{Ajout de n-1 mots au tableau }
  i := 0;
  While (Pos(' ',ch)<>0) Do
    Begin
      i := i+1;
      t[i] := Copy(ch,1,Pos(' ',ch)-1);
      Delete(ch,1,Pos(' ',ch));
    End;
{Ajout du dernier mot au tableau }
  i := i+1;
  t[i] := Copy(ch,1,Pos('.',ch)-1);
{nombre de mots = taille n de tableau}
  n := i;
End;
Begin
{extraire les mots de T1 et T2 dans deux tableaux T11 et T22}
  extraire_mots(ch1,T11,n1);
  extraire_mots(ch2,T22,n2);
  Writeln('Les mots communs:');
  nb := 0;
  For i:=1 To n1 Do
    Begin
      j := 0;
      trouve := False;
      Repeat
        j := j+1;
 {rechercher si un mot de T11 se trouve dans T22}
        If t11[i]=t22[j] Then
          Begin
            trouve := True;
            nb := nb+1;
            Write(t11[i],' - ');
 {effacer le mot trouvé dans T22 par décalage des éléments }
            For k:=j To n2-1 Do
              t22[k] := t22[k+1];
 { Par conséquent la taille du tableau diminue}
            n2 := n2-1;
          End;
      Until (Trouve) Or (j>n2);
    End;
  commun := nb;
End;
Function verif(ch:String): Boolean;
Var
  ok: Boolean;
  i: Integer;
Begin
  ok := True;
  i := 0;
  Repeat
    i := i+1;
    If Not(ch[i] In ['A'..'Z',' ']) Then ok := False;
  Until (i=Length(ch)-1) Or (ok=False);
  Verif := ok;
End;
Procedure saisir(Var ch:String);
Begin
  Repeat
    Write('Donner une chaine :');
    Readln(ch);
  Until (ch[1] In ['A'..'Z']) And (Length(ch)<=200) And (ch[Length(ch)]='.') And (verif(ch)=True);
 {garder un seul espace entre deux mots consécutifs}
  While Pos('  ',ch)<>0 Do
    Delete(ch,Pos('  ',ch),1);
 { ne garder aucun espace avant le point de fin de texte}
  If ch[Length(ch)-1]=' ' Then Delete(ch,Length(ch)-1,1);
End;
Begin
  Writeln('saisir deux textes T1 et T2 ayant un même nombre de mots:');
  Repeat
    Writeln('Donner T1:');
    Saisir (T1);
    Writeln('Donne T2:');
    Saisir (T2);
  Until (Nbmots (T1) = Nbmots (T2));
  Nbc := Commun (T1,T2);
  Writeln('Nombre de mots communs: ',nbc);
  If nbc>Nbmots(T1) Div 2 Then Writeln('le texte T2 est plagiat de T1')
  Else Writeln('le texte T2 n''est pas plagiat de T1')
End.

Program Fidelite;
Uses Wincrt;
Type
  TAB = Array[1..30] Of String[10];
Var
  N: Integer;
  TA: TAB;
  
Procedure Remplir(Var TA:TAB; n:Integer);
Begin
End;

Procedure Bonus(TA:TAB; n:Integer);
Begin
End;

Begin
  Repeat
    Write('Donner le nombre des adhérents: ');
    Readln(N);
  Until N In [5..30];
  Remplir(TA,N);
  Bonus(TA,N);
End.

Program Fidelite;
Uses Wincrt;
Type
  TAB = Array[1..30] Of String[10];
Var
  N: Integer;
  TA: TAB;

Function distinct(TA:tab;n,i:Integer): Boolean;
Var
  ok: Boolean;
  j: Integer;
Begin
  ok := True;
  j := 0;
  Repeat
    j := j+1;
    If Copy(TA[i],8,3)=Copy(TA[j],8,3) Then ok := False;
  Until (ok=False) Or (j=i-1);
  distinct := ok;
End;
Function verif(ch:String): Boolean;
Var
  d: Longint;
  e,a,m: Integer;
Begin
  Val(Copy(ch,6,2),m,e); { extraction du mois }
  Val(Copy(ch,2,4),a,e); {extraction de l'année}
  Val(Copy(ch,2,Length(ch)-1),d,e); {si e=0 alors il y a 9 chiffres }
  verif := (Length(ch)=10) And (ch[1] In ['A','J','E']) And (e=0) And
           (a>=2000) And (a<=2019) And (m In [1..12]) ;
End;
Procedure Remplir(Var TA:TAB; n:Integer);
Var
  i: Integer;
Begin
  Repeat
    Write('Donner le numéro d''abonnement n° 1 =');
    Readln(TA[1]);
  Until verif(TA[1]);
  For i:=2 To n Do
    Repeat
      Write('Donner le numéro d''abonnement n° ',i,' =');
      Readln(TA[i]);
    Until verif(TA[i]) And distinct(TA,N,i)
End;

Procedure Bonus(TA:TAB; n:Integer);
Var
  i,aa,mm,a,m,e,an,nb: Integer;
  cat: Char;
Begin
  aa := 2019;
  mm := 5;
  Repeat
    Write('donner la catégorie de l''adhérent: ');
    Readln(cat);
  Until cat In ['A','J','E'];
  For i:=1 To n Do
    If TA[i][1]=cat Then
      Begin
        nb := 0;
        Val(Copy(TA[i],2,4),a,e);
        Val(Copy(TA[i],6,2),m,e);
        an := aa-a;
        If (mm < m) And (an<>0) Then an := an-1; {calcul de nombre d'années }
        If (an>=5) Then
          Begin
            If m<=mm Then nb := an*12+(mm-m)
            Else nb := an*12+(12-(m-mm)); {calcul de nombre de mois }
            Writeln('L''adhérent n°', Copy(TA[i],8,3), ' son bonus accordé est=',nb,' heures');
          End;
      End;
End;

Procedure Saisir(Var N:Integer);
Begin
  Repeat
    Write('Donner le nombre des adhérents: ');
    Readln(N);
  Until N In [5..30];
End;
Begin
  Saisir(N);
  Remplir(TA,N);
  Bonus(TA,N);
End.