Помощь - Поиск - Пользователи - Календарь
Полная версия: задача на целочисленное вычисление
Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи
virt
Задача A. Все на выборы!
Ограничение времени: 1 сек.
Входной файл: input.txt
Выходной файл output.txt

Совсем недавно в стране Электорляндии проходили выборы президента, и произошла удивительная вещь: все избиратели пришли на выборы, и не один не проголосовал против всех! Избирательная комиссия пригласила вас для помощи при предварительном подсчете голосов. Известно, что на выборах было N кандидатов. Требуется написать программу, подсчитывающую, сколько процентов голосов получил каждый кандидат; причем числа, которые выдает ваша программа, должны удовлетворять следующим условиям:
1. Общая сумма всех чисел должна быть равна 100%
2. Каждое число должно быть целым и равняться реальному результату, округленному либо в большую, либо в меньшую сторону.

Формат входного файла
В первой строке записано натуральное число N (1<=N<=10000) – количество кандидатов. Вторая строка содержит последовательность целых чисел A1, A2,..., AN; Ai – количество голосов, отданное i-му кандидату (0<=Ai<=10000). Числа разделены одним или несколькими пробелами.

Формат выходного файла
В выходной файл запишите последовательность чисел, описанную в условии. Числа следует разделять пробелами. Если решения не существует, выведите “No solution”. Если решений несколько, выведите любое из них.

Примеры
Код
  Входной файл           Выходной файл
|-----------------------------------------|
|2                  |                     |
|10 10              |   50 50             |
|-----------------------------------------|
|3                  |                     |
|1 1 198            |  0 1 99             |
|-----------------------------------------|



решайте кто ,хочет.
решения можете прислать сюды : dan_net@mail.ru
у меня есть тесты к этой задаче ,посмотрим кто на сколько решит .

ЗЫ : вам надоело сортировать массивы по убыванию ,тогда эта задача для васsmile.gif
А правила раздела для кого?


результаты :
максимум -- 15 баллов
Код
--------------------------------------
|BlackShadow        |     15 баллов   |
|trminator          |     9 баллов    |
|Oleg_Z             |     2 балла     |
|Денис               |     2 балла     |
--------------------------------------

Altair
Название темы исправил ... вечером порешаю... действительно интересная.
BlackShadow
Прикольно. Надо будет посмотреть.
virt
уже 2 дня и 5 часов прошло smile.gif и 40 просмотров ,а никто так и не прислалsad.gif
Altair
Я за 20 минут сделал:
Код
Program VIBORI;
Var
FI,FO   : TEXT; {входной и выходной файлы соответсвенно}
KK      : Word; {число кандидатов}
KG,summ : longint; {10000*10000 = 10^8 - longint}
KPZK    : WORD; {Количество Проголосовавших За данного Кандидата}

begin
Assign(FI,'input.txt');
Assign(FO,'output.txt');
Reset(FI); Rewrite(FO);
Readln(FI,KK);
{определим сумму всех голосов}
While not EOF(FI) do begin read(FI,KG); INC(KPZK); INC(summ,KG) end;
{количестов определили}
IF KK<>KPZK then begin writeln(FO,'No solution'); CLOSE(FO); CLOSE(FI); HALT end;
close(FI); reset(FI); readln(FI,KK);
While not EOF(FI) do
begin
 read(FI,KG);
 write(FO,' ');write(FO,TRUNC((KG*100)/SUMM))
end;
close(FO); close(FI);
end.

Вот и все. я только не понимаю, зачем ограничение повремени? Ведь это напрямую
от машины зависит! + можно прогу оптимизировать, переписать часть кода на асм.
Ну если что не то, сразу не ругайте :)


И не надо будет смеятся, если что не то. Может что и не учел...
virt
я забыл указать правила :

1)никаких юнитов т.е. недолжно быть секции
Код
uses ...;


2)никакого асма т.е. недолжно быть секции
Код
asm
  ...
end;
и инлайна т.е.
Код
inline(...);


3)должну использоваться только 2 файла : input.txt и output.txt

