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

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

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

 
 Ответить  Открыть новую тему 
> одномерный массив
сообщение
Сообщение #1





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

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


Помогите пожалуйста со следующей задачей: Разделить одномерный массив на 3 части, которые по возможности имеют минимальное расхождение сумм. Например: исходный массив - 1 2 3 4 5 6, полученые массивы - 6 1, 5 2, 3 4. Необязательно чтоб в полученном массиве было одинаковое количество чисел. Я пробывал что-то сделать но ответ выводится неправильно. Не понял только как сделать так чтобы выводились 3 массива которые бы включали все введенные числа.
uses crt;
var
a,b:array[1..100] of integer;
n:byte;
sym:integer;sum,k:real;
f:boolean;
i,j,h,s,rab:integer;
begin
{Vvodim vse podryat}
clrscr;
Writeln('Vvedite kolichestvo elimentov massiva<=100');
Readln(n);
for i:=1 to n do
begin
writeln(i,' :eliment');
readln(a[i]);
end;
{sortirovka elementov}
begin
for j:=1 to n-1 do
for i:=1 to n-1 do
if a[i]>a[i+1] then begin
rab:=a[i];
a[i]:=a[i+1];
a[i+1]:=rab;
end;
end;
sym:=0;
for i:=1 to n do
sym:=sym+a[i];
sum:=sym/3;
{Nachinaetsya glavniji cikl
idem sverhu v niz}
for i:=n downto 1 do
begin
s:=1;
b[1]:=a[i];
repeat
h:=1;
k:=sum-a[i]; {vichitaem naibol'shiji eliment podposledovatel'nosti
i nachinaem proveryat' so sledueshigo}
if k=0 then begin write(a[i]);break;end {dobavil proverku pered
ciklom}
else
begin
for j:=i-s downto 1 do
begin
if k<a[j] then continue else {esli eliment bol'she k, to
idem k sleduushimu}
begin
k:=k-a[j];
inc(h);b[h]:=a[j]; {sohronyaem na vsyakji sluchaji}
if k=0 then break; {esli k=0 vihodim iz cikla}
end;
end;
if k=0 then {proviryam esli k=0, to raspichativaem
posledovatel'nost', esli net
to posledovatel'nosti s dannim
naibol'shim chlenom izchrponi, perehodim k
sleduushimu}
begin
writeln;
for j:=1 to h do write(b[j],' ');f:=true;inc(s);
end else f:=false;
end; {konec dobavki}
until not f;
end;
repeat until keypressed;
end.

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


Perl. Just code it!
******

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

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


разделение одномерного массива

Хотя нет, там немного другое условие дробления ...

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


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #3





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

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


По той ссылке задача решена но немножко не так. При том массиве что там в программе( 12345 ) в ответе выводится 1->1,2->2,3->5. а по программе должно выводится 5 14 23
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #4


Perl. Just code it!
******

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

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


Цитата
По той ссылке задача решена но немножко не так


Там все решено _так_ просто условие задачи там отличается от твоего, там надо было разбить исходный массив на 3 блока, не перемещая его элементы.


--------------------
perl -e 'print for (map{chr(hex)}("4861707079204E6577205965617221"=~/(.{2})/g)), "\n";'
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 
сообщение
Сообщение #5





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

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


Решил сам программу до конца. Выкладываю код. Возможно кому-то понадобится в будущем.
uses crt;
var a:array[1..100] of integer;
a1,a2,a3:array[1..34] of integer;
prom,n,prom_n:integer;
n1,n2,n3:integer;
sum,nn:real;
i,k,j,m:integer;
begin
clrscr;
write('vvedite kolichestvo elementov massiva(<=100):');
readln(n);
for i:=1 to n do
begin
write('vvedite',i,'element massiva:');
readln(a[i]);
end;
{-------------}
for i:=2 to n do
begin
for j:=1 to i-1 do
begin
if (a[i]>a[j]) then
begin
prom:=a[i];
for k:=i-1 downto j do a[k+1]:=a[k];
a[j]:=prom;
end;
end;
end;
{sum:=0;
for i:1 to n do sum:=sum+a[i];
sum:=sum/3;}
nn:=n/3;
if (frac(nn)=0) then
begin
prom_n:=trunc(nn);
if((prom_n mod 2)=0) then
begin
n1:=trunc(prom_n/2);
n2:=trunc(prom_n/2);
{first array}
j:=1;
for i:=1 to n1 do
begin
a1[j]:=a[i];
j:=j+1;
a1[j]:=a[n-i+1];
j:=j+1;
end;
{second array}
j:=1;
for i:=n1+1 to n1+n2 do
begin
a2[j]:=a[i];
j:=j+1;
a2[j]:=a[n-i+1];
j:=j+1;
end;
{third array}
j:=1;
for i:=n1+n2+1 to n-n1-n2 do
begin
a3[j]:=a[i];
j:=j+1;
end;
n1:=prom_n;
n2:=prom_n;
n3:=prom_n;
end
else
begin
n1:=trunc(prom_n/2)+1;
n2:=trunc(prom_n/2)+1;
{first array}
j:=1;
for i:=1 to n1 do
begin
if(i<n1) then
begin
a1[j]:=a[i];
j:=j+1;
a1[j]:=a[n-i+1];
j:=j+1;
end
else
begin
a1[j]:=a[n-i+1];
j:=j+1;
end;
end;
{second array}
j:=1;
for i:=n1 to n1+n2-1 do
begin
if(i<(n1+n2-1)) then
begin
a2[j]:=a[i];
j:=j+1;
a2[j]:=a[n-i];
j:=j+1;
end
else
begin
a2[j]:=a[n-i];
j:=j+1;
end;
end;
{third array}
j:=1;
for i:=n1+n2 to n-n1-n2+1 do
begin
a3[j]:=a[n-i];
j:=j+1;
end;
n1:=prom_n;
n2:=prom_n;
n3:=n-n1-n2;
end;
end
else
begin
prom_n:=trunc(nn)+1;
if ((prom_n mod 2)=0) then
begin
n1:=trunc(prom_n/2);
n2:=trunc(prom_n/2);
{first array}
j:=1;
for i:=1 to n1 do
begin
a1[j]:=a[i];
j:=j+1;
a1[j]:=a[n-i+1];
j:=j+1;
end;
{second array}
j:=1;
for i:=n1+1 to n1+n2 do
begin
a2[j]:=a[i];
j:=j+1;
a2[j]:=a[n-i+1];
j:=j+1;
end;
{third array}
j:=1;
for i:=n1+n2+1 to n-n1-n2 do
begin
a3[j]:=a[i];
j:=j+1;
end;
n1:=prom_n;
n2:=prom_n;
n3:=n-n1-n2;
end
else
begin
if ((nn-trunc(nn))>0.5) then
begin
n1:=trunc(prom_n/2)+1;
n2:=trunc(prom_n/2)+1;
{first array}
j:=1;
for i:=1 to n1 do
begin
if(i<n1) then
begin
a1[j]:=a[i];
j:=j+1;
a1[j]:=a[n-i+1];
j:=j+1;
end
else
begin
a1[j]:=a[n-i+1];
j:=j+1;
end;
end;
{second array}
j:=1;
for i:=n1 to n1+n2-1 do
begin
if(i<(n1+n2-1)) then
begin
a2[j]:=a[i];
j:=j+1;
a2[j]:=a[n-i];
j:=j+1;
end
else
begin
a2[j]:=a[n-i];
j:=j+1;
end;
end;
{third array}
j:=1;
for i:=n1+n2 to n-n1-n2+1 do
begin
a3[j]:=a[n-i];
j:=j+1;
end;
n1:=prom_n;
n2:=prom_n;
n3:=n-n1-n2;
end
else
begin
n1:=trunc(prom_n/2)+1;
n2:=trunc(prom_n/2);
{first array}
j:=1;
for i:=1 to n1 do
begin
if (i<n1) then
begin
a1[j]:=a[i];
j:=j+1;
a1[j]:=a[n-i+1];
j:=j+1;
end
else
begin
a1[j]:=a[n-i+1];
j:=j+1;
end;
end;
{second array}
j:=1;
for i:=n1 to n1+n2-1 do
begin
a2[j]:=a[i];
j:=j+1;
a2[j]:=a[n-i];
j:=j+1;
end;
{third array}
j:=1;
for i:=n1+n2 to n-n1-n2 do
begin
a3[j]:=a[i];
j:=j+1;
end;
n1:=prom_n;
n2:=prom_n-1;
n3:=n-n1-n2;
end;
end;
end;
write('first array:');
for i:=1 to n1 do
write(a1[i],' ');
writeln(' ');
write('second array:');
for i:=1 to n2 do
write(a2[i],' ');
writeln(' ');
write('third array:');
for i:=1 to n3 do
write(a3[i],' ');
readln;
end.
 Оффлайн  Профиль  PM 
 К началу страницы 
+ Ответить 

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

 





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