Модераторы: volvo877, Snowy, MetalFan
  

Поиск:

Ответ в темуСоздание новой темы Создание опроса
> Не идёт задачка... Написал, а ошибки выдаёт. 
:(
    Опции темы
AL
  Дата 19.11.2005, 19:16 (ссылка) | (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered
В массиве найти отрезок максимальной длины, в котором первое число равно последнему, второе - предпоследнему и т.д. Напечатать характеристики этого отрезка: длинну и номер первого элемента.

Вроде написал, да ошибку не найду - не запускается даже.
Код

program Kostya;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  n = 20;

type
  Tind = 1..n;
  Vector = array [Tind] of integer;

var
  A:Vector; // Массив
  i,j,k,l,  // Переменные цикла
  max_begin, max_length: word;  // Данные последовательности
  equal : boolean;  // Условие равенства

begin
  WriteLn('Please, input an array: ');
  for i:=1 to n do Read(A[i]);
  ReadLn;

  max_begin := 0;
  max_length := 0;

  for j:=1 to n do
    for k:=j+1 to n do
      if (A[k] = A[j]) then
       begin
       equal := false;
       if (odd(k-j)) then
        equal := true
       else
        equal := false;
       l := 1;
       repeat
        if (A[j+l] = A[k-l]) then
          equal := true
        else
          equal := false;
       until (equal = false) or ((k - j + 1) div 2 = l);
       if (equal = true) then
        begin
          if (k - j + 1 > max_length) then
          max_begin := k;
          max_length := k - j + 1;
        end;
       end;
    end;
  end;

  if((max_begin = 0) and (max_length = 0)) then
    WriteLn('There are no symmetric lines.')
  else
    WriteLn('The line begins from ', max_begin, ' and it''s length is ', max_length, '.');

  ReadLn;
end.
  Вверх
AL
Дата 19.11.2005, 19:27 (ссылка) | (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered
Упс, старую версию загрузил. Смотрите эту плз:

Код

program Kostya;

{$APPTYPE CONSOLE}

uses
  SysUtils;

const
  n = 4;

type
  Tind = 1..n;
  Vector = array [Tind] of integer;

var
  A:Vector; // Ìàññèâ
  i,j,k,l,  // Ïåðåìåííûå öèêëà
  max_begin, max_length: word;  // Äàííûå ïîñëåäîâàòåëüíîñòè
  equal : boolean;  // Óñëîâèå ðàâåíñòâà

begin
  WriteLn('Please, input an array: ');
  for i:=1 to n do Read(A[i]);
  ReadLn;

  max_begin := 0;
  max_length := 0;

  for j := 1 to n do
    for k := j + 1 to n do
      if (A[k] = A[j]) then
       begin
       equal := false;
       l := 1;
       repeat
        if (A[j+l] = A[k-l]) then
          equal := true
        else
          equal := false;
        inc(l);
       until (equal = false) or ((k - j + 1) div 2 = l);
       if (equal = true) then
        begin
          if (k - j + 1 > max_length) then
          max_begin := k;
          max_length := k - j + 1;
        end;
       end;
    end;
  end;

  if((max_begin = 0) and (max_length = 0)) then
    WriteLn('There are no symmetric lines.')
  else
    WriteLn('The line begins from ', max_begin, ' and it''s length is ', max_length, '.');

  ReadLn;
end.
  Вверх
darkart
Дата 19.11.2005, 21:27 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 379
Регистрация: 9.11.2005

Репутация: нет
Всего: 31
Попробуй это:
Код

const
  n=7;{размерность}
type
  TArr=array[1..n] of integer;
procedure InputArray(var Arr:TArr);
{ввод массива}
var
  i:integer;
begin
  for i:=1 to n-1 do
    read(Arr[i]);
  readln(Arr[n]);
end;
function FindNumIndex(var Arr:TArr;start,num:integer):integer;
{находит первое положение числа нум после start}
var
  i:integer;
begin
  i:=start+1;
  while (Arr[i]<>num) and (i<=n) do
    inc(i);
  FindNumIndex:=i;
end;
function Test(var Arr:TArr;start,finish:integer):boolean;
{подходит ли нам число}
var
  i,center:integer;
  bolResult:boolean;
begin
  if finish>n then
    bolResult:=False
  else
  begin
    bolResult:=True;
    center:=(finish-start) div 2;
    i:=1;
    while bolResult and (i<=center)do
    begin
      bolResult:=(Arr[start+i]=Arr[finish-i]);
      inc(i);
    end;
  end;
  Test:=bolResult;
end;
procedure GetMaxLength(var Arr:TArr;var maxLength,maxStart:integer);
{нахождение макс длины и номера начала последовательности}
var
  i,k,Index:integer;
begin
  maxStart:=1;
  maxLength:=1;
  for i:=1 to n do
  begin
    k:=i;
    repeat
      Index:=FindNumIndex(Arr,k,Arr[i]);
      if Test(Arr,i,Index) then
        if (Index-i+1)>maxLength then
        begin
          maxLength:=Index-i+1;
          maxStart:=i;
        end;
      k:=Index;
    until Index>n;
  end;
end;
var
  Arr:TArr;
  maxStart,maxLength:integer;
begin
  writeln('Please enter array:');
  InputArray(Arr);
  GetMaxLength(Arr,maxLength,maxStart);
  writeln('MaxLength=',maxLength);
  writeln('MaxStart=',MaxStart);
  readln;
end.


Это сообщение отредактировал(а) darkart - 19.11.2005, 21:50
PM MAIL WWW ICQ Skype GTalk   Вверх
AL
Дата 19.11.2005, 23:05 (ссылка) | (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered
1112111 - тоже выдает, что симметричная...
А можно определить, что в моём коде неправильно?
  Вверх
darkart
Дата 19.11.2005, 23:07 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Опытный
**


Профиль
Группа: Участник
Сообщений: 379
Регистрация: 9.11.2005

Репутация: нет
Всего: 31
Цитата
1112111 - тоже выдает, что симметричная...
Так она же и является симметричной...
PM MAIL WWW ICQ Skype GTalk   Вверх
AL
Дата 20.11.2005, 00:30 (ссылка) | (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered
Хм... А я думал только 11122111 - а что с моим кодом никто не подскажет, хочу очь разобраться)
  Вверх
Zero
Дата 21.11.2005, 00:20 (ссылка) | (нет голосов) Загрузка ... Загрузка ... Быстрая цитата Цитата


Эксперт
****


Профиль
Группа: Завсегдатай
Сообщений: 2169
Регистрация: 23.10.2004
Где: Россия, г. Рязань

Репутация: нет
Всего: 24
Цитата(AL @ 20.11.2005, 01:30)
а что с моим кодом никто не подскажет, хочу очь разобраться)

Цитата(AL @ 19.11.2005, 20:16)
Вроде написал, да ошибку не найду - не запускается даже.

Ну вообщем, я его исправил, чтобы он запускался, а в алгоритме разбираться влом...
PS: ну что то он там похожее на что-то выдаёт... smile
Код

program Kostya;

const
  n = 4;
type
  Tind = 1..n;
  Vector = array [Tind] of integer;
var
  A:Vector;
  i,j,k,l,
  max_begin,max_length: word;
  equal : boolean;
begin
  WriteLn('Please, input an array: ');
  for i:=1 to n do Read(A[i]);
  ReadLn;
  max_begin := 0;
  max_length := 0;
  for j := 1 to n do
    for k := j + 1 to n do
      if (A[k] = A[j]) then
        begin
          equal := false;
          l := 1;
          repeat
            if (A[j+l] = A[k-l]) then
              equal := true
            else
              equal := false;
              inc(l);
          until (equal = false) or ((k - j + 1) div 2 = l);
          if (equal = true) then
             begin
               if (k - j + 1 > max_length) then
                  max_begin := k;
               max_length := k - j + 1;
             end;
        end;
  if((max_begin = 0) and (max_length = 0)) then
    WriteLn('There are no symmetric lines.')
  else
    WriteLn('The line begins from ', max_begin, ' and it''s length is ', max_length, '.');
  ReadLn;
end.



Это сообщение отредактировал(а) Zero - 21.11.2005, 00:21
PM MAIL ICQ   Вверх
AL
Дата 21.11.2005, 22:11 (ссылка) | (голосов: 0) Загрузка ... Загрузка ... Быстрая цитата Цитата


Unregistered
Уже сам всё нашёл и поправил. Дурацкие ошибки были... smile
  Вверх
  
 Ответ в темуСоздание новой темы Создание опроса
Правила форума "Delphi"
THandle
Rrader
volvo877

Запрещается!

1. Обсуждать и делится взломанными компонентами или программным обеспечением

2. Публиковать ссылки на варез

3. Оффтопить

  • Действия модераторов можно обсудить здесь
  • С просьбами о написании курсовой, реферата и т.п. обращаться сюда
  • Вопросы по реализации алгоритмов рассматриваются здесь
  • 90% ответов на свои вопросы можно найти в DRKB (Delphi Russian Knowledge Base) - крупнейшем в рунете сборнике материалов по Дельфи

Если Вам понравилась атмосфера форума, заходите к нам чаще! С уважением, THandle, Rrader, volvo877.
 
0 Пользователей читают эту тему (0 Гостей и 0 Скрытых Пользователей)
0 Пользователей:
« Предыдущая тема | Object Pascal: кроссплатформенные технологии | Следующая тема »

Подписаться на тему | Подписка на этот форум | Скачать/Распечатать тему


 




[ Время генерации скрипта: 0.0528 ]   [ Использовано запросов: 22 ]   [ GZIP включён ]


Реклама на сайте     Информационное спонсорство

 
 По вопросам размещения рекламы пишите на vladimir(sobaka)vingrad.ru
Отказ от ответственности     Powered by Invision Power Board(R) 1.3 © 2003  IPS, Inc.