M1RAI

BAC_PRATIQUE_2016

Jun 25th, 2020
891
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. program Fac_prim;
  2. uses WinCrt;
  3. var
  4. N:byte;
  5.  
  6. procedure saisie (Var n:byte);
  7. begin
  8.         repeat
  9.             write('N=');
  10.             readln(n);
  11.         until n in[2..5];
  12. end;
  13.  
  14. function fac_prem(x:integer):LongInt;
  15. begin
  16.             if x = 0 then fac_prem:=1
  17.             else fac_prem:= x * fac_prem(x-1);
  18. end;
  19.  
  20. function premier(x:integer):boolean;
  21. var i:integer;
  22. V:Boolean;
  23. begin
  24.             V:=true;
  25.             for i:=2 to x div 2 do
  26.                 if x mod (i) = 0 then V:=false;
  27.             premier:=V;
  28. end;
  29.  
  30. function verif_fac_prem(x:integer):boolean;
  31. var i:integer;
  32. begin
  33.         i:=0;
  34.         repeat
  35.             i:= i+1;
  36.         until (fac_prem(i) + 1 = x) OR (fac_prem(i) - 1 = x) OR (fac_prem(i) + 1> x);
  37.         if  (fac_prem(i) + 1 = x) OR (fac_prem(i) - 1 = x) then  verif_fac_prem:= true
  38.         else verif_fac_prem:= false;
  39. end;
  40.  
  41.  
  42. function verif_prim(x:integer):boolean;
  43. var i:integer;
  44. P:longint;
  45. begin
  46.         i:=1;
  47.         P:=1;
  48.         Repeat
  49.                     if premier(i) then
  50.                     begin
  51.                         P:=P*i;
  52.                         i:=i+1;
  53.                     End
  54.                     else  i:=i+1;
  55.         until (P+1 = x) OR (P-1 = x) OR (P > x+1);
  56.         if  (P+1 = x) OR (P-1 = x) then verif_prim := true
  57.         else   verif_prim := false;
  58. end;
  59.  
  60.  
  61. Procedure afficher(N:integer);
  62. var
  63. i:integer;
  64. x:integer;
  65. begin
  66.         x:=1;
  67.         writeln('Les nombres premiers factoriels :');
  68.         for i:= 1 to N Do
  69.         Begin
  70.             repeat
  71.                 x:=x+1;
  72.             until (premier(x)) AND (verif_fac_prem(x));
  73.             writeln(x);
  74.         end;
  75.         x:=1;
  76.         writeln('Les nombres premiers primoriels :');
  77.         for i:= 1 to N Do
  78.         Begin
  79.                 repeat
  80.                     x:=x+1;
  81.                 until (premier(x)) AND (verif_prim(x));
  82.             writeln(x);
  83.         end;
  84. end;
  85.  
  86. begin
  87. saisie(n);
  88. afficher(n);
  89. end.
RAW Paste Data