Пилообразная последовательность, Pascal

Student · 28 Дек 2012

Пилообразная последовательность, Pascal

Последовательность a1, a2, a3, … , an-1, an называется пилообразной, если она удовлетворяет одному из следующих условий:
1) a1 < a2 > a3 < … > an-1 < an
2) a1 > a2 < a3 > … < an-1 > an

Задание:
заполнить файл txt целыми числами с консоли, вывести самую длинную пилообразную последовательность.

Помогите, пожалуйста, с решением!! Заранее спасибо

Имеется код схожей задачи на массивы, но он немножко неверно работает:

uses crt;
const nmax=30;
var a:array[1..nmax] of byte;
n,i,j,k,mx,imx:byte;
begin
clrscr;
repeat
write('Размер массива до ',nmax,' n=');
readln

;
until n in [1..nmax];
writeln('Введите элементы массива, в том числе образующие пилообразные последовательности');
for i:=1 to n do
begin
write('a[',i,']=');
readln(a);
end;
clrscr;
writeln('Массив:');
for i:=1 to n do
write(a,' ');
writeln;
writeln;
i:=2;mx:=0;imx:=0;
while i<n do
if ((a>a[i-1])and(a>a[i+1]))or((a<a[i-1])and(a<a[i+1])) then
begin
j:=i;k:=2;
while(j<=n)and(((a[j]>a[j-1])and(a[j]>a[j+1]))or((a[j]<a[j-1])and(a[j]<a[j+1]))) do
begin
j:=j+1;
k:=k+1;
end;
if k>mx then
begin
mx:=k;
imx:=i-1;
end;
i:=i+k;
end
else i:=i+1;
if mx=0 then write('Нет пилообразной последовательности!')
else
begin
writeln('Максимальная пилообразная последовательность одинаковых чисел=',mx);
for i:=imx to imx+mx-1 do
write(a,' ');
writeln;
write('Её длина=',mx);
end;
readln
end.

Vladimir_S · 28 Дек 2012

Student написал(а):
Имеется код схожей задачи на массивы, но он немножко неверно работает:

В чем именно "неверно"? Погонял программу и ошибок не обнаружил.

Student · 28 Дек 2012

Если последовательность начинается с убывания, то вроде нормально, а если с возрастания но есть сбои
попробуйте ввести: 1 2 1 2 1 2

Vladimir_S · 28 Дек 2012

Student написал(а):
Если последовательность начинается с убывания, то вроде нормально, а если с возрастания но есть сбои
попробуйте ввести: 1 2 1 2 1 2

Попробовал. Нолик в конце присобачивается. Об этом речь?

Student · 28 Дек 2012

Да, и прибавляет еще этот нолик к длине строки

Vladimir_S · 28 Дек 2012

Понятно. Всё, что могу обещать - посмотрю, как будет время. Сегодня вечером либо завтра.

Student · 28 Дек 2012

Спасибо, но дело даже не в этом нолике - надо это как-то реализовать через файл txt
Но за любую помощь все-равно спасибо.

hamchuk250894 · 29 Дек 2012

Такое же задание у меня но только мне надо создать типизированный файл .dat целых чисел и вывести на экран самую длинную пилообразную последовательность.

hamchuk250894 · 29 Дек 2012

но только я тоже понять не могу как сделать.

Vladimir_S · 29 Дек 2012

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

hamchuk250894 · 29 Дек 2012

Хорошо. Заранее благодарен.

Vladimir_S · 29 Дек 2012

Уф, допилил, кажется. Предлагаются три варианта. В кодах с файлами поправьте имена и пути. Еще прошу прощения за переход на английские ремарки - мне так удобнее:

1. Без файла с исправленными ошибками (их там две; выделены красным):

Код:

uses crt;
const
 nmax=30;
var
 a:array[1..nmax] of byte;
 n,i,j,k,mx,imx:byte;
