trg_lib.pas

PASCAL光盘资料PASCAL光盘资料PASCAL光盘资料

unit trg_lib;

interface
function Init : integer;
function Pitaj (grad1, grad2 : integer) : integer;
procedure Gotovo (put : array of integer);

implementation
const INFILE = 'trgovac.in';
  OUTFILE = 'trgovac.out';
  LOGFILE = 'trgovac.log';
  MAXGRADOVA = 1000;
  MAXPITANJA = 10000;
  PREVISE_PITANJA = -1;
  ILEGALNO_PITANJE = -2;
var broj_gradova : integer;
    strelica : array[0..MAXGRADOVA, 0..MAXGRADOVA] of integer;
    flog : text;
    broj_pitanja, muljaza : integer;
    maxin, maxout : array[0..MAXGRADOVA+1] of integer;
    bio : array[0..MAXGRADOVA, 0..MAXGRADOVA] of integer;

function Init : integer;
var fin : text;
    i, j : integer;
label van;
begin
  broj_pitanja:=0;

  assign (flog, LOGFILE); rewrite (flog);
  {$i-} assign (fin, INFILE); reset (fin); {$i+}
  if (IoResult <> 0) then
    begin
    writeln (flog, 'Datoteka ', INFILE, ' ne postoji.');
    close (flog);
    halt(0);
    end;

  { ucitavamo podatke iz trgovac.in }
  {$i+} read (fin, broj_gradova); {$i-}
  if (IoResult <> 0) then
    begin
    writeln (flog, 'Format datoteke ', INFILE, ' nije dobar.');
    close (flog);
    halt(0);
    end;

  for i:=0 to broj_gradova-1 do
    for j:=i+1 to broj_gradova-1 do
      begin
      {$i+} read (fin, strelica[i, j]); {$i-}
      if (IOResult <> 0) then
        begin
        writeln (flog, 'Format datoteke ', INFILE, ' nije dobar.');
        close (flog);
        halt(0);
        end
      else
        strelica[i, j]:=strelica[i, j]-1;

      if (strelica[0, 1] = -1) then
        begin
        muljaza:=1;
        goto van;
        end;

      strelica[j, i]:=strelica[i, j];
      end;

van:;
  close (fin);

  Init:=broj_gradova;
end;

function muljaj (grad1, grad2 : integer) : integer;
begin
  { jel sam vec odgovorio na to pitanje }
  if (bio[grad1][grad2]=1) then
    begin
    muljaj:=strelica[grad1, grad2];
    exit;
    end;

  { pogledaj jel bolje staviti strelicu grad1->grad2 ili obratno }

  if (maxin[grad1]+maxout[grad2] > maxin[grad2]+maxout[grad1]) then
    begin
    { bolje je grad2->grad1 }
    if (maxout[grad2] < maxout[grad1]+1) then
      maxout[grad2]:=maxout[grad1]+1;

    if (maxin[grad1] < maxin[grad2]+1) then
      maxin[grad1]:=maxin[grad2]+1;

    strelica[grad1, grad2]:=grad2; strelica[grad2, grad1]:=grad2;
    end
  else
    begin
    { bolje je grad1->grad2 }
    if (maxout[grad1] < maxout[grad2]+1) then
      maxout[grad1]:=maxout[grad2]+1;

    if (maxin[grad2] < maxin[grad1]+1) then
      maxin[grad2]:=maxin[grad1]+1;

    strelica[grad1, grad2]:=grad1; strelica[grad2, grad1]:=grad1;
    end;

  bio[grad1, grad2]:=1; bio[grad2, grad1]:=1;
  muljaj:=strelica[grad1][grad2];
end;

function Pitaj (grad1, grad2 : integer) : integer;
var fout : text;
    odg : integer;
begin
  broj_pitanja:=broj_pitanja+1;

  if (broj_pitanja > MAXPITANJA) then
    begin
    writeln (flog, 'Prevelik broj pitanja.');
    close (flog);

    assign (fout, OUTFILE); rewrite (fout);
    writeln (fout, PREVISE_PITANJA);
    close (fout);

    halt(0);
    end;

  write (flog, 'Pitanje broj ', broj_pitanja, ': Pitaj(', grad1, ', ', grad2, ') --> ');

  if (grad1=grad2) or (1>grad1) or (1>grad2) or (grad1>broj_gradova) or (grad2>broj_gradova) then
    begin
    assign (fout, OUTFILE); rewrite (fout);

    writeln (flog, 'nedozvoljeno pitanje');
    close (flog);

    writeln (fout, ILEGALNO_PITANJE);
    close (fout);

    halt (0);
    end
  else
    begin
    if (muljaza = 1) then
      odg:=muljaj (grad1-1, grad2-1)
    else
      odg:=strelica[grad1-1, grad2-1];

    writeln (flog, strelica[grad1-1][grad2-1]+1);
    Pitaj:=strelica[grad1-1][grad2-1]+1; exit;
    end;
end;

procedure napravi_in_file;
var fin : text;
    i, j : integer;
begin
  assign (fin, INFILE); rewrite (fin);

  randomize;
  writeln (fin, broj_gradova);
  for i:=0 to broj_gradova-2 do
    begin
    for j:=i+1 to broj_gradova-1 do
      begin
      if (bio[i][j]=1) then
        write (fin, strelica[i][j]+1, ' ')
      else
        write (fin, (j-i)*random(2)+i+1, ' ');
      end;

    writeln (fin);
    end;

  close (fin);
end;

procedure Gotovo (put : array of integer);
var fout : text;
    i : integer;
begin
  writeln (flog, 'Ukupno postavljeno ', broj_pitanja, ' pitanja.');
  close (flog);

  assign (fout, OUTFILE); rewrite (fout);
  writeln (fout, broj_pitanja);

  {
    pazi, ovdje je put indexiran od nula iako je pascal!!!!!
    tu moze biti bad ako on ima raspored[0..N] a indexira od 1
    ko normalan to radi?!
  }

  write (fout, put[0]);
  for i:=1 to broj_gradova-1 do
    write (fout, ' ', put[i]);

  writeln (fout);
  close (fout);

  { ako muljam onda moram napraviti i in-file za checker }
  if (muljaza=1) then
    napravi_in_file();

  halt (0);
end;

end.