Форум программистов
 

Восстановите пароль или Зарегистрируйтесь на форуме, о проблемах и с заказом рекламы пишите сюда - alarforum@yandex.ru, проверяйте папку спам!

Вернуться   Форум программистов > Delphi программирование > Общие вопросы Delphi
Регистрация

Восстановить пароль

Купить рекламу на форуме - 42 тыс руб за месяц

Ответ
 
Опции темы Поиск в этой теме
Старый 24.01.2011, 00:38   #1
Василиск
Новичок
Джуниор
 
Регистрация: 24.01.2011
Сообщений: 10
Вопрос Динамические массивы объектов, проблема с перекрестной индексацией.

Есть некий код волнового алгоритма работает хорошо если бы не одно НО, в процессе поиска пути непонятно из-за чего нарушется индексация объектов.
Вот код.
Код:
var
x,y,x2,y2,i,j,maxsteps,lengthwave:integer;
ss,sl,ss2,sl2:integer;
bbb:integer;
www:integer;
  begin
  //If cper=76 then MainUNit.ShowMessage('Давай'+IntToStr(id)+' индекс поиска'+IntToStr(s));
  bbb:=id;
  lengthwave:=1;
  if MainUnit.Dots[id].Energy div MainUnit.Dots[id].Stats[5]>20 then maxsteps:=20 else maxsteps:=MainUnit.Dots[id].Energy div MainUnit.Dots[id].Stats[5];
  if maxsteps>100-MainUnit.Dots[id].Age then maxsteps:=100-MainUnit.Dots[id].Age;
  for x:=1 to 40 do
  for y:=1 to 40 do
    WaysMap[x,y]:=maxsteps;
  WaysMap[MainUnit.Dots[id].X,MainUnit.Dots[id].Y]:=0;
  ss:=0;
  sl:=1;
  way[1,0].x:=MainUnit.Dots[id].X;
  way[1,0].y:=MainUnit.Dots[id].Y;
  www:=1;
  repeat
    ss2:=1000-ss;
    sl2:=0;
    for i:=0 to sl-1 do
      begin
      x:=way[1,ss+i].x;
      y:=way[1,ss+i].y;
      for j:=1 to 4 do
        begin
        x2:=ConversionXY(x+dx[j]);
        y2:=ConversionXY(y+dy[j]);
        if (s=2) and(MainUnit.Dots[id].Work<>-1) then MainUNit.ShowMessage('Шаг 1'+IntToStr(CPer)+' '+IntToStr(id));//ТУТ ВСЕ ГУД
        if (CheckTarget(x2,y2,s,id)=True)and((lengthwave<=maxsteps)) then
          begin
          Go(x2,y2,lengthwave,id,s);
          exit;
        end;
        if (s=2) and(MainUnit.Dots[id].Work<>-1) then MainUNit.ShowMessage('Шаг 3'+IntToStr(CPer)+' '+IntToStr(id));//А ВОТ ТУТ УЖЕ НЕТ
        if (CheckWay(x2,y2,id)=True) and (MainUnit.WaysMap[x2,y2]>lengthwave) then
          begin
          way[1,ss2+sl2].x:=x2;
          way[1,ss2+sl2].y:=y2;
          inc(sl2);
          WaysMap[x2,y2]:=lengthwave;
        end;
      end;
    end;
    ss:=ss2;
    sl:=sl2;
    inc(lengthwave);
  until sl=0;
Прошу помочь в нахождении ошибки, уже месяц бьюсь, уже хочу руки наложить, то ли на себя то ли на машину.
PS - Delphi 7
Василиск вне форума Ответить с цитированием
Старый 24.01.2011, 00:43   #2
Василиск
Новичок
Джуниор
 
Регистрация: 24.01.2011
Сообщений: 10
По умолчанию Продолжение кода...

