M1RAI

max_min_bac_2010_prat

Mar 30th, 2020
443
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. Program max_min;
  2. Uses Wincrt;
  3. Type
  4.     fich = file of byte;
  5. Var
  6.   n: Byte;
  7.   f: fich;
  8.     g,ch:string;
  9. Procedure saisie (Var n:Byte);
  10. Begin
  11.   Repeat
  12.     Write('n=');
  13.     Readln(n);
  14.   Until n In[3..50];
  15. End;
  16. Procedure remp (Var f:fich; n:Byte);
  17. Var
  18.   x,i: Byte;
  19. Begin
  20.   Rewrite(f);
  21.   For i := 1 To n Do
  22.     Begin
  23.       x := Random(9-1)+1;
  24.       Write(f,x);
  25.     End;
  26.   Close(f);
  27. End;
  28. Procedure rempch (Var ch:string; Var f:fich);
  29. Var
  30.   x,i: Byte;
  31.     chx:string;
  32. Begin
  33.   Reset(f);
  34.   i := 0;
  35.     ch:='';
  36.   While Not(Eof(f)) Do
  37.     Begin
  38.       i := i + 1;
  39.       Read(f,x);
  40.       str(x,chx);
  41.             ch:=ch+chx;
  42.     End;
  43.         close(f);
  44. End;
  45. procedure tri_crois(Var ch:string;n:Byte);
  46. Var
  47.   i: Byte;
  48.     v:Boolean;
  49.     aux:char;
  50. Begin
  51.   Repeat
  52.     v := True;
  53.     For i:=1 To n-1 Do
  54.       Begin
  55.         If ch[i] > ch[i+1]
  56.           Then
  57.           Begin
  58.             aux := ch[i];
  59.             ch[i] := ch[i+1];
  60.             ch[i+1] := aux;
  61.             v := False;
  62.           End;
  63.       End;
  64.     n := n -1;
  65.   Until V;
  66. End;
  67.  
  68.  
  69.  
  70. function grand(ch:string): string;
  71. Var chg:string;
  72. i:byte;
  73. Begin
  74.     chg:='';
  75.     for i:=length(ch) DownTo 1 do
  76.     begin
  77.         chg:=chg+ch[i];
  78.     end;
  79.     grand:=chg;
  80. End;
  81.  
  82. procedure verif(g:string;n:byte);
  83. var  e1,e2:integer;
  84. c,i,j,xi,xj:byte;
  85. U:array [1..n] of byte;
  86. r:shortint;
  87. V:boolean;
  88. begin
  89.          i:=1;
  90.          j:=n;
  91.          c:=0;
  92.          Repeat
  93.                  c:=c+1;
  94.                  val(G[i],xi,e1);
  95.                  val(G[j],xj,e2);
  96.                  U[c] := xi-xj;
  97.                  i:=i+1;
  98.                  j:=j-1;
  99.          until   i>j;
  100.          r:=U[2]-U[1];
  101.          i:=2;
  102.          while (i<=c-1) and (U[i+1]-U[i] = r) do
  103.          i:=i+1;
  104.          V:=i>c-1;
  105.          if V then write('ce nombre forme une suite arithmétique de raison r=',r)
  106.          else write('ce nombre ne forme pas une suite arithmétique');
  107.          
  108.  
  109. end;
  110.  
  111.  
  112. Begin
  113.     Randomize;
  114.   Assign(f,'C:\Pascal\max_min_bac_2010_prat\nombres.dat');
  115.   saisie(n);
  116.   remp(f,n);
  117.   rempch(ch,f);
  118.     tri_crois(ch,n);
  119.   Writeln('Le plus petit nombre est: ',ch);
  120.   Writeln('le plus grand nombre est: ',grand(ch,n));
  121.     g:=grand(ch,n);
  122.     verif(g,n);
  123.    
  124. End.
RAW Paste Data