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

Обсуждение задачи 1127. Кубики

Why WA?Help me pls...
Послано Serega 27 авг 2003 15:45

var index:byte;
    s:array[1..1000] of string[6];
    i,j:integer;
    k,kil:integer;
    a:array[1..10] of integer;
procedure read_dat;
begin
  readln(k);
  for i:=1 to k do
    readln(s[i]);
for j:=1 to k do
  for i:=1 to 6 do
  begin
    if s[j][i]='A' then
     index:=1;
    if s[j][i]='B' then
      index:=2;
    if s[j][i]='C' then
      index:=3;
    if s[j][i]='G' then
      index:=4;
    if s[j][i]='O' then
      index:=5;
    if s[j][i]='R' then
      index:=6;
    if s[j][i]='S' then
      index:=7;
    if s[j][i]='V' then
      index:=8;
    if s[j][i]='W' then
      index:=9;
    if s[j][i]='Y' then
      index:=10;
    inc(a[index]);
  end;
end;
procedure sort(l,r:integer);
var i,j,x,y:integer;
begin
  i:=l;
  j:=r;
  x:=a[(l+r) div 2];
  repeat
    while a[i]<x do inc(i);
    while a[j]>x do dec(j);
    if i<=j then
    begin
      y:=a[i];
      a[i]:=a[j];
      a[j]:=y;
      inc(i);
      dec(j);
    end;
  until i>j ;
  if l<j then sort(l,j);
  if i<r then sort(i,r);
end;
procedure solve;
begin
  writeln(a[7]);
end;
begin
  read_dat;
  sort(1,10);
  solve;
end.