Продолжение кода...
Код:
function CheckTarget(x,y,s,id:integer):Boolean;
var
j,i,k:integer;
  begin
  Result:=False;
  //Еда
  if s=1 then
    begin
    if MainUnit.Map[x,y].TypeBlock>=3 then
      Result:=True
    else exit;
  end;
  //Партнер для размножения
  if s=2 then
    begin
    if MainUnit.Map[x,y].TypeObject=1 then
    if MainUnit.Dots[MainUnit.Map[x,y].IdObjects[0]].ColorDot=MainUnit.Dots[id].ColorDot then
    for j:=0 to MainUnit.Map[x,y].LengthIdObjects-1 do
      begin
      if (MainUnit.Dots[MainUnit.Map[x,y].IdObjects[j]].Stats[6]-MainUnit.Dots[MainUnit.Map[x,y].IdObjects[j]].Motivation[1] div 20<MainUnit.Dots[id].Stats[6])and
      (MainUnit.Dots[MainUnit.Map[x,y].IdObjects[j]].Eat=False)and
      (MainUnit.Dots[MainUnit.Map[x,y].IdObjects[j]].Work=-1)and
      (MainUnit.Dots[MainUnit.Map[x,y].IdObjects[j]].Id<>id)then
        begin
        NewWork(id,1);
        SearchWork(MainUnit.Map[x,y].IdObjects[j],LengthArrWorks-1);
        Result:=True;
        exit;
      end;
    end;
  end;
  if Length(IntToStr(s))>=2 then
    begin
    if StrToInt(Copy(IntToStr(s),1,1))=1 then
      begin
      for j:=0 to MainUnit.Map[x,y].LengthIdObjects-1 do
        begin
        if MainUnit.Dots[MainUnit.Map[x,y].IdObjects[j]].ID=StrToInt(Copy(IntToStr(s),2,Length(IntToStr(s)))) then
          begin
          Result:=True;
          exit;
        end;
      end;
    end;
  end;
end;
Василиск вне форума Ответить с цитированием
Старый 24.01.2011, 01:05   #3
asmodey1
Подтвердите свой е-майл
 
Регистрация: 19.12.2010
Сообщений: 808
По умолчанию

Что за процедуры ?
Код:
NewWork(id,1);
SearchWork(MainUnit.Map[x,y].IdObjects[j],LengthArrWorks-1);
В них и портятся ваши индексы, поскольку эта связка:
Код:
if (s=2) and(MainUnit.Dots[id].Work<>-1) then MainUNit.ShowMessage('Шаг 1'+IntToStr(CPer)+' '+IntToStr(id));//ТУТ ВСЕ ГУД
{if (CheckTarget(x2,y2,s,id)=True)and((lengthwave<=maxsteps)) then
begin
Go(x2,y2,lengthwave,id,s);
exit;
end;}
CheckTarget(x2,y2,s,id);
if (s=2) and(MainUnit.Dots[id].Work<>-1) then MainUNit.ShowMessage('Шаг 3'+IntToStr(CPer)+' '+IntToStr(id));//А ВОТ ТУТ УЖЕ НЕТ
Вроде бы иначе никак не может ничего подпортить...

З.Ы. Прежде чем накладывать на себя руки или начинать кусаться, приложите еще немного усилий и сообщите, какие индексы портятся, как портятся...
Уже поздно и все экстрасенсы спят...

Последний раз редактировалось asmodey1; 24.01.2011 в 01:07.
asmodey1 вне форума Ответить с цитированием
Старый 24.01.2011, 01:18   #4
Василиск
Новичок
Джуниор
 
Регистрация: 24.01.2011
Сообщений: 10
По умолчанию

