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

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

Решение:

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.

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.

Решение olegst1975:

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.

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.

Задачи из раздела Array можно посмотреть здесь.

Комментарии 6

olegst1975

20.03.2016 в 02:22

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

Ответить

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

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,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>

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>

Ответить

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

[crayon-67439bc25880f777496412 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-67439bc25880f777496412 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;

end;

inc(i);

end;

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

end.

[/crayon]

Ответить

Anton

21.03.2016 в 07:47

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

Ответить

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

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.

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.

Ответить

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

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.

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.

Ответить

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

Комментарии:

Комментарии 6

Добавить комментарий Отменить ответ