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

Общий форум

Whi wrang. p1211
Послано I am david. Tabo. 25 окт 2002 22:57
var ni,nn,k,i,j,max,m,n:longint;
    a,b,c:array [1..250{01}] of integer;
    q:array [1..25001] of byte;
    s:boolean;

begin
  readln (k);
  for j:=1 to k do
    begin
      readln (n);
      for i:=1 to n do
        begin
          if i<>n then
            read (a[i])
          else
            readln (a[i]);
          if a[i]<>0 then
            inc (b[a[i]]);
        end;
      max:=b[1];
      for i:=2 to n do
        if max<b[i] then
          max:=b[i];
      for i:=1 to n do
        if (b[i]=max) then
          begin
            c[i]:=max;
            inc (m);
          end;
      if m=1 then
        begin
          inc (nn);
          q[nn]:=1;
          s:=true;
        end
      else
        for i:=1 to n do
          if (a[i]=0)and(b[i]<>0) then
            begin
              inc (nn);q[nn]:=1;
              if ni=1 then
                begin
                  FillChar(q,SizeOf(q),0);
                  dec(nn);break;
                end;
              inc (ni);
              s:=true;
            end;
      if not s then
        begin
          inc (nn);q[nn]:=0;
        end;
      FillChar(a,SizeOf(a),0);
      FillChar(b,SizeOf(b),0);
      FillChar(c,SizeOf(c),0);
      s:=false;
    end;
  for i:=1 to nn do
    if q[i]=1 then
      writeln ('YES')
    else
      writeln ('NO');
end.


i found some error and no it got WA too. help
Послано I am david. Tabo. 25 окт 2002 23:24
var ni,nn,k,i,j,max,m,n:longint;
    a,b,c:array [1..25001] of integer;
    q:array [1..1001] of byte;
    s:boolean;

begin
  readln (k);
  for j:=1 to k do
    begin
      readln (n);
      for i:=1 to n do
        begin
          if i<>n then
            read (a[i])
          else
            readln (a[i]);
          if a[i]<>0 then
            inc (b[a[i]]);
        end;
      max:=b[1];
      for i:=2 to n do
        if max<b[i] then
          max:=b[i];
      for i:=1 to n do
        if (b[i]=max) then
          begin
            c[i]:=max;
            inc (m);
          end;
      if m=1 then
        begin
          inc (nn);
          q[nn]:=1;
          s:=true;
        end
      else
        for i:=1 to n do
          if (a[i]=0)and(b[i]<>0) then
            begin
              inc (nn);q[nn]:=1;
              if ni=1 then
                begin
                  if nn<>1 then
                    q[nn-1]:=0
                  else
                    q[nn]:=0;
                  break;
                end;
              inc (ni);
              s:=true;
            end;
      if not s then
        begin
          inc (nn);q[nn]:=0;
        end;
      FillChar(a,SizeOf(a),0);
      FillChar(b,SizeOf(b),0);
      FillChar(c,SizeOf(c),0);
      s:=false;
    end;
  for i:=1 to k do
    if q[i]=1 then
      writeln ('YES')
    else
      writeln ('NO');
end.


i found some error and no it got WA too. help
Послано I am david. Tabo. 25 окт 2002 23:24
var ni,nn,k,i,j,max,m,n:integer;
    a,b,c:array [1..25001] of integer;
    q:array [1..1001] of byte;
    s:boolean;

begin
  readln (k);
  for j:=1 to k do
    begin
      readln (n);
      for i:=1 to n do
        begin
          if i<>n then
            read (a[i])
          else
            readln (a[i]);
          if a[i]<>0 then
            inc (b[a[i]]);
        end;
      max:=b[1];
      for i:=2 to n do
        if max<b[i] then
          max:=b[i];
      for i:=1 to n do
        if (b[i]=max) then
          begin
            c[i]:=max;
            inc (m);
          end;
      if m=1 then
        begin
          inc (nn);
          q[nn]:=1;
          s:=true;
        end
      else
        for i:=1 to n do
          if (a[i]=0)and(b[i]<>0) then
            begin
              inc (nn);q[nn]:=1;
              if ni=1 then
                begin
                  if nn<>1 then
                    q[nn-1]:=0
                  else
                    q[nn]:=0;
                  break;
                end;
              inc (ni);
              s:=true;
            end;
      if not s then
        begin
          inc (nn);q[nn]:=0;
        end;
      FillChar(a,SizeOf(a),0);
      FillChar(b,SizeOf(b),0);
      FillChar(c,SizeOf(c),0);
      s:=false;
    end;
  for i:=1 to k do
    if q[i]=1 then
      writeln ('YES')
    else
      writeln ('NO');
end.


I got TL. who can help me
Послано I am david. Tabo. 25 окт 2002 23:56
var ni,k,i,j,max,m,n:longint;
    a,b:array [1..25001] of integer;
    q:array [1..1001] of byte;
    s:boolean;

begin
  readln (k);
  for j:=1 to k do
    begin
      readln (n);
      for i:=1 to n do
        begin
          if i<>n then
            read (a[i])
          else
            readln (a[i]);
          if a[i]<>0 then
            inc (b[a[i]]);
        end;
      max:=b[1];
      for i:=2 to n do
        if max<b[i] then
          max:=b[i];
      for i:=1 to n do
        if (b[i]=max) then
          inc (m);
      ni:=0;
      if m=1 then
        begin
          q[j]:=1;
          s:=true;
        end
      else
        for i:=1 to n do
          if (a[i]=0)and(b[i]<>0) then
            begin
              q[j]:=1;
              if ni=1 then
                begin
                  q[j]:=0;
                  break;
                end;
              inc (ni);
              s:=true;
            end;
      if not s then
        q[j]:=0;
      s:=false;
      fillchar(a,sizeof(a),0);
      fillchar(b,sizeof(b),0);
    end;
  for i:=1 to k do
    if q[i]=1 then
      writeln ('YES')
    else
      writeln ('NO');
end.