IPB
ЛогинПароль:

> Прочтите прежде чем задавать вопрос!

1. Заголовок темы должен быть информативным. В противном случае тема удаляется ...
2. Все тексты программ должны помещаться в теги [code=pas] ... [/code], либо быть опубликованы на нашем PasteBin в режиме вечного хранения.
3. Прежде чем задавать вопрос, см. "FAQ", если там не нашли ответа, воспользуйтесь ПОИСКОМ, возможно такую задачу уже решали!
4. Не предлагайте свои решения на других языках, кроме Паскаля (исключение - только с согласия модератора).
5. НЕ используйте форум для личного общения, все что не относится к обсуждению темы - на PM!
6. Одна тема - один вопрос (задача)
7. Проверяйте программы перед тем, как разместить их на форуме!!!
8. Спрашивайте и отвечайте четко и по существу!!!

2 страниц V  1 2 >  
 Ответить  Открыть новую тему 
> задача на целочисленное вычисление, интересная задачка
сообщение
Сообщение #1


Знаток
****

Группа: Пользователи
Сообщений: 419
Пол: Мужской

Репутация: -  6  +


Задача 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 балла     |
--------------------------------------



Сообщение отредактировано: virt -


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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

Сообщение отредактировано: Oleg_Z -


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


Гость






Прикольно. Надо будет посмотреть.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Знаток
****

Группа: Пользователи
Сообщений: 419
Пол: Мужской

Репутация: -  6  +


уже 2 дня и 5 часов прошло smile.gif и 40 просмотров ,а никто так и не прислалsad.gif

Сообщение отредактировано: virt -


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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

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


И не надо будет смеятся, если что не то. Может что и не учел...


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6


Знаток
****

Группа: Пользователи
Сообщений: 419
Пол: Мужской

Репутация: -  6  +


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

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


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


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

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

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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


Знаток
****

Группа: Пользователи
Сообщений: 419
Пол: Мужской

Репутация: -  6  +


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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #8


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #9


Знаток
****

Группа: Пользователи
Сообщений: 419
Пол: Мужской

Репутация: -  6  +


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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #10


Гость






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

Сообщение отредактировано: BlackShadow -
 К началу страницы 
+ Ответить 
сообщение
Сообщение #11


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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

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


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #12


Знаток
****

Группа: Пользователи
Сообщений: 419
Пол: Мужской

Репутация: -  6  +


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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #13


Гость






Ща подправлю...
 К началу страницы 
+ Ответить 
сообщение
Сообщение #14


Гость






Блин, тупильник голова-жопа заело в положении "жопа" 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.
 К началу страницы 
+ Ответить 
сообщение
Сообщение #15


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


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


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #16


Знаток
****

Группа: Пользователи
Сообщений: 419
Пол: Мужской

Репутация: -  6  +


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


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #17


Знаток
****

Группа: Пользователи
Сообщений: 419
Пол: Мужской

Репутация: -  6  +


trminator
у меня пень 4 2400 ,так что за время не беспокойсяsmile.gif ,размести свои записи динамически ,и будет 15 баллов.


--------------------
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #18


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


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

А вообще надо бы под рукой иметь какой-нибудь 386... для тестирования smile.gif а то я, например, уже расслабляться начал, не оптимизирую ничего, пузырики вон пошли...


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #19


Ищущий истину
******

Группа: Пользователи
Сообщений: 4 825
Пол: Мужской
Реальное имя: Олег

Репутация: -  45  +


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


--------------------
Помогая друг другу, мы справимся с любыми трудностями!
"Не опускать крылья!" (С)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #20


Четыре квадратика
****

Группа: Пользователи
Сообщений: 579
Пол: Мужской

Репутация: -  4  +


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


--------------------
Закон добровольного труда Зимерги:
Люди всегда согласны сделать работу, когда необходимость в этом уже отпала
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

2 страниц V  1 2 >
 Ответить  Открыть новую тему 
1 чел. читают эту тему (гостей: 1, скрытых пользователей: 0)
Пользователей: 0

 





- Текстовая версия 1.11.2020 3:22
500Gb HDD, 6Gb RAM, 2 Cores, 7 EUR в месяц — такие хостинги правда бывают
Связь с администрацией: bu_gen в домене octagram.name