Begin
 clrscr;
 repeat
  write('The length of array up to ',nmax,' n=');
  readln(n);
 until n in [1..nmax];
 writeln('Enter the array elements including ones forming the serrated sequences');
 for i:=1 to n do
  begin
   write('a[',i,']=');
   readln(a[i]);
  end;
 clrscr;
 writeln('Array:');
 for i:=1 to n do write(a[i],' ');
 writeln;
 writeln;
 i:=2;
 mx:=0;
 imx:=0;
 while i<n do
  if ((a[i]>a[i-1])and(a[i]>a[i+1]))or((a[i]<a[i-1])and(a[i]<a[i+1])) then
   begin
    j:=i;
    k:=2;
    while(j<=n[COLOR=Red][B]-1[/B][/COLOR])and(((a[j]>a[j-1])and(a[j]>a[j+1]))or((a[j]<a[j-1])and(a[j]<a[j+1]))) do
     begin
      j:=j+1;
      k:=k+1;
     end;
    if k>mx then
     begin
      mx:=k;
      imx:=i-1;
     end;
    i:=i+k[COLOR=Red][B]-1[/B][/COLOR];
   end
   else i:=i+1;
 if mx=0 then write('No serrated sequence!')
 else
 begin
  for i:=imx to imx+mx-1 do write(a[i],' ');
  writeln;
  write('Its length= ',mx);
 end;
 readln
End.

2. С текстовым файлом:

Код:

uses crt;
const
 nmax=30;
var
 a:array[1..nmax] of byte;
 n,i,k,mx,imx,a1,a2,a3:byte;
 f:Text;
Begin
 Assign(f,'D:\xxx.txt');
 Rewrite(f);
 clrscr;
 repeat
  write('The length of array up to ',nmax,' n=');
  readln(n);
 until n in [1..nmax];
 writeln('Enter the array elements including ones forming the serrated sequences');
 for i:=1 to n do
  begin
   write('a[',i,']=');
   readln(a[i]);
  end;
 clrscr;
 writeln('Array:');
 for i:=1 to n do
  begin
   write(a[i],' ');
   if i<n then write(f,a[i],' ') else write(f,a[i]);
  end;
 Close(f);
 Reset(f);
 writeln;
 writeln;
 i:=2;
 mx:=0;
 imx:=0;
 Read(f,a1,a2,a3);
 while Not(Eof(f)) do
  if ((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3)) then
   begin
    k:=3;
    while Not(Eof(f))and(((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3))) do
     begin
      a1:=a2;
      a2:=a3;
      read(f,a3);
      if Not(Eof(f))and(((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3))) then k:=k+1;
     end;
    if k>mx then
     begin
      mx:=k;
      imx:=i-1;
     end;
    i:=i+k-1;
    a1:=a2;
    a2:=a3;
    If Not(EoF(f)) then read(f,a3);
   end
   else
   if Not(EoF(f)) then
    begin
     a1:=a2;
     a2:=a3;
     read(f,a3);
     i:=i+1;
    end;
 if mx=0 then write('No serrated sequence!')
 else
 begin
  writeln('Maximal serrated sequence= ',mx);
  Reset(f);
  for i:=1 to imx-1 do read(f,a1);
  for i:=imx to imx+mx-1 do
   begin
    read(f,a1);
    write(a1,' ');
   end;
  Close(f);
  writeln;
  write('Its length= ',mx);
 end;
 readln
End.

3. С типизированным файлом:

Код:

uses crt;
const
 nmax=30;
var
 a:array[1..nmax] of byte;
 n,i,k,mx,imx,a1,a2,a3:byte;
 f:file of byte;
