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

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

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

> Одномер. (Pascal)
сообщение
Сообщение #1


Новичок
*

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

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


№1.Создать массив целых чисел R[1..N], содержащий серии чисел, разделенных нулями. Отсортировать массив по возрастанию сумм чисел в сериях.

Т.е. например дан массив
1 2 3 0 -1 2 3 0 6 7 3 0 3 3 3
данный массив нужно преобразовать по возрастанию сумм в сериях , чтоб получилось следующее:
-1 2 3 0 1 2 3 0 3 3 3 0 6 7 3


МОИ мысли по этой задаче:

uses crt;
const n=20;
var nach:array[1..n+1] of integer;
a,s, g:array[1..n] of integer;
i, j, h, k, c,gh, l :integer;
priz:boolean;
begin clrscr;
randomize;
for i:=1 to n do
begin a[i]:=-5+random(10);
write(a[i], ' ');
end;
writeln;
i:=0; j:=0;
repeat
inc(j); s[j]:=0;
nach[j]:=i+1;
???????????
repeat
inc(i);
s[j]:=s[j]+a[i];
until (a[i]=0) or (n=i);
writeln(s[j], '=б㬬* ', j);
until n=i;
k:=j;
gh:=j;
repeat dec(k);
priz:=true;
for j:=1 to k do
if s[j]>s[j+1] then begin
c:=s[j];
s[j]:=s[j+1];
s[j+1]:=c;
l:=nach[j];
nach[j]:=nach[j+1];
nach[j+1]:=l;
priz:=false;
end;
until priz;
writeln;
for h:=1 to gh do
write(nach[h],' ');
readkey;
end.


p.s. Там где стоит знак ? нужно дополнить.....ну я так думаю.....

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


Гость






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

procedure sort_series(var arr: array of integer);

function get_serie(i: integer; var len: integer): integer;
begin
{ Функция №1: по номеру серии возвращает ее начало (как результат) и длину (Len) }
end;

function func(serie: integer): integer;
begin
{ Функция №2: по номеру серии с использованием get_serie вычисляет сумму эл-тов серии }
end;

{
Самое сложное в данном случае - по номерам серий менять их содержимое местами
Поскольку это действительно непросто, привожу реализацию этой процедуры, но
над остальными подумай сам...
}
procedure swap(first, second: integer);
var
start_1, start_2, L_1, L_2: integer;
buf: pointer;
begin
start_1 := get_serie(first, L_1);
start_2 := get_serie(second, L_2);
getmem(buf, (L_1 + 1)*sizeof(integer));

move(arr[start_1], buf^, (L_1 + 1)*sizeof(integer));
move(arr[start_2], arr[start_1], (L_2 + 1)*sizeof(integer));
move(buf^, arr[start_1 + L_2 + 1], (L_1 + 1)*sizeof(integer));

freemem(buf, (L_1 + 1)*sizeof(integer));
end;

function count_series: integer;
begin
{ Еще одна вспомогательная функция - считает количество серий в массиве }
end;

var
i, j, n: integer;
begin
{ Ну, а сама сортировка до боли напоминает "пузырек", правда? }
n := count_series;
for i := 1 to n do
for j := n downto i + 1 do begin
if func(j - 1) > func(j) then swap(j - 1, j);
end;
end;

const
n = 16;
arr: array[0 .. n - 1] of integer = (
3, -1, 2, 3, 0, 6, 3, 0, 1, 2, 0, 1, 1, 1, 1, 3
);

begin
{ ... }
sort_series(arr);
{ ... }
end.
Над отсутствующими функциями подумай сам, что получится - выкладывай... Давать тебе полное решение без усилий с твоей стороны я не собираюсь...
 К началу страницы 
+ Ответить 

Сообщений в этой теме


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

 





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