Отсев Опции

[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

[Tauka]

Вроде бы так :о) , домучала (но будет интересно при каких комбинациях оно идет неправильно не считая -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]

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

Код

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]

Ivs:
Всё супер, только - последовательность  возрастающая, поэтому в "ответе" не должно быть повторяющихся элементов.
Дополнительный массив использовать можно  :)

[Ivs]

Ivs:
Всё супер, только - последовательность  возрастающая, поэтому в "ответе" не должно быть повторяющихся элементов.
Дополнительный массив использовать можно  :)

Исправил.

[___ALex___]

чё вы тут делаете?

[zx1024]

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

Код

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 - возр. посл-ть из исходного массива.

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

[AlaRic]

zx1024: может t:=A[1]  ;)

[zx1024]

Точно!!!