Begin
 Assign(f,'D:\xxx');
 Rewrite(f);
 clrscr;
 repeat
  write('The length of array up to ',nmax,' n=');
  readln(n);
 until n in [1..nmax];
 writeln('Enter the array elements including ones forming the serrated sequences');
 for i:=1 to n do
  begin
   write('a[',i,']=');
   readln(a[i]);
  end;
 clrscr;
 writeln('Array:');
 for i:=1 to n do
  begin
   write(a[i],' ');
   write(f,a[i]);
  end;
 Close(f);
 Reset(f);
 writeln;
 writeln;
 i:=2;
 mx:=0;
 imx:=0;
 Read(f,a1,a2,a3);
 while Not(Eof(f)) do
  if ((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3)) then
   begin
    k:=3;
    while Not(Eof(f))and(((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3))) do
     begin
      a1:=a2;
      a2:=a3;
      read(f,a3);
      if Not(Eof(f))and(((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3))) then k:=k+1;
     end;
    if k>mx then
     begin
      mx:=k;
      imx:=i-1;
     end;
    i:=i+k-1;
    a1:=a2;
    a2:=a3;
    If Not(EoF(f)) then read(f,a3);
   end
   else
   if Not(EoF(f)) then
    begin
     a1:=a2;
     a2:=a3;
     read(f,a3);
     i:=i+1;
    end;
 if mx=0 then write('No serrated sequence!')
 else
 begin
  writeln('Maximal serrated sequence= ',mx);
  Reset(f);
  for i:=1 to imx-1 do read(f,a1);
  for i:=imx to imx+mx-1 do
   begin
    read(f,a1);
    write(a1,' ');
   end;
  Close(f);
  writeln;
  write('Its length= ',mx);
 end;
 readln
End.

hamchuk250894 · 29 Дек 2012

Спасибо большое.

Student · 3 Янв 2013

Владимир, огромное спасибо за помощь))
Я вот текстовый файл посмотрел - у меня 2 вопроса:
1) как сделать чтобы корректно выводились отрицательные числа
2) если последнее число записанное в строку входит в последовательность то оно не выводится, например: вводим "121212" выводится только "12121" - почему?
Если не трудно, посмотрите пожалуйста

Vladimir_S · 3 Янв 2013

Student написал(а):
Если не трудно, посмотрите пожалуйста

Посмотрел. Поправил. И насчет отрицательных чисел - тоже.

1. С текстовым файлом:

Код:

uses crt;
const
 nmax=30;
var
 a:array[1..nmax] of Integer;
 n,i,k,mx,imx,a1,a2,a3:Integer;
 f:Text;
Begin
 Assign(f,'D:\xxx.txt');
 Rewrite(f);
 clrscr;
 repeat
  write('The length of array up to ',nmax,' n=');
  readln(n);
 until n in [1..nmax];
 writeln('Enter the array elements including ones forming the serrated sequences');
 for i:=1 to n do
  begin
   write('a[',i,']=');
   readln(a[i]);
  end;
 clrscr;
 writeln('Array:');
 for i:=1 to n do
  begin
   write(a[i],' ');
   if i<n then write(f,a[i],' ') else write(f,a[i]);
  end;
 Close(f);
 Reset(f);
 writeln;
 writeln;
 i:=2;
 mx:=0;
 imx:=0;
 Read(f,a1,a2,a3);
 while Not(Eof(f)) do
  if ((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3)) then
   begin
    k:=3;
    while Not(Eof(f))and(((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3))) do
     begin
      a1:=a2;
      a2:=a3;
      read(f,a3);
      if ((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3)) then k:=k+1;
     end;
    if k>mx then
     begin
      mx:=k;
      imx:=i-1;
     end;
    i:=i+k-1;
    a1:=a2;
    a2:=a3;
    If Not(EoF(f)) then read(f,a3);
   end
   else
   if Not(EoF(f)) then
    begin
     a1:=a2;
     a2:=a3;
     read(f,a3);
     i:=i+1;
    end;
 if mx=0 then write('No serrated sequence!')
 else
 begin
  writeln('Maximal serrated sequence= ',mx);
  Reset(f);
  for i:=1 to imx-1 do read(f,a1);
  for i:=imx to imx+mx-1 do
   begin
    read(f,a1);
    write(a1,' ');
   end;
  Close(f);
  writeln;
  write('Its length= ',mx);
 end;
 readln
