shichemt

Correction BAC 2013 a 11h

May 27th, 2013
32
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
Pascal 1.08 KB | None | 0 0
  1. program bac2013v11;
  2. uses wincrt;
  3. var i,e,n:integer; ch:string;  trv1,trv2:boolean; a,x:longint;
  4. procedure saisir(var n:integer);
  5. begin
  6. repeat
  7. writeln('Donner n');
  8. readln(n);
  9. until(n>=10);
  10. end;
  11.  
  12. procedure inverse (var ch:string);
  13. var i,j:integer;
  14. procedure permut (var x,y:char);
  15. var aux:char;
  16. begin
  17. aux := x;
  18. x := y;
  19. y := aux;
  20. end;
  21.  
  22. begin
  23. i:=0;
  24. j:=length(ch);
  25. repeat
  26. i:=i+1;
  27. permut(ch[i],ch[j]);
  28. j:=j-1;
  29. until(j=i);
  30. end;
  31.  
  32. function pali (var ch:string):boolean;
  33. var debut,n:integer; trv:boolean;
  34. begin
  35. debut:=1;
  36. n:= length(ch);
  37. repeat
  38. debut:=debut+1;
  39. n:=n-1;
  40.  
  41. until((debut=n) or (ch[n] <> ch[debut]));
  42. if (ch[n] <> ch[debut]) then trv:=false
  43. else trv:=true;
  44.  
  45. pali:= trv;
  46. end;
  47.  
  48. begin
  49.  
  50. saisir(n);
  51. a:=n;
  52. i:=0;
  53. repeat
  54. i:=i+1;
  55. str(a,ch);
  56. inverse(ch);
  57. val(ch,x,e);
  58. a:=a+x;
  59. str(a,ch);
  60. trv1:=((pali(ch)) and (i<=10));
  61. trv2:=((pali(ch)=false) and (i=11));
  62. until(trv1 or trv2);
  63. if (trv1) then writeln('Cette suite est palindromique')
  64. else if(trv2) then writeln('Le calcul de 11 termes ne donne pas une suite palidromique pour ce nombre.')
  65.  
  66.  
  67. end.
Advertisement
Add Comment
Please, Sign In to add comment