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

Общий форум

Whi TL HELP ME PLEASE. THENCKS
Послано I am david. Tabo. 26 окт 2002 19:25
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.
IT IS P1211
Послано I am david. Tabo. 26 окт 2002 19:25