Bac 2014 22/05

Program bac2014;
Uses Wincrt;
Type
  mat = Array[1..10,1..10] Of Integer;
Var
  f: Text;
  t: mat;
  n,m: Integer;
Procedure creation (Var f:Text);
Begin
  Assign (f,'c:/bac/Fnombres.txt');
End;
Procedure remplir (Var f:Text;Var t:mat;Var n,m:Integer);
Var
  i,j: Integer;
Begin
  Repeat
    Writeln ('Saisir n: ');
    Readln (n);
    Write ('Saisir m: ');
    Readln (m);
  Until (1<=n) And (n<=10) And (3<m) And (m<=10) And (m Mod 2=0);
  For i:=1 To n Do
    For j:=1 To m Do
      Begin
        Write ('t[',i,',',j,'] : ');
        Readln (t[i,j]);
      End;
  Rewrite (f);
  For i:=1 To n Do
    For j:= 1 To m Div 2 Do
      Writeln (f,Abs(t[i,j]-t[i,m-j+1]));
  Close (f);
End;
Procedure traitement (Var f:Text);
Var
i,n,e,j:integer;
ch:string;
t1,t2:array [1..50] of integer;
begin
    reset (f);
    n:=0;
    while not (eof(f)) Do
        Begin
            n:=n+1;
            readln (f,t1[n]);
        end;
    close (f);
    for i:=1 to n-1 Do
        t2[i]:=t1[i+1]-t1[i];
    e:=0;
    For i:=0 To n-1 Do
    Begin
      e := 0;
      Repeat
        i := i+1;
        If t2[i+1]=t2[i] Then
          e := e+1;
      Until ((e>0) And (t2[i+1]<>t2[i])) Or (i-2=n-1);
            if (e>0) Then
                begin
                for j:=abs(e-i) to i+1 Do
                    if (j<=i) Then
                    write (t1[j],', ')
                    else write (t1[j],' ') ;
                writeln ('est une suite arithmétique de raison r = ',t2[i]);
                end;
    End;
End;
Begin
  creation (f);
  remplir (f,t,n,m);
    traitement (f);
End.