End.

2. С типизированным файлом:

Код:

uses crt;
const
 nmax=30;
var
 a:array[1..nmax] of Integer;
 n,i,k,mx,imx,a1,a2,a3:Integer;
 f:file of Integer;
Begin
 Assign(f,'D:\xxx');
 Rewrite(f);
 clrscr;
 repeat
  write('The length of array up to ',nmax,' n=');
  readln(n);
 until n in [1..nmax];
 writeln('Enter the array elements including ones forming the serrated sequences');
 for i:=1 to n do
  begin
   write('a[',i,']=');
   readln(a[i]);
  end;
 clrscr;
 writeln('Array:');
 for i:=1 to n do
  begin
   write(a[i],' ');
   write(f,a[i]);
  end;
 Close(f);
 Reset(f);
 writeln;
 writeln;
 i:=2;
 mx:=0;
 imx:=0;
 Read(f,a1,a2,a3);
 while Not(Eof(f)) do
  if ((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3)) then
   begin
    k:=3;
    while Not(Eof(f))and(((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3))) do
     begin
      a1:=a2;
      a2:=a3;
      read(f,a3);
      if ((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3)) then k:=k+1;
     end;
    if k>mx then
     begin
      mx:=k;
      imx:=i-1;
     end;
    i:=i+k-1;
    a1:=a2;
    a2:=a3;
    If Not(EoF(f)) then read(f,a3);
   end
   else
   if Not(EoF(f)) then
    begin
     a1:=a2;
     a2:=a3;
     read(f,a3);
     i:=i+1;
    end;
 if mx=0 then write('No serrated sequence!')
 else
 begin
  writeln('Maximal serrated sequence= ',mx);
  Reset(f);
  for i:=1 to imx-1 do read(f,a1);
  for i:=imx to imx+mx-1 do
   begin
    read(f,a1);
    write(a1,' ');
   end;
  Close(f);
  writeln;
  write('Its length= ',mx);
 end;
 readln
End.

Проверяйте. Я уж и не знаю - мне казалось, я на всяких комбинациях предыдущий вариант тестировал, и вроде всё получалось, ан вот поди ж ты!

JustYouSmile147 · 7 Янв 2013

Попал на тему в поисках решения задачи с acmp, вот мое решение:

Program abc;
Var
n,mx,mmx,i:longint;
a1,a2,a3,a4:integer;
begin
Assign(input, 'input.txt');
Reset(input);
Assign(output, 'output.txt');
Rewrite(output);
read;
read(a1,a2,a3);
i:=2;
mx:=0;
mmx:=0;
While i<=n-1 do
if (i<=n-1)and(((a2>a1)and(a2>a3))or((a2<a1)and(a2<a3))) then
begin
mx:=mx+1;
i:=i+1;
if mx>mmx then mmx:=mx;
read(a4);
a1:=a2;
a2:=a3;
a3:=a4;
end
else begin
mx:=0;
i:=i+1;
read(a4);
a1:=a2;
a2:=a3;
a3:=a4;
end;
writeln(mmx+2);
end.

hamchuk250894 · 7 Янв 2013

а через случайные числа в векторе можно сделать это задание также через типизированный файл?

Vladimir_S · 7 Янв 2013

hamchuk250894 написал(а):
а через случайные числа в векторе можно сделать это задание также через типизированный файл?

Можно. Заменив ввод с консоли генерацией случайных чисел.

hamchuk250894 · 7 Янв 2013

а как это сделать в программе?

Daniellos · 7 Янв 2013

вместо ввода с клавиатуры, активируй ГСЧ командой randomize;

Пилообразная последовательность, Pascal

Новые

Супермодераторы

Новые

Супермодераторы

Новые

Супермодераторы

Новые

Новые

Новые

Супермодераторы

Новые

Супермодераторы

Новые

Новые

Супермодераторы

Ученик

Новые

Супермодераторы

Новые

Хозяин Медной Горы