Автор: Tauka 22.08.2003 1:24
Удалить в заданном массиве Х(n) "лишние" (кроме первого) элементы так, чтобы оставшиеся образовали возрастающую последовательность.(за 1 просмотр массива)
что-то вроде бы сделала, но всё равно находятся такие комбинации, для которых условие не исполняется.
На всякий случай, здесь моя "попытка":
Код
Program otsew;
uses crt;
var n:integer;
X,Y:array [1..1000] of integer;
t:integer;
procedure vvid;
var i:byte;
Begin
clrscr;
Write ('n= ');
Readln (n);
Writeln ('wwesty x[i]');
for i:=1 to n do
begin
write ('x[',i,'] ');
readln (x[i]);
end;
End;
procedure vidbir;
var i,j:byte;
t:integer;
Begin
t:=0;
for i:=2 to n do
begin
y[i]:=-10000;
Y[1]:=X[1];
if X[i]>X[i-1] then if X[i]>t then
begin
t:=X[i];
Y[i]:=X[i];
end;
end;
End;
procedure vyvid;
var i:byte;
Begin
Writeln ('Zrostayucha poslidownisty z cyh elementiw:');
for i:=1 to n do
begin
if (y[i]<>y[i+1]) and (y[i]<>y[i-1]) then
if y[i]<>-10000 then begin
Write ('X[',i,']= ');
Writeln (Y[i]);
end;
end;
End;
BEGIN
CLRSCR;
vvid;
vidbir;
vyvid;
READLN;
END.
Спасибочки за внимание. :о)
Автор: Tauka 22.08.2003 20:09
Вроде бы так :о) , домучала (но будет интересно при каких комбинациях оно идет неправильно не считая -10000 и то, что превышает integer)
Код
Program otsew;
uses crt;
var n:integer;
X,Y:array [1..1000] of integer;
t:integer;
procedure vvid;
var i:byte;
Begin
clrscr;
Write ('n= ');
Readln (n);
Writeln ('wwesty x[i]');
for i:=1 to n do
begin
write ('x[',i,'] ');
readln (x[i]);
end;
End;
procedure vidbir;
var i,j:byte;
t:integer;
Begin
t:=-10000;
for i:=1 to n do
begin
y[i+1]:=-10000;
Y[1]:=X[1];
if (X[i+1]>X[i]) and (X[i+1]>X[1]) then if X[i+1]>t then
begin
t:=X[i+1];
Y[i+1]:=X[i+1];
end;
end;
End;
procedure vyvid;
var i:byte;
Begin
Writeln ('Zrostayucha poslidownisty z cyh elementiw:');
Writeln ('X[1]= ',y[1]);
for i:=2 to n do
begin
if (y[i]<>y[i+1]) and (y[i]<>y[i-1]) then
if y[i]<>-10000 then
begin
Write ('X[',i,']= ');
Writeln (Y[i]);
end;
end;
End;
BEGIN
CLRSCR;
vvid;
vidbir;
vyvid;
READLN;
END.
Автор: Ivs 23.08.2003 0:21
Конечно хотелось бы уточнить немного условие задачи, например можно ли использовать дополнительный массив, но вобшем у меня получилось так, (без доп массива), если несложно посмотри, ну или протести.
Код
Program Posled;
Const
N = 100;
Var
A : Array [1..N] of Integer;
i : Integer;
k : Integer;
Procedure SdvigArray;
Var
j : Integer;
Begin
for j := i to k do A[j] := A[j+1];
End;
Begin
Randomize;
k := N;
for i := 1 to N do
begin
A[i] := Random(1000) + 1;
Write(A[i], ' ');
end;
i := 2;
while i <= k do
begin
if A[i] <= A[i-1] then {!!!!!!!!!!!!!!!!!}
begin
k := k - 1;
SdvigArray;
i := i - 1;
end;
i := i + 1;
end;
WriteLn;
for i := 1 to k do Write(A[i], ' ');
ReadLn;
End.
Автор: Tauka 26.08.2003 10:42
Ivs:
Всё супер, только - последовательность возрастающая, поэтому в "ответе" не должно быть повторяющихся элементов.
Дополнительный массив использовать можно :)
Автор: Ivs 27.08.2003 2:23
Цитата
Ivs:
Всё супер, только - последовательность возрастающая, поэтому в "ответе" не должно быть повторяющихся элементов.
Дополнительный массив использовать можно :)
Исправил.
Автор: zx1024 28.08.2003 20:39
Как я понял, искать посл-ть макс. длины не нужно.
Привожу пример без использования доп. массива.
Код
t := A[i];
j := 1;
for i := 2 to n do
begin
if A[i] > t then
begin
inc(j);
t := A[i];
A[j] := t
end
end;
n := j;
На выходе тот же массив, где все элементы до j - возр. посл-ть из исходного массива.