Версия для печати темы

Нажмите сюда для просмотра этой темы в обычном формате

Форум «Всё о Паскале» _ Задачи _ Одномер. (Pascal)

Автор: xxBOBAHxx 27.10.2008 1:57

№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. Там где стоит знак ? нужно дополнить.....ну я так думаю.....

Автор: мисс_граффити 27.10.2008 3:56

Правила (необходимость использования тега code и одна тема - одна задача) принципиально игнорируешь?
Исправляй...

Автор: volvo 27.10.2008 20:08

Цитата
МОИ мысли по этой задаче:
Ты сначала условие-то уточни: все серии должны иметь одинаковую длину, или может быть так
1 2 0 3 -1 2 3 0 6 3 0 7 3 3 3 3
? Если нет, то решение элементарное, если да - то сложнее...

Автор: xxBOBAHxx 28.10.2008 23:50

УТОЧНЯЮ: серии могут быть разной длины


Автор: volvo 29.10.2008 2:38

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

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.
Над отсутствующими функциями подумай сам, что получится - выкладывай... Давать тебе полное решение без усилий с твоей стороны я не собираюсь...