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

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

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

 
 Ответить  Открыть новую тему 
> Четные - нечетные последовательности
сообщение
Сообщение #1


Бывалый
***

Группа: Пользователи
Сообщений: 209

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


Входной файл: INPUT.TXT
Выходной файл: OUTPUT.TXT
[Задание:
Пусть задана последовательность из n (n Ј 100) целых чисел {a1, a2, ..., an} (1 Ј ai Ј 100), которая содержит m четных чисел и l - нечетных (m + l = n). Требуется получить последовательность из k пар (k = min(m, l)) {(x1, y1), (x2, y2), ..., (xk, yk)}, где x1, x2, ..., xk - взятые в порядке следования первые k четных членов последовательности {a1, a2, ..., an}, а y1, y2, ..., yk - взятые в порядке следования первые k нечетных членов последовательности {a1, a2, ..., an}.
Формат входных данных:
Входной файл INPUT.TXT состоит из двух строк. В первой строке содержится натуральное число n - длина последовательности. Во второй - идут целые числа a1, a2, ..., an, разделенные пробелами. Пример:
10
98 56 33 73 41 8 48 93 52 80
Формат выходных данных:
Выходной файл OUTPUT.TXT должен содержать последовательность {(x1, y1), (x2, y2), ..., (xk, yk)}, расположенную в одной строке файла, числа должны быть разделены пробелами. Если исходная последовательность не содержит ни одного четного или ни одного нечетного члена, т.е. k = 0, то в файл необходимо вывести цифру 0 (нуль).
Пример:
98 33 56 73 8 41 48 93


--------------------
Если вы хотите чаще встречаться с понравившейся девушкой установите ей Windows'95
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #2


Бывалый
***

Группа: Пользователи
Сообщений: 209

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


Ну что неужели такая сложная задача ??? (гор.олимп) I уровень....
Ответ опубликую попозже (может кто и решит....),
задачка-то легкая.... :'(


--------------------
Если вы хотите чаще встречаться с понравившейся девушкой установите ей Windows'95
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3


...
*****

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

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


Дай время...его как раз и не хватает sad.gif
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4





Группа: Пользователи
Сообщений: 9

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


1 вариант, по условию:

Program Posled2;
Var
l, m, n, i : byte;
FIn, FOut : text;
Num : array[1..100] of byte;
Begin
assign(FIn,'input.txt');
assign(FOut,'output.txt');
reset(FIn);
rewrite(FOut);
l := 0; {chet}
m := 0; {nechet}
readln(FIn,n);
for i := 1 to n do begin
read(FIn,Num[i]);
if Num[i] mod 2 = 0 then
inc(l)
else
inc(m);
end;
if (l=0) or (m=0) then
write(FOut,0)
else
if l > m then
for l := 1 to m do begin
i := 1;
while (Num[i] mod 2 <> 0) or (Num[i]=100) do
inc(i);
write(FOut,Num[i], ' ');
Num[i] := 100;
i := 1;
while Num[i] mod 2 <> 1 do
inc(i);
write(FOut,Num[i], ' ');
Num[i] := 100;
end else
for i := m to l do begin
i := 1;
while (Num[i] mod 2 <> 0) or (Num[i]=100) do
inc(i);
write(FOut,Num[i], ' ');
Num[i] := 100;
i := 1;
while Num[i] mod 2 <> 1 do
inc(i);
write(FOut,Num[i], ' ');
Num[i] := 100;
end;
close(FIn);
close(FOut);
End.



2 вариант: n может быть больше, оно не указывается.

Program Posled1;
Var
FIn, FOut, Fl, Fm : text;
l, m : longint;
Num : integer;
Begin
assign(FIn,'input.txt');
assign(FOut,'output.txt');
assign(Fl,'l.txt');
assign(Fm,'m.txt');
reset(FIn);
rewrite(FOut);
rewrite(Fl);
rewrite(Fm);
readln(FIn,m);
l := 0; {chet}
m := 0; {nechet}
while not(Eof(FIn)) do begin
read(FIn,Num);
if Num mod 2 = 0 then begin
inc(l);
write(Fl,Num, ' ');
end else
begin
inc(m);
write(Fm,Num, ' ');
end;
end;
close(Fl);
close(Fm);
reset(Fl);
reset(Fm);
if (l=0) or (m=0) then
write(FOut,0)
else
if l > m then
for l := 1 to m do begin
read(Fl,Num);
write(FOut,Num, ' ');
read(Fm,Num);
write(FOut,Num, ' ');
end else
for m := 1 to l do begin
read(Fl,Num);
write(FOut,Num, ' ');
read(Fm,Num);
write(FOut,Num, ' ');
end;
close(Fl);
close(Fm);
close(FIn);
close(FOut);
End.



--------------------
"Разум есть оружее лени, лишь умный человек может позволить себе быть ленивым" (Я)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5


Бывалый
***

Группа: Пользователи
Сообщений: 209

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


В первой проге у тебя есть маленькая ошибка: если, например, нечетных чисел больше то у тебя не будет выполняться цикл for i:=m to l do, а вторая классно зделана не придерешся, а вот мой вариант:

program Posled_CHET_NECHET;
var
f1,f2:text;
i,r,g,f,j,n:integer;
b,a:array[1..100] of byte;
begin
assign(f1,'input.txt');
assign(f2,'output.txt');
reset(f1);
rewrite(f2);
readln(f1,n);
for i:=1 to n do read(f1,a[i]);
r:=1;i:=1;
while i<=n do
begin
if a[i] mod 2=0 then
begin
b[r]:=a[i];
r:=r+2;
end;
i:=i+1;
end;
g:=r-2;
r:=2;i:=1;
while n>=i do
begin
if odd(a[i]) then
begin
b[r]:=a[i];
r:=r+2;
end;
i:=i+1;
end;
f:=r-2;
if (g=-1) or (f=0) then write(f2,'0') else
begin
if f>=g then j:=g+1 else j:=f;
for i:=1 to j do write(f2,b[i],' ');
end;
close(f1);
close(f2);
end.


Я здесь использую дополнительный массив который заполняю сначала четными, а затем нечетными числами, ну а потом вывожу в файл то что надо.


--------------------
Если вы хотите чаще встречаться с понравившейся девушкой установите ей Windows'95
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #6





Группа: Пользователи
Сообщений: 9

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


В первой проге у тебя есть маленькая ошибка: если, например, нечетных чисел больше то у тебя не будет выполняться цикл for i:=m to l do, а вторая классно зделана не придерешся, а вот мой вариант:

это просто опечатка smile.gif  for m := 1 to l и усё!
Спасибо за задачку ;)


--------------------
"Разум есть оружее лени, лишь умный человек может позволить себе быть ленивым" (Я)
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #7


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

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

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


Похоже, я с ответом запоздал немного... на месячишко-полтора smile.gif но вот мое решение(короткое, но исп. ДВА доп. массива, что при таких ограничениях на их длины не фатально).

program Ivs_question;
var A, B, given: array[1..100] of Byte;
i, n, k1, k2, k: byte;
input, output: text;

function min(a,b: byte): byte;
begin if a < b then min:=a else min:=b end;

procedure init_vars;
begin k1:=1; k2:=1; k:=1;
assign(input,'input.txt');reset(input);
assign(output,'output.txt'); rewrite(output) end;

begin init_vars;
ReadLn(N);
for i:=1 to N do Read(input,given[i]);

for i:=1 to N do
if given[i] mod 2 = 1 then begin
A[k1]:=given[i]; inc(k1) end
else begin
B[k2]:=given[i]; inc(k2) end;
k:=min(k1, k2)-1;
if k=0 then Write(output,k) else
for i:=1 to k do Write(output,B[i],' ',A[i],' ');
close(input); close(output)
END.


В Паскале чуть-чуть не влезает на один экран(25 строк) ;)

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


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

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

 





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