4)все программы тестируются на одном и том-же компе или на компах с одинаковой конфигурацией (т.к. например поиск пути в графе можно написать за O(n^3) -- алгоритм Флойда (он легче в написании) и за O(n^2) -- алгоритм Дейкстры (он сложнее в написании и дольше в написании ,зато быстрее работант) ,а можно Дейкстру за O(n*logn) написать ,еще сложнее ,зато и быстрее). Тесты строятся таким образом что самый простой и медленный алгоритм наберет не полное количествово баллов.

ЗЫ
эти правила придумал не я. Это общепринятые правила проведения олимпиад по программированию.
virt
при нарушении правил задача снимается с тестирования т.е. участник получает за неё 0 баллов независимо от того сколько она реально тестов пройдет.
Altair
Ладно, ладно, у меня все по правилам, что я правила олимпиад не знаю smile.gif
virt
to all :
пока только Oleg_Z прислал решение ,а где же остальные?
что правил испугались?
BlackShadow
Не дебажа могу сказать, что у Oleg_Z есть ошибка:
3
1 1 1
У него должно выдать
33 33 33
Что в сумме не даёт 100.
Можно попробыать так (пишу без компилятора, так что возможны описки, но не логические ошибки!):
Код

Type
 PData=^TData;
 TData=Array[1..10000] Of Real;

Var
 Data:PData;
 Sum:LongInt;
 i,n,k:Integer;

Function Test:Boolean;
Var
 i,s:Integer;
Begin
 s:=0;
 For i:=1 To n Do
   s:=s+Trunc(Data^[i]);
 Test:=s=100
End;

Begin
 Assign(Input,'Input.Txt');
 Reset(Input);
 Assign(Output,'Output.Txt');
 ReWrite(Output);
 New(Data);
 ReadLn(n);
 Sum:=0;
 For i:=1 To n Do
 Begin
   Read(k);
   Inc(Sum,k);
   Data^[i]:=k
 End;
 For i:=1 To n Do
   Data^[i]:=Data^[i]/Sum;
 i:=0;
 While Not Test Do
   While True Do
   Begin
     Inc(i);
     If Data^[i]>Trunc(Data^[i]) Then
     Begin
       Data^[i]:=Data^[i]+1;
       Break
     End
   End;
 For i:=1 To Count Do
   Write(Trunc(Data^[i]),' ');
 Dispose(Data)
End.

Те же 20 минут smile.gif

Отредактировано: забыл Dispose вписать...
Altair
Цитата
Не дебажа могу сказать, что у Oleg_Z есть ошибка

Ладно, ладно, на олимпиаде уже не упел бы ты :D
virt
BlackShadow
не понял логики твоей проги ,поэтому никак не пойму отчего возникает ошибка.
только один тест из 8
BlackShadow
Ща подправлю...
BlackShadow
Блин, тупильник голова-жопа заело в положении "жопа" smile.gif Забыл на 100 умножить при работе с процентами.
Код

Type
PData=^TData;
TData=Array[1..10000] Of Real;

Var
Data:PData;
Sum:LongInt;
i,n,k:Integer;

Function Test:Boolean;
Var
i,s:Integer;
Begin
s:=0;
For i:=1 To n Do
  s:=s+Trunc(Data^[i]);
Test:=s=100
End;

Begin
Assign(Input,'Input.Txt');
Reset(Input);
Assign(Output,'Output.Txt');
ReWrite(Output);
New(Data);
ReadLn(n);
Sum:=0;
For i:=1 To n Do
Begin
  Read(k);
  Inc(Sum,k);
  Data^[i]:=k
End;
For i:=1 To n Do
  Data^[i]:=Data^[i]/Sum*100;
i:=0;
While Not Test Do
  While True Do
  Begin
    Inc(i);
    If Data^[i]>Trunc(Data^[i]) Then
    Begin
      Data^[i]:=Data^[i]+1;
      Break
    End
  End;
For i:=1 To n Do
  Write(Trunc(Data^[i]),' ');
Dispose(Data)
End.
trminator
Вот. За _эту_ сортировку не пинайте :p2:
Код