Код:
procedure NewWork(p,t:integer);
var
i,k:integer;
  begin
  if MainUnit.Dots[p].ColorDot=1 then CBlueWorks:=CBlueWorks+1 else CRedWorks:=CRedWorks+1;
  LengthArrWorks:=LengthArrWorks+1;
  SetLength(Works,LengthArrWorks);
  MainUnit.Works[LengthArrWorks-1]:=TVWork.Create;
  MainUnit.Dots[p].Work:=LengthArrWorks-1;
  MainUnit.Works[LengthArrWorks-1].TypeWork:=t;
  MainUnit.Works[LengthArrWorks-1].Id:=LengthArrWorks-1;
  //Ðàçìíîæåíèå
  if t=1 then
    begin
    MainUnit.Works[LengthArrWorks-1].LengthWorkers:=1;
    SetLength(MainUnit.Works[LengthArrWorks-1].Workers,MainUnit.Works[LengthArrWorks-1].LengthWorkers);
    MainUnit.Works[LengthArrWorks-1].Workers[0]:=p;
    MainUnit.Works[LengthArrWorks-1].TimeWork:=3;
    MainUnit.Works[LengthArrWorks-1].ResultWork:=1;
  end;
end;

procedure SearchWork(p,id:integer);
  begin
  MainUnit.Dots[p].Work:=id;
  MainUnit.Works[id].LengthWorkers:=MainUnit.Works[id].LengthWorkers+1;
  SetLength(MainUnit.Works[id].Workers,MainUnit.Works[id].LengthWorkers);
  MainUnit.Works[id].Workers[MainUnit.Works[id].LengthWorkers-1]:=p;
end;
Объясню на пальцах параметр S это цель поиска при вызове процедуры проверяется индекс работы Work он должен быть равен -1 ("ГУТ") но в момент поиска этот индекс становится не -1 хотя когда идет присвоение процедура должна прерываться, на одном форуме весь исходник программы чел просмотрел, ответа так и не нашел я уже грешу на компилятор.
Вот объекты и переменные
Код:
  //Точка
  TVDot = class(TObject)
  Id:integer;//Индекс
  TypeDot:integer;//Тип
  ColorDot:integer;//Цвет
  X,Y:integer;//Координаты
.....
  Work:integer;//Ðàáîòà
  Eat:Boolean;//Ôàêòîð ïîèñêà ïèùè
  end;

//Работа
  TVWork = class(TObject)
  Id:integer;//Индекс
  TypeWork:integer;//Тип
  ResultWork:integer;//Результат
  TimeWork:integer;//Время работы
  LengthWorkers:integer;//Кол рабочих
  Workers:array of integer;//Рабочие
  end;

//Карта путей
  WaysMap:array[1..40,1..40] of integer;
  dy:array[1..4] of integer;
  dx:array[1..4] of integer;
  way:array[1..2,0..2000] of record x,y:integer end;
Василиск вне форума Ответить с цитированием
Старый 24.01.2011, 01:23   #5
Василиск
Новичок
Джуниор
 
Регистрация: 24.01.2011
Сообщений: 10
По умолчанию

Иными словами нерабочий объект ищет работу, в момент поиск становится рабочим и продолжает искать работу из-за этого утечка памяти, и выход за границы массива, если необходимо выложу весь код касаемый индексов, но ошибку вывел только тут путем вывода вот этой не точности по поводу работы и индекса поиска.
Василиск вне форума Ответить с цитированием
Старый 24.01.2011, 01:45   #6
asmodey1
Подтвердите свой е-майл
 
Регистрация: 19.12.2010
Сообщений: 808
По умолчанию

Ну, я ж вам показал - ваши строки //ТУТ ВСЕ ГУД и //А ВОТ ТУТ УЖЕ НЕТ абсолютно идентичны, за исключением номера шага.
А вот между ними у вас всегда выполняется функция CheckTarget(), в которой происходит вызов NewWork() и SearchWork().
То есть "поплыть" ваши индексы могут только в CheckTarget()...
Кстати, вы так и не сказали, какой индекс плывет - S ? Так это вроде и не индекс...
Ну так сделайте поиск по "S:=" и т.п., и проверьте все места, где он меняется.
Хотя, с другой стороны, я все просмотрел - эта переменная участвует только в операциях сравнения...
По шагам-то отлаживали ?
Может, у вас там еще и таймер какой-нибудь есть, по событию которого вызывается нечто, портящее индексы ?
А может, вы просто где-то допустили описку в имени переменной...
asmodey1 вне форума Ответить с цитированием
Старый 24.01.2011, 01:56   #7
Василиск
Новичок
Джуниор
 
