ENG  RUSTimus Online Judge
Online Judge
Задачи
Авторы
Соревнования
О системе
Часто задаваемые вопросы
Новости сайта
Форум
Ссылки
Архив задач
Отправить на проверку
Состояние проверки
Руководство
Регистрация
Исправить данные
Рейтинг авторов
Текущее соревнование
Расписание
Прошедшие соревнования
Правила
вернуться в форум

Обсуждение задачи 1085. Встреча

What wrong with my program? Please help me...
Послано Reshetnikov Eugeny 6 май 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.