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

Обсуждение задачи 1028. Звёзды

Why wa???
Послано ls 13 июл 2003 21:31
var
  n:longint;
  p:array[1..15000,1..2]of longint;

procedure init;
var
  i:longint;
begin
  readln(n);
  for i:=1 to n do begin
    readln(p[i,1],p[i,2]);
    inc(p[i,1])
  end
end;

procedure work;
var
  i,j,count:longint;
  k,now:longint;
  t:array[1..65536]of longint;
  ans:array[0..15000]of longint;
begin
  fillchar(ans,sizeof(ans),0);
  for i:=1 to n do begin
    k:=p[i,1];now:=1;
    count:=0;
    for j:=15 downto 1 do begin
      if k=longint(1) shl j then begin
        inc(count,t[now]);break
      end;
      if k>longint(1) shl (j-1) then begin
        dec(k,longint(1) shl (j-1));
        inc(count,t[now shl 1]);now:=now shl 1+1
      end
      else
        now:=now shl 1
    end;
    inc(ans[count]);
    k:=32767+p[i,1];
    while k<>0 do begin
      inc(t[k]);k:=k shr 1
    end
  end;
  for i:=0 to n-1 do writeln(ans[i]);
end;

begin
  init;
  work
end.