program putinka;
const maxn = 10000 + 1;
var n, i, total, ngol : integer;
   want : array[1..maxn] of record
                               c : real;
                               n : integer
                            end;
   get  : array[1..maxn] of integer;
procedure swap1(var a, b : real);
var t : real;
begin
   t := a; a := b; b := t
end;

procedure swap2(var a, b : integer);
var t : integer;
begin
   t := a; a := b; b := t
end;

{ сортирует want }
procedure sort;
var i, j, t : integer;
begin
   for i := 1 to n do
       for j := i to n do
       if want[i].c < want[j].c then
       begin
           swap1(want[i].c, want[j].c);
           swap2(want[i].n, want[j].n)
       end;
end;

begin
   assign(input,'input.txt'); assign(output,'output.txt');
   reset(input); rewrite(output);
   readLn(n);
   total := 100; ngol := 0;

   for i := 1 to n do
   begin
       read(want[i].c);
       inc(ngol, trunc(want[i].c));
       want[i].n := i;
   end;

   for i := 1 to n do
   begin
       want[i].c := want[i].c / ngol * 100;
       get[i] := trunc(want[i].c);
       want[i].c := want[i].c - get[i];
       dec(total, get[i])
   end;

   sort;
   i := 1;

   while total > 0 do
   begin
       inc(get[want[i].n]);

       dec(total);
       inc(i); if i > n then i := 1;
   end;

   for i := 1 to n do
       write(get[i],' ');
end.

Как минимум пару тестов пройти должно... правда, по времени не пройдет наверное... если не пройдет -- завтра нормальную sort поставлю, пирамидку, например
virt
BlackShadow
поздравляю ,у тебе максимум!!!
virt
trminator
у меня пень 4 2400 ,так что за время не беспокойсяsmile.gif ,размести свои записи динамически ,и будет 15 баллов.
trminator
Какое динамически? Сортировка пузырьком на динамических записях... мсье знает толк в извращениях :D Или там в память не влазит? unsure.gif

А вообще надо бы под рукой иметь какой-нибудь 386... для тестирования smile.gif а то я, например, уже расслабляться начал, не оптимизирую ничего, пузырики вон пошли...
Altair
Если впроге есть сортировка, то надо делать "быструю"
trminator
Не согласен. Сейчас объясню в теме про оптимизацию
virt
trminator
твой массив записей занимает больше одного сегмента.
я поставил заместо 1..10000+1 >> 1..6300+1 ,тогда поместилось.

а сортировку ,если уж писать то :
1)карманныю >> много памяти ,зато за линейное времяsmile.gif
2)пирамидальную >> и памяти немного ,и самая быстрая ,на всех данных работает за O(n*logn) ?а быстрая на некоторых наборах работает за O(n^2)
BlackShadow
virt, приятно вспомнить детство. Олимпиады я забросил уж лет как 7-8
trminator, RESPECT. Сюда ещё и сортировку умудриться всунуть... Не каждый бы собразил smile.gif
trminator
Вот блин... все-таки не влезает... м-да. А какое там ограничение по памяти? =) (На современных олимпиадах испольуются 32-битные компилеры, и память ограничивают искусственно, типа 1 метра)
virt
trminator
на этой задаче 640 килобайт ,и 16 битный компилерsmile.gif
на всех остальных буду компилить на freepascal/
BlackShadow
Так что решения прислано всего 3?
virt
BlackShadow
нет ,уже 4!:)
BlackShadow
virt, сам что ли написал чего smile.gif
А когда результаты, тесты и т. д. ?
virt
BlackShadow
Нет сам не писал ,денис -- такой юзер есть.
Я вот думаю дать еще немного времени ,пусть хоть кто еще решит ,а потом все решения и тесты в архив скину и прикреплю к первому сообщению.
Altair
Вообще, надо было было мне сказать сразу, что это соревнование 2
Тогда бы народу больше было бы!
trminator
А что, еще не кончилось соревнование-то? Может, и допишу для динамического массива... если успею smile.gif
virt
trminator
успеешь-успеешь ,я думая ,до 5 числа еще можно присылать ,потом выложу тесты.

ЗЫ
И новую задачу. Так что готовьтесь.
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.