ENG  RUSTimus Online Judge
Online Judge
Problems
Authors
Online contests
About Online Judge
Frequently asked questions
Site news
Webboard
Links
Problem set
Submit solution
Judge status
Guide
Register
Update your info
Authors ranklist
Current contest
Scheduled contests
Past contests
Rules
back to board

Discussion of Problem 1085. Meeting

What wrong with my program? Please help me...
Posted by Reshetnikov Eugeny 6 May 2002 22:04
Program n1085;
  Const MaxN = 100;
        MaxM = 100;
        MaxK = 100;
  Var   n,m,k,step : integer;
        i,j,q,w    : integer;
        money      : array [1..MaxK] of integer;
        a          : array [1..MaxM,1..MaxN] of byte;
        b          : array [1..MaxK,1..MaxN] of Record
                                                  sum    : integer;
                                                  step,t : byte;
                                                End;
        lost,num   : longint;

Procedure Init;
  Var stop,l : byte;
      sum    : integer;
  Begin
    Read(n,m);
    FillChar(a,SizeOf(a),0);
    For i:=1 to m Do Begin
      Read(l);
      For j:=1 to l Do Begin
        Read(stop);
        a[i,stop]:=1;
      End;
    End;
    Read(k);
    For i:=1 to k Do
      For j:=1 to n Do Begin
        b[i,j].sum:=0;
        b[i,j].step:=0;
        b[i,j].t:=0;
      End;
    For i:=1 to k Do Begin
      Read(sum,stop,l);
      money[i]:=sum;
      b[i,stop].sum:=sum;
      b[i,stop].step:=1;
      b[i,stop].t:=l;
    End;
  End;

Procedure Solve;
  Var yes : boolean;
  Begin
    step:=1;
    While true Do Begin
      yes:=true;
      For i:=1 to k Do
        For j:=1 to n Do
          If (b[i,j].step=step) and (b[i,j].sum>=4) Then Begin
            yes:=false;
            For q:=1 to m Do
              If a[q,j]=1 Then
                For w:=1 to n Do
                  If (a[q,w]=1) and (b[i,w].step=0) Then Begin
                    b[i,w].step:=step+1;
                    b[i,w].t:=b[i,j].t;
                    If b[i,j].t=0 Then b[i,w].sum:=b[i,j].sum-4
                    Else b[i,w].sum:=b[i,j].sum;
                  End;
          End;
      If yes Then Break;
      step:=step+1;
    End;
  End;

Procedure SearchAns;
  Var yes : boolean;
      los : longint;
  Begin
    lost:=MaxLongInt;
    num:=0;
    For i:=1 to n Do Begin
      yes:=true;
      los:=0;
      For j:=1 to k Do
        If b[j,i].step=0 Then Begin
          yes:=false;
          Break;
        End
        Else los:=los+money[j]-b[j,i].sum;
      If yes and (los<lost) Then Begin
        lost:=los;
        num:=i;
      End;
    End;
  End;

Procedure WriteIt;
  Begin
    If num<>0 Then Write(num,' ',lost)
    Else Write('0');
  End;

Begin
  Init;
  Solve;
  SearchAns;
  WriteIt;
End.