Регистрация: 24.01.2011
Сообщений: 10
По умолчанию

Меняется индекс работы, но непонятно в каком месте он может измениться только при NeWWork, но при этом процедура должна завершиться exit, но почему то она либо продолжается либо я не знаю если посмотреть на проверочные условия то они одинаковы но последнее вообще не должно вызываться никогда.\
ККрасным помечен индекс который меняется с -1 на индекс работы.
Синим что ищем.
Код:
if (s=2) and(MainUnit.Dots[id].Work<>-1) then MainUNit.ShowMessage('Øàã 3'+IntToStr(CPer)+' '+IntToStr(id));
Код:
if (CheckTarget(x2,y2,s,id)=True)and(lengthwave<=maxsteps) then
          begin
          Go(x2,y2,lengthwave,id,s);
          exit;
        end;
//Эта строчка по определению не может выполнятся если она не выполнялась до поиска цели, а она не выполнялась....МИСТИКА
       if (s=2) and(MainUnit.Dots[id].Work<>-1) then MainUNit.ShowMessage('Øàã 3'+IntToStr(CPer)+' '+IntToStr(id));
Эта штука и вызывается по таймеру вернее вызывается цикл из которого вызывается эта чтука.
Сам объект id тотже проверял по всем параметрам.
Скажите пожалуйста хотябы что еще может на это повлиять...
Василиск вне форума Ответить с цитированием
Старый 24.01.2011, 02:15   #8
asmodey1
Подтвердите свой е-майл
 
Регистрация: 19.12.2010
Сообщений: 808
По умолчанию

MainUnit.Dots[id].Work у вас меняется в двух местах:
MainUnit.Dots[p].Work:=LengthArrWorks-1;
и
MainUnit.Dots[p].Work:=id;
Ставьте туда бряки и смотрите начальное значение и конечное...
asmodey1 вне форума Ответить с цитированием
Старый 24.01.2011, 14:47   #9
GunSmoker
Старожил
 
Регистрация: 13.08.2009
Сообщений: 2,581
По умолчанию

Рекомендую ещё включить опцию Range Check Errors и сделать проекту Build (не Compile).

Есть хороший шанс на переполнение буфера.
Опытный программист на C++ легко решает любые не существующие в Паскале проблемы.
GunSmoker вне форума Ответить с цитированием
Старый 24.01.2011, 14:58   #10
Василиск
Новичок
Джуниор
 
Регистрация: 24.01.2011
Сообщений: 10
По умолчанию

Цитата:
Сообщение от GunSmoker Посмотреть сообщение
Рекомендую ещё включить опцию Range Check Errors и сделать проекту Build (не Compile).

Есть хороший шанс на переполнение буфера.
А по подробнее к чему может привести переполнение буфера???
Василиск вне форума Ответить с цитированием
Ответ


Купить рекламу на форуме - 42 тыс руб за месяц



Похожие темы
Тема Автор Раздел Ответов Последнее сообщение
Динамические массивы [ICQ] Помощь студентам 3 20.02.2015 17:31
Динамические массивы с++ maxsept Общие вопросы C/C++ 2 27.10.2010 20:16
Динамические массивы и массивы варианты N@stya Помощь студентам 0 11.06.2010 21:09
Динамические массивы на си Sha-sha Помощь студентам 1 19.05.2009 18:55
динамические массивы funky Общие вопросы C/C++ 3 12.05.2009 01:54