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

Series40. Дано целое число $$K$$, а также $$K$$ наборов ненулевых целых чисел. Каждый набор содержит не менее трех элементов, признаком его завершенияявляется число 0. Для каждого набора выполнить следующее действие: если набор является пилообразным (см. задание Series23), то вывести количество его элементов; в противном случае вывести номер первого элемента, который не является зубцом.

Решение:

program Series40;
var
  K,Ki,A,A1,A2,Count:Integer;
  Check:Boolean;
begin
 Write('K: ');
 Readln(K);
 for Ki:=1 to K do
  begin
   Write('A: ');
   Readln(A1);
   Write('A: ');
   Readln(A);
   Count:=1;
   Check:=True;
   repeat
    A2:=A1;
    A1:=A;
    Write('A: ');
    Readln(A);
    if Check then
     begin
      inc(Count);
      if  not (((A2<A1) and (A1>A)) or ((A2>A1) and (A1<A))) and (A<>0) then
       Check:=False;
     end;
   until A=0;
   Writeln('---');
   Writeln(Count);
  end;
end.

program Series40;

var

K,Ki,A,A1,A2,Count:Integer;

Check:Boolean;

begin

Write('K: ');

Readln(K);

for Ki:=1 to K do

begin

Write('A: ');

Readln(A1);

Write('A: ');

Readln(A);

Count:=1;

Check:=True;

repeat

A2:=A1;

A1:=A;

Write('A: ');

Readln(A);

if Check then

begin

inc(Count);

if not (((A2<A1) and (A1>A)) or ((A2>A1) and (A1<A))) and (A<>0) then

Check:=False;

end;

until A=0;

Writeln('---');

Writeln(Count);

end;

end.

Другие задачи из раздела Series можно посмотреть здесь.

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

Строчку 25 изменить на Count:=count+1. Чуть глобальнее, предлагаю строки с 21 по 27 заменить на

if  not (((A2меньшеA1) and (A1>A)) or ((A2>A1) and (A1<A))) and (Aне равно0) then Check:=False;
if Check then inc(Count,1);

1 2	if not (((A2меньшеA1) and (A1>A)) or ((A2>A1) and (A1<A))) and (Aне равно0) then Check:=False; if Check then inc(Count,1);

Ответить

Угу, вместо номера элемента выводил его значение.
Немного не нравится строчки, так как проверка будет происходить всё время. Поэтому поменял так:
Было:

if Check then
 if  not (((A2 < A1 ) and (A1 > A)) or ((A2 > A1) and (A1 < A ))) and (A<>0) then
  begin
   Check:=False;
   Count:=A;
  end
 else Count:=count+1;

if Check then

if not (((A2 < A1 ) and (A1 > A)) or ((A2 > A1) and (A1 < A ))) and (A<>0) then

begin

Check:=False;

Count:=A;

end

else Count:=count+1;

Стало:

if Check then
 begin
  inc(Count);
  if  not (((A2 < A1 ) and (A1 > A)) or ((A2 > A1) and (A1 < A ))) and (A<>0) then
  Check:=False;
 end;

if Check then

begin

inc(Count);

if not (((A2 < A1 ) and (A1 > A)) or ((A2 > A1) and (A1 < A ))) and (A<>0) then

Check:=False;

end;

Ответить

//pascalABC.net
begin
  write('введите кол-во наборов: ');
  var k:=ReadlnInteger('k =');
  for var i:=1 to k do
  begin
    writeln('введите ',i,' набор чисел:');
    var a:=ReadSeqIntegerWhile(t->t<>0).ToArray;
    //var a:=Arr(1,3,1,3,1,3,1,3,1,3); a.Println;
    a:=a.Incremental((x,y)->x-y).ToArray;//a.Println;
    for var j:=0 to a.Count-2 do
      if a[j]*a[j+1]>=0 then
      begin
        if a[0]=0 then println('индекс ''незубца''',j+2)
        else println('индекс ''незубца''',j+3);
        break;
      end
      else
        if j=a.Count-2 then
          println('кол-во элементов в наборе',a.Count+1);
   end;
  readln;readln;
end.

//pascalABC.net

begin

write('введите кол-во наборов: ');

var k:=ReadlnInteger('k =');

for var i:=1 to k do

begin

writeln('введите ',i,' набор чисел:');

var a:=ReadSeqIntegerWhile(t->t<>0).ToArray;

//var a:=Arr(1,3,1,3,1,3,1,3,1,3); a.Println;

a:=a.Incremental((x,y)->x-y).ToArray;//a.Println;

for var j:=0 to a.Count-2 do

if a[j]*a[j+1]>=0 then

begin

if a[0]=0 then println('индекс ''незубца''',j+2)

else println('индекс ''незубца''',j+3);

break;

end

else

if j=a.Count-2 then

println('кол-во элементов в наборе',a.Count+1);

end;

readln;readln;

end.

Ответить

Наталья

20.01.2019 в 06:51

В отношении «незубцов» правильнее вместо строк 14, 15 :

println('индекс ''незубца'':',j+2);

1

println('индекс ''незубца'':',j+2);

Ответить

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

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

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

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