Arfizato

bac pratique 14h 2013

Apr 24th, 2020
1,029
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. //http://kiteb.net/education/informatique/bac/bacinfo2013/bac-pratique-23052013-algo-14h.pdf
  2. Program bac2013;
  3. uses WinCrt;
  4. type
  5.      mat= Array [1..24,1..24] of Integer;
  6.      eng= Record
  7.       nl,icd,icf : Byte;
  8.      end;
  9.      tab = Array [1..24] of eng;
  10. var
  11.   m :mat ;
  12.     l,c :byte;
  13.     t: tab;
  14.     f: text;
  15.     Procedure saisi(var x : Byte;ch: string);
  16.      begin
  17.         repeat
  18.             write(ch);
  19.             readln(x);
  20.         until  x in [3..24 ]
  21.      end;
  22.     Procedure rempM(var m : mat ; l,c: Byte);
  23.      var
  24.         a,b: Byte;
  25.      begin
  26.         for a:=1 to l do
  27.          for b:=1 to c  Do
  28.            begin
  29.               repeat
  30.                     write('M[',a,',',b,'] : ');
  31.                     readln(m[a,b]);
  32.                 until m[a,b] <>0;
  33.              end;
  34.      end;
  35.      Procedure init(var t : tab ; l : Byte);
  36.       var
  37.         a: Byte;
  38.         begin
  39.          for a:=1 to l do
  40.           begin
  41.              t[a].nl:=0;
  42.              t[a].icd:=0;
  43.              t[a].icf:=0;
  44.             end;
  45.         end;
  46.      Procedure rempt(var t :tab; m: mat ;l,c: Byte);
  47.         var
  48.          a,b,d,s: Byte;
  49.         begin
  50.             init(t,l);
  51.          for a:=1 to l do
  52.             begin
  53.                 for d:=1 to  c do
  54.                     begin
  55.                         b:=d;
  56.                         s:=0;
  57.                         repeat
  58.                             s:=s+m[a,b];
  59.                             b:=b+1;
  60.                         until (b>c ) or (s=0 );
  61.                         if (s=0 ) then
  62.                             if (t[a].icf - t[a].icd < (b) -d  ) then
  63.                             begin
  64.                                 t[a].nl:=a;
  65.                                 t[a].icf:=b-1;
  66.                                 t[a].icd:=d;
  67.                             end;
  68.                     end;
  69.             end;
  70.         end;
  71.         function calc(t : tab ; l : Byte): Byte;
  72.             var
  73.              a,max: Byte;
  74.             begin
  75.            max :=0;
  76.              for a:=1 to l do
  77.               if t[a].icf -t[a].icd > max then
  78.                  max := t[a].icf -t[a].icd ;
  79.                 calc:=max;
  80.             end;
  81.       Procedure fillfile(var f : text ;t :tab; l : Byte);
  82.             var
  83.              a,max:Byte;
  84.             begin
  85.                 rewrite(f);
  86.                 max:=calc(t,l);
  87.                 for a:=1 to l do
  88.                     if t[a].icf -t[a].icd = max  then
  89.                      writeln(f,t[a].nl,'#',t[a].icd,'#',t[a].icf);
  90.                 close(f);
  91.             end;
  92. begin
  93.    
  94.  saisi(l,'Nbr de ligne: ');
  95.  saisi(c,'Nbr de colonnes:' );
  96.  rempm(m,l,c);
  97.     rempt(t,m,l,c);
  98. assign(f,'C:\Users\platpot\Desktop\arfizato\progg\pascal\Projects\bac2013.txt');
  99.  fillfile(f,t,l);
  100. end.
RAW Paste Data