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

hamchuk250894 · 29.12.2012, 13:40

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

Vladimir_S · 29.12.2012, 16:53

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

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-1)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-1;
   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.12.2012, 18:14

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

Student · 03.01.2013, 11:19

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

Vladimir_S · 03.01.2013, 14:18

Цитата:

Сообщение от 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 · 07.01.2013, 06:01

Попал на тему в поисках решения задачи с 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(n);
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 · 07.01.2013, 18:14

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

Vladimir_S · 07.01.2013, 18:56

Цитата:

Сообщение от hamchuk250894

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

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

hamchuk250894 · 07.01.2013, 19:26

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

Daniellos · 07.01.2013, 20:09

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

29.12.2012, 13:40	#11 (permalink)
hamchuk250894 Member Регистрация: 09.12.2012 Сообщений: 45 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Хорошо. Заранее благодарен.

29.12.2012, 13:40
Helpmaster Member Регистрация: 08.03.2016 Сообщений: 0	Могу вам помочь отправив ссылки на похожие обсуждения Pascal Pascal ABC Последовательность чисел. Паскаль Pascal RGR Pascal

29.12.2012, 18:14	#13 (permalink)
hamchuk250894 Member Регистрация: 09.12.2012 Сообщений: 45 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Спасибо большое.

03.01.2013, 11:19	#14 (permalink)
Student Member Регистрация: 14.12.2012 Сообщений: 13 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	Владимир, огромное спасибо за помощь)) Я вот текстовый файл посмотрел - у меня 2 вопроса: 1) как сделать чтобы корректно выводились отрицательные числа 2) если последнее число записанное в строку входит в последовательность то оно не выводится, например: вводим "121212" выводится только "12121" - почему? Если не трудно, посмотрите пожалуйста

Ads
Яндекс Member Регистрация: 31.10.2006 Сообщений: 40200 Записей в дневнике: 0 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 55070

07.01.2013, 18:14	#17 (permalink)
hamchuk250894 Member Регистрация: 09.12.2012 Сообщений: 45 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	а через случайные числа в векторе можно сделать это задание также через типизированный файл?

07.01.2013, 19:26	#19 (permalink)
hamchuk250894 Member Регистрация: 09.12.2012 Сообщений: 45 Сказал(а) спасибо: 0 Поблагодарили 0 раз(а) в 0 сообщениях Репутация: 10	а как это сделать в программе?

07.01.2013, 20:09	#20 (permalink)
Daniellos Хозяин Медной Горы Регистрация: 01.08.2011 Адрес: Армавир Сообщений: 12,159 Записей в дневнике: 8 Сказал(а) спасибо: 751 Поблагодарили 88 раз(а) в 27 сообщениях Репутация: 57416	вместо ввода с клавиатуры, активируй ГСЧ командой randomize;