M1RAI

freq_premier_bac_2012

May 15th, 2020
1,903
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program freq_premier;
  2. uses wincrt;
  3. type
  4. fich=file of integer;
  5. var
  6. f:fich;
  7. ft:text;
  8. N,P,bi,bf:byte;
  9.  
  10. Procedure saisie(var N:byte; bi,bf:byte);
  11. begin
  12.     repeat
  13.         readln(n);
  14.     until (N>bi) AND (N<bf);
  15. end;
  16.  
  17. function verif(x:integer;P:byte):Boolean;
  18. var ch:string;
  19. begin
  20.     str(x,ch);
  21.     if(Length(ch) = P) then verif:= TRUE
  22.     else verif:= FALSE;
  23. end;
  24.  
  25. Procedure rempf(var f:fich; N,P:byte);
  26. var i:byte;
  27. x:integer;
  28. begin
  29.     ReWrite(f);
  30.     for i:=1 to N do
  31.     begin
  32.         repeat
  33.             readln(x);
  34.         until verif(x,P);
  35.         write(f,x);
  36.     end;
  37.     Close(f);
  38. end;
  39.  
  40.  
  41.  
  42.  
  43.  
  44. Procedure rempft(var ft:text; var f:fich);
  45. Var
  46. x,i,nb:integer;
  47. chf,chi,freq,chnb:string;
  48. begin
  49.         reset(f);
  50.         ReWrite(ft);
  51.         while not(Eof(f)) do
  52.         begin
  53.                 freq:='';
  54.                 read(f,x);
  55.                 chf:='';
  56.                 if x > 1
  57.                 then
  58.                 begin
  59.                         for i:=2 to x do
  60.                         begin
  61.                                 nb:=0;
  62.                                 if x mod i = 0 Then
  63.                                 repeat
  64.                                     str(i,chi);
  65.                                     chf:=chf+chi+'*';
  66.                                     nb:=nb+1;
  67.                                     x:= x div i;
  68.                                 until x mod i <> 0;
  69.                                 if nb <> 0
  70.                                 then
  71.                                 begin
  72.                                     str(nb,chnb);
  73.                                     freq:=freq+chnb+chi;
  74.                                 end;
  75.                         end;
  76.                 end;
  77.                 delete(chf,length(chf),1);
  78.                 writeln(ft,chf,' ',freq);
  79.         end;
  80.         close(f);
  81.         close(ft);
  82. end;
  83.  
  84.  
  85. procedure aff(var ft:text);
  86. var ch:string;
  87. begin
  88.         reset(ft);
  89.         while not(eof(ft)) do
  90.         begin
  91.             readln(ft,ch);
  92.             writeln(ch);
  93.         end;
  94.         Close(ft);
  95. end;
  96.  
  97.  
  98. begin
  99. assign(f,'C:\Pascal\BAC2012\nombres.dat');
  100. Assign(ft,'C:\Pascal\BAC2012\Facteurs.txt');
  101. write('N=');
  102. saisie(N,2,100);
  103. write('P=');
  104. saisie(P,2,6);
  105. rempf(f,n,p);
  106. rempft(ft,f);
  107. aff(ft);
  108. end.
RAW Paste Data