Отсев Опции

[Tauka]

Удалить в заданном массиве Х(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.

Спасибочки за внимание. :о)

Сообщение отредактировано: volvo - 17.12.2004 13:46

[Ivs]

Конечно хотелось бы уточнить немного условие задачи, например можно ли использовать дополнительный массив, но вобшем у меня получилось так, (без доп массива), если несложно посмотри, ну или протести.

Код

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.