Форум «Всё о Паскале» > задача на целочисленное вычисление

Помощь - Поиск - Пользователи - Календарь

Полная версия: задача на целочисленное вычисление

Форум «Всё о Паскале» > Pascal, Object Pascal > Задачи

virt

23.05.2004 21:26

Задача 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
у меня есть тесты к этой задаче ,посмотрим кто на сколько решит .

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

А правила раздела для кого?

результаты :
максимум -- 15 баллов

Код

Altair

25.05.2004 19:18

Название темы исправил ... вечером порешаю... действительно интересная.

BlackShadow

25.05.2004 19:33

Прикольно. Надо будет посмотреть.

virt

26.05.2004 1:07

уже 2 дня и 5 часов прошло

и 40 просмотров ,а никто так и не прислал

Altair

26.05.2004 3:28

Я за 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

26.05.2004 12:08

я забыл указать правила :

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

Код

uses ...;

2)никакого асма т.е. недолжно быть секции

Код

asm
...
end;

и инлайна т.е.

Код

inline(...);

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

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

ЗЫ
эти правила придумал не я. Это общепринятые правила проведения олимпиад по программированию.

virt

26.05.2004 12:10

при нарушении правил задача снимается с тестирования т.е. участник получает за неё 0 баллов независимо от того сколько она реально тестов пройдет.

Altair

26.05.2004 12:16

Ладно, ладно, у меня все по правилам, что я правила олимпиад не знаю

virt

27.05.2004 3:25

to all :
пока только Oleg_Z прислал решение ,а где же остальные?
что правил испугались?

BlackShadow

27.05.2004 17:16

Не дебажа могу сказать, что у 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 минут

Отредактировано: забыл Dispose вписать...

Altair

27.05.2004 22:31

Цитата

Не дебажа могу сказать, что у Oleg_Z есть ошибка

Ладно, ладно, на олимпиаде уже не упел бы ты :D

virt

27.05.2004 23:09

BlackShadow
не понял логики твоей проги ,поэтому никак не пойму отчего возникает ошибка.
только один тест из 8

BlackShadow

28.05.2004 1:37

Ща подправлю...

BlackShadow

28.05.2004 1:45

Блин, тупильник голова-жопа заело в положении "жопа"

Забыл на 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

28.05.2004 2:33

Вот. За _эту_ сортировку не пинайте :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

28.05.2004 2:37

BlackShadow
поздравляю ,у тебе максимум!!!

virt

28.05.2004 2:49

trminator
у меня пень 4 2400 ,так что за время не беспокойся

,размести свои записи динамически ,и будет 15 баллов.

trminator

28.05.2004 2:52

Какое динамически? Сортировка пузырьком на динамических записях... мсье знает толк в извращениях :D Или там в память не влазит?

А вообще надо бы под рукой иметь какой-нибудь 386... для тестирования

а то я, например, уже расслабляться начал, не оптимизирую ничего, пузырики вон пошли...

Altair

28.05.2004 2:58

Если впроге есть сортировка, то надо делать "быструю"

trminator

28.05.2004 2:59

Не согласен. Сейчас объясню в теме про оптимизацию

virt

28.05.2004 3:13

trminator
твой массив записей занимает больше одного сегмента.
я поставил заместо 1..10000+1 >> 1..6300+1 ,тогда поместилось.

а сортировку ,если уж писать то :
1)карманныю >> много памяти ,зато за линейное время

2)пирамидальную >> и памяти немного ,и самая быстрая ,на всех данных работает за O(n*logn) ?а быстрая на некоторых наборах работает за O(n^2)

BlackShadow

28.05.2004 16:28

virt, приятно вспомнить детство. Олимпиады я забросил уж лет как 7-8
trminator, RESPECT. Сюда ещё и сортировку умудриться всунуть... Не каждый бы собразил

trminator

29.05.2004 17:42

Вот блин... все-таки не влезает... м-да. А какое там ограничение по памяти? =) (На современных олимпиадах испольуются 32-битные компилеры, и память ограничивают искусственно, типа 1 метра)

virt

29.05.2004 23:45

trminator
на этой задаче 640 килобайт ,и 16 битный компилер

на всех остальных буду компилить на freepascal/

BlackShadow

31.05.2004 14:49

Так что решения прислано всего 3?

virt

31.05.2004 18:45

BlackShadow
нет ,уже 4!:)

BlackShadow

31.05.2004 19:07

virt, сам что ли написал чего

А когда результаты, тесты и т. д. ?

virt

31.05.2004 21:52

BlackShadow
Нет сам не писал ,денис -- такой юзер есть.
Я вот думаю дать еще немного времени ,пусть хоть кто еще решит ,а потом все решения и тесты в архив скину и прикреплю к первому сообщению.

Altair

31.05.2004 21:55

Вообще, надо было было мне сказать сразу, что это соревнование 2
Тогда бы народу больше было бы!

trminator

31.05.2004 23:05

А что, еще не кончилось соревнование-то? Может, и допишу для динамического массива... если успею

virt

1.06.2004 2:59

trminator
успеешь-успеешь ,я думая ,до 5 числа еще можно присылать ,потом выложу тесты.

ЗЫ
И новую задачу. Так что готовьтесь.

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