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

Обсуждение задачи 1007. Кодовые слова

Hey anybody help me with problem 1007, auuuuu!!!!!
Послано CELO 5 окт 2005 00:19
here listed my source code:
please check it for me
thnx

---------
program Project2;
var n,j,i,sum,d:integer;
    a:Array[1..1000] of string;
    st:string;
begin
    readln(n);
    for i:=1 to n do readln(a[i]);
    for i:=1 to n do
    if length(a[i])=n then
    begin
        sum:=0;
        for j:=1 to n do
            if a[i][j]='1' then sum:=sum+j;
        d:=sum mod (n+1);
        if d<>0 then a[i][d]:='0';
        writeln(a[i]);
    end
    else if length(a[i])=n+1 then
    begin
        for d:=1 to n+1 do
        begin
        sum:=0;
        st:=a[i];
        delete(st,d,1);
        for j:=1 to n do
            if st[j]='1' then sum:=sum+j;
        if (sum mod (n+1)=0) then break;
        end;
        writeln(st);
    end
    else
    begin
        for d:=1 to n do
        begin
        sum:=0;
        st:=a[i];
        insert('0',st,d);
        for j:=1 to n do
            if st[j]='1' then sum:=sum+j;
        if (sum mod (n+1)=0) then break
        else
            if ((sum+d) mod (n+1)=0) then
            begin
                st[d]:='1';
                break;
            end;
        end;
        writeln(st);
    end;
end.