Bac 2010 8H30

Program bac20108h30;
Uses Wincrt;
Type
  tab = Array [1..25] Of Integer;
Var
  f: Text;
  ch: String;
Procedure creation (Var f:Text);
Begin
  Assign (f,'c:\bac\nombres.txt');
End;
Procedure remplir (Var f:Text;Var ch1:String);
Var
  n,i: Integer;
  ch: String;
Begin
  Repeat
    Write ('Saisir le nombre d''entiers: ');
    Readln (n);
  Until (2<n) And (n<=50);
  Rewrite (f);
    Randomize;
  For i:=1 To n Do
    Begin
      Str (Random(9)+1,ch);
      Writeln (f,ch);
      ch1 := ch1+ch;
    End;
End;
Function tri (ch:String): String;
Var
  i: Integer;
  ch1,max: String;
Begin
  ch1 := '';
  Repeat
    max := ch[1];
    For i:=1 To Length(ch) Do
      Begin
        If max<ch[i] Then
          max := ch[i];
      End;
    Delete (ch,Pos(max,ch),1);
    ch1 := ch1+max;
  Until (ch='');
  tri := ch1;
End;
Function invers (ch:String): String;
Var
  ch1: String;
  i: Integer;
Begin
  ch1 := '';
  For i:=Length(ch) Downto 1 Do
    ch1 := ch1+ch[i];
  invers := ch1;
End;
Function suite (ch:String): Boolean;
Var
  i,x1,x2,e,r: Integer;
  test: Boolean;
  t: tab;
Begin
 {ch:='7654321'; example de l'exerceice}
  Writeln ('gn: ',tri(ch));
  Writeln ('pn: ',invers(tri(ch)));
  ch := tri(ch);
  For i:=1 To Length(ch) Div 2 Do
    Begin
      Val (ch[i],x1,e);
      Val (ch[Length(ch)-i+1],x2,e);
      t[i] := x1-x2;
    End;
  r := t[1]-t[2];
  i := 1;
  test := True;
  While (test) And (i+1<Length(ch) Div 2) Do
    Begin
      i := i+1;
      test := t[i]-t[i+1]=r;
    End;
  suite := test;
End;
Begin
  creation (f);
  remplir (f,ch);
  If (suite(ch)) Then
    Writeln ('U est une suite arithmetique');
End.