Комментарии: Решаем задачи Абрамян на Паскале. Array76

Автор: adfg

adfg — Tue, 19 Nov 2019 18:12:50 +0000

как то сложно у вас

program array76;

var a,b:array [1..10] of real; n:integer;

begin

readln (n);

for var i:=1 to n do read (a[i]);

if a[1]>a[2] then b[1]:=1;

for var i:=2 to n-1 do

begin

if (a[i]>a[i-1]) and (a[i]>a[i+1]) then b[i]:=i;

end;

if a[n]>a[n-1] then b[n]:=n;

for var i:=1 to n do

if b[i]<>0 then a[i]:=0;

print (a);

end.

Автор: Bronislav

Bronislav — Sat, 04 Aug 2018 15:39:19 +0000

То же, только одна вспомогательная переменная:

program array_76;//pascalABC.net

begin

var n := 10;

var a := Arr(9, 7, 6, 9, 5, 9, 0, 8, 9, 7); a.Println;

var temp := a[0];

if a[0] > a[1] then a[0] := 0;//проверяем первый элемент

for var i := 1 to n - 2 do

if (a[i] > temp) and (a[i] > a[i + 1]) then

begin

temp := a[i];

a[i] := 0

end

else temp := a[i];

if a[n - 1] > temp then a[n - 1] := 0;//проверяем последний элемент

a.Println//0 7 6 0 5 0 0 8 0 7

end.

Автор: Anton

Anton — Mon, 21 Mar 2016 03:47:19 +0000

В ответ на olegst1975. Первое решение идея такая же, как уже в размещённом, а вот второе, да ... интересное решение. добавил в шапку

Автор: olegst1975

olegst1975 — Sun, 20 Mar 2016 21:04:46 +0000

Приведу свои решения. Комменты писал для себя, но можно что-то почерпнуть. Интересен второй вариант. Опровергает утверждения из первого — обнулять максимум можно сразу , ведь в следующем сравнений ему не нужно участвовать, т.к. два максимума подряд быть не могут.

[crayon-694e811cd5e16241312482 inline="true" ]
********************array76-1*
{Дан массив размера N. Обнулить все его локальные максимумы (т. е. числа, большие своих соседей).}
var
  n,i,m,m1:integer;    
  a:array [1..10]of real;
begin{здесь проблема что сразу обнулять максимумы нельзя - они участвуют дальше в сравнениях} 
  readln(n);{поэтому будем использовать две переменные для хранения индексов максимумов}
  m:=0;//здесь будет индекс максимума уже для обнуления, пока равно 0,т.к. такого индекса нет
  m1:=0; //текущий индекс максимума, пока равно 0,т.к. такого индекса нет      
  for i:=1 to n do readln(a[i]);
  if a[1]>a[2] then m1:=1;//первый эл-т тоже может быть максимумом
  for i:=2 to n-1 do
    begin
      m:=m1;//переход индекса максимума с "текущей" m1 на переменную m "под удаление"
      if (a[i-1] <a[i])and(a[i]>a[i+1]) then m1:=i;//определение максимума и запись в "текущую" m1 его индекса
      if m<>0 then a[m]:=0;//обнуление максимума, m<>0 - условие что индекс существует      
    end;
  if a[n]>a[n-1] then m1:=n;//проверяем последнее число на максимум, естественно запись в m1
  a[m1]:=0;//обнуляем последний максимум     
  for i:=1 to n do writeln(a[i]);
end. 
************76-2*
var
  n,i,m,m1:integer;    
  a:array [1..10]of real;
begin 
  readln(n);
  for i:=1 to n do readln(a[i]);
  i:=1;  
  while i<=n do
    begin      
      if ((i=1)or(a[i-1]<a[i]))and((i=n)or(a[i]>a[i+1])) then
        begin
          a[i]:=0;
          inc(i);//здесь идея-после нахождения максимума, следующее число точно не максимум, пропускаем его, то есть увеличиваем i на 2(дважды на 1)
        end;
      inc(i);     
    end;
  for i:=1 to n do writeln(a[i]);
end.

[crayon-694e811cd5e16241312482 inline="true" ]

********************array76-1*

{Дан массив размера N. Обнулить все его локальные максимумы (т. е. числа, большие своих соседей).}

var

n,i,m,m1:integer;

a:array [1..10]of real;

begin{здесь проблема что сразу обнулять максимумы нельзя - они участвуют дальше в сравнениях}

readln(n);{поэтому будем использовать две переменные для хранения индексов максимумов}

m:=0;//здесь будет индекс максимума уже для обнуления, пока равно 0,т.к. такого индекса нет

m1:=0; //текущий индекс максимума, пока равно 0,т.к. такого индекса нет

for i:=1 to n do readln(a[i]);

if a[1]>a[2] then m1:=1;//первый эл-т тоже может быть максимумом

for i:=2 to n-1 do

begin

m:=m1;//переход индекса максимума с "текущей" m1 на переменную m "под удаление"

if (a[i-1] <a[i])and(a[i]>a[i+1]) then m1:=i;//определение максимума и запись в "текущую" m1 его индекса

if m<>0 then a[m]:=0;//обнуление максимума, m<>0 - условие что индекс существует

end;

if a[n]>a[n-1] then m1:=n;//проверяем последнее число на максимум, естественно запись в m1

a[m1]:=0;//обнуляем последний максимум

for i:=1 to n do writeln(a[i]);

end.

************76-2*

var

n,i,m,m1:integer;

a:array [1..10]of real;

begin

readln(n);

for i:=1 to n do readln(a[i]);

i:=1;

while i<=n do

begin

if ((i=1)or(a[i-1]<a[i]))and((i=n)or(a[i]>a[i+1])) then

begin

a[i]:=0;

inc(i);//здесь идея-после нахождения максимума, следующее число точно не максимум, пропускаем его, то есть увеличиваем i на 2(дважды на 1)

end;

inc(i);

end;

for i:=1 to n do writeln(a[i]);

end.

[/crayon]

Автор: Anton

Anton — Sun, 20 Mar 2016 12:54:28 +0000

Да, поправил…
Было:

program Array76;

var

a : array[1..10] of integer;

N,i:Integer;

begin

Write('N: ');

Readln(N);

Writeln('A: ');

for i:=1 to N do

begin

write(i,' :');

readln(a[i]);

end;

for i:=2 to N-1 do if (a[i-1]<a [i]) and (a[i]>a[i+1]) then a[i]:=0;

if a[1] > a[2] then a[1]:=0;

if a[N] > a[N-1] then a[N]:=0;

for i:=1 to N do writeln(i,' :',a[i]);

end.

</a>

Стало:

program Array76;

var

a : array[1..10] of integer;

N,an,i,k:Integer;

begin

Write('N: ');

Readln(N);

Writeln('A: ');

for i:=1 to N do

begin

write(i,' :');

readln(a[i]);

end;

if a[1] > a[2] then k:=0

else k:=a[1];

if a[N] > a[N-1] then an:=0

else an:=a[n];

for i:=2 to N-1 do

if (a[i-1]<a [i]) and (a[i]>a[i+1]) then

begin

a[i-1]:=k;

k:=0;

end

else

begin

a[i-1]:=k;

k:=a[i];

end;

a[N]:=an;

for i:=1 to N do writeln(i,' :',a[i]);

end.

</a>

Автор: olegst1975

olegst1975 — Sat, 19 Mar 2016 22:22:53 +0000

Сразу обнулять максимумы нельзя — они участвуют дальше в сравнениях