Удаление элементов косвенно рекурсивных списков

← →
теркин © (2012-02-18 02:41) [0]

Имеются два списка TRebroList = class(TList) и TYzelList = class(TList). Имеются два еще 2 класса TYzel=class(TObject) и TRebro=class(TObject). При этом объект TRebro содержит ListYzel:TYzelList
а TYzel содержит ListRebro:TRebroList. Все 4 класса объявлены с опережением и создают косвенную рекурсию. Ниже приведен интерфейс модуля
type TYzel=class; TRebro=class; TRebroList = class; { TYzeltList class } TYzelList = class(TList) private FOwnsObjects: Boolean; protected procedure Notify(Ptr: Pointer; Action: TListNotification); override; function GetItem(Index: Integer): TYzel; procedure SetItem(Index: Integer; AYzel: TYzel); public constructor Create; overload; constructor Create(AOwnsObjects: Boolean); overload; function Add(AYzel: TYzel): Integer; function Extract(Item: TYzel): TYzel; function Remove(AYzel: TYzel): Integer; function IndexOf(AYzel: TYzel): Integer; function FindInstanceOf(AClass: TClass; AExact: Boolean = True; AStartAt: Integer = 0): Integer; procedure Insert(Index: Integer; AYzel: TYzel); function First: TYzel; function Last: TYzel; property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects; property Items[Index: Integer]: TYzel read GetItem write SetItem; default; end; TYzel=class(TObject) TipYzel:String; NomerYzel,RecNoYzel,TipTrybYzel,Tag:Integer; GeoYzel,DavlenieYzel,TemperatyraYzel,GYzel:Double; private function ReadRebro(IndexRebro:integer):TRebro; function AddRebro(ARebro:TRebro):integer; function ReadRachod:Double; function ReadDavlenie:Double; public ListRebro:TRebroList; Marhrut:TRebroList; constructor Create(RecNo:integer;Tip:String;TipTryb,Nomer:Integer;Geo,Davlenie,Temperatyra,G :Double); destructor Destroy;override; property Nomer:integer read NomerYzel; property Tip:String read TipYzel; property Rebro[IndexRebro:integer]:TRebro read ReadRebro; property Rashod:Double read ReadRachod; property Davlenie:Double read ReadDavlenie; end; { TRebrotList class } TRebroList = class(TList) private FOwnsObjects: Boolean; protected procedure Notify(Ptr: Pointer; Action: TListNotification); override; function GetItem(Index: Integer): TRebro; procedure SetItem(Index: Integer; ARebro: TRebro); public constructor Create; overload; constructor Create(AOwnsObjects: Boolean); overload; function Add(ARebro: TRebro): Integer; function Extract(Item: TRebro): TRebro; function Remove(ARebro: TRebro): Integer; function IndexOf(ARebro: TRebro): Integer; function FindInstanceOf(AClass: TClass; AExact: Boolean = True; AStartAt: Integer = 0): Integer; procedure Insert(Index: Integer; ARebro: TRebro); function First: TRebro; function Last: TRebro; property OwnsObjects: Boolean read FOwnsObjects write FOwnsObjects; property Items[Index: Integer]: TRebro read GetItem write SetItem; default; end; TRebro=class(TObject) Tag:Integer; SyRebro,GRebro,EDSRebro,dHRebro,Hdrosel,Histok,dT,Tistok:Double; tipRebro:string; IDYhastok:TStringList; private procedure SmenaNapravlenia; function ReadYzel(IndexYzel:integer):TYzel; function ReadYzel1:TYzel; function ReadYzel2:TYzel; function AddYzel(AYzel:TYzel):integer; function ReadRashod:Double; public ListYzel:TYzelList; constructor Create(Tip,ID:String;Sy,G,EDS,HYhastok,dTyhastok:Double); function LastYzel:TYzel; function FirstYzel:TYzel; property Yzel[IndexYzel:integer]:TYzel read ReadYzel; property Yzel1:TYzel read ReadYzel1; property Yzel2:TYzel read ReadYzel2; property Rashod:Double read ReadRashod; end; type TMatriza=class(TObject) private KolYzlov,KolReber,KolStok,KolIstok:Integer; procedure SListYzelActivate; procedure SListRebroActivate; procedure SListZiklActivate(var MListYzel: TYzelList;var MListRebro:TRebroList;var MListZikl:TZiklList); procedure Incidentnost(var Yzel:TYzel;IndexRebro:integer); function PoiskYzla(var SYzel:TYzel):integer; procedure Sgatie(SListYzel:TYzelList;SListRebro:TRebroList); procedure SgatieListYzel(var MListYzel: TYzelList;var MListRebro:TRebroList); function YzelHorda(Yzel:TYzel):Boolean; procedure DerevoActivate(var MListRebro:TRebroList;var MListYzel:TYzelList;var Yzel:TYzel); function RebroHorda(Rebro:TRebro):Boolean; procedure MarhPerdat(const Rebro:TRebro;var MListYzel: TYzelList); procedure Zep(IndexYzel:integer;var MListYzel: TYzelList;var MListRebro:TRebroList); function YzelZep(Yzel:TYzel):Boolean; function RebroZep(Rebro:TRebro):Boolean; procedure ZepYzelADD(const IndexYzel:integer;var ZepYzel:TYzelList;var ZepRebro:TRebroList); procedure ZepRebroADD(const IndexYzel:integer;const IndexRebro:integer;var ZepYzel:TYzelList;var ZepRebro:TRebroList); procedure ZepRebroRemove(var ZepRebro:TRebroList;var MListRebro:TRebroList); procedure ZepYzelRemove(var ZepYzel:TYzelList;var ZepRebro:TRebroList;var MListYzel: TYzelList); public SListRebro:TRebroList; SListYzel:TYzelList; constructor Create; end;

Оба списка созданы на основе стандартного списка TObjectList с соответствующей заменой входящего в него стандартного TObject на классы TYzel и TRebro. Оба списка работают нормально- создают элементы, переставляют местами, без потери данных из рекурсивных списков, элементы рекурсивных списков находят друг друга без проблем.... короче работает все за исключение двух методов Remove и Delete. Привожу код процедуры которая вызывает ошибку
procedure TMatriza.ZepYzelRemove(var ZepYzel: TYzelList; var ZepRebro: TRebroList; var MListYzel: TYzelList); var i,j,k,m:integer; begin for i:=0 to zepYzel.Count -1 do begin j:=MListYzel.IndexOf(ZepYzel[i]); if not(yzelZep(MListYzel[j])) then for k:=0 to ZepRebro.Count -1 do begin MListYzel[j].ListRebro.Remove(ZepRebro[k]); end else MListYzel.Delete(i); end; end;

Удаление элемент из списка SListRebro происходит нормально, но стоит начать удаление SListYzel, программа сразу ругается на попытки удаления элемента из списка . Сообщение одно и тоже -invalid pointer operation
Вот и встает вопрос как грамотно удалять элементы косвенно рекурсивных списков?

← →
Германн © (2012-02-18 03:37) [1]

Все удаления из списков в цикле for надо удалять используя "обратный" цикл.
for i:=... downto...
Хотя не утверждаю, что в данном случае причина ошибки именно в этом. Слишком много ненужного кода объявлений и слишком мало нужного кода реализации.

← →
теркин © (2012-02-18 05:51) [2]

Ну как скажете объявление рабочих процедур TRebroList и TYzelList опускаю, они полностью совпадают со стандартными процедурами TObjecList с соответствующими заменами, а вот нерабочая функция Remove объекта TYzelList объявлена так:
function TYzelList.Remove(AYzel: TYzel): Integer; begin Result := inherited Remove(AYzel); end;
для TRebroList та же функция, объявлена почти точно так же:
function TRebroList.Remove(ARebro: TRebro): Integer; begin Result := inherited Remove(ARebro); end;
Эта функция работает все в порядке.

← →
Ega23 © (2012-02-18 08:16) [3]

1. Узел - Node, Ребро - Edge. Либо соблюдай везде аглицкую нотацию, либо перепиши свои методы и классы:
TYzel = class (...) function Dobavit() procedure Udalit constructor Cozdat

2.

function Add(AYzel: TYzel): Integer; function Extract(Item: TYzel): TYzel; function Remove(AYzel: TYzel): Integer; function IndexOf(AYzel: TYzel): Integer; function FindInstanceOf(AClass: TClass; AExact: Boolean = True; AStartAt: Integer = 0): Integer; procedure Insert(Index: Integer; AYzel: TYzel); function First: TYzel; function Last: TYzel;

Зачем? Тебе достаточно взять взять TObjectList и переобъявить свойство Items:

TNodeList = class (TObjectList) private function GetItem(Value: Integer): TNode; public property Items[Index: Integer]: TNode read GetItem; default; end; function TNodeList.GetItem(Value: Integer): TNode; begin Result := TNode(inherited Items[Value]); end;

3. Сообщение одно и тоже -invalid pointer operation

С вероятностью 99% был вызван деструктор объекта, он отработал, а потом отработала нотификация в твоиз доморощенных списках. И через нотификацию он попытался вызвать деструктор ещё один раз.

← →
теркин © (2012-02-18 13:17) [4]

То что классы объявлены именно так как они объявлены, прочитал где то, что простая замена в исходном классе TObjectList класса TObject на прямого наследника от TObject делает список полностью работоспособным и предоставляет все свойства и методы из объекта замены. Так и сделал и без косвенной рекурсии все работает так как надо. Понятно что простое решение не самое хорошее(оно корявое,тупое называйте его как хотите), но другого у меня нет(кто не дойдет летая - дойдет хромая, хромать не грех). Поэтому и прошу у людей которые умнее чем я объяснить источник возникновения ошибки. Сейчас напишу в деструкторе защиту try.. except и проверю Ваши 99%.

← →
RWolf © (2012-02-18 13:24) [5]

> Понятно что простое решение не самое хорошее

это не простое решение, как раз с TObjectList"ом будет проще и лучше.

← →
Ega23 © (2012-02-18 13:38) [6]

> Понятно что простое решение не самое хорошее

Если ты внимательно помотришь на реализацию TObjectList, то увидишь, что это обычный потомок TList. Только не надо Notify перекрывать и деструктор вызывать.

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

← →
теркин © (2012-02-18 15:12) [7]

Введение защиты в деструктор ничего не дает ошибка та же самая, так что остался 1%.Замена метода Delete на Extract решает проблему и устраняет ошибку, правда непонятно как.

← →
Ega23 © (2012-02-18 15:19) [8]

> Введение защиты в деструктор ничего не дает ошибка та же
> самая, так что остался 1%

А я смотрю, ты серьёзный специалист.

Тогда как ты объяснишь вот это:

unit Unit36; interface uses Windows, Messages, SysUtils, Variants, Classes, Graphics, Controls, Forms, Dialogs, StdCtrls, Grids, DBGrids; type TForm36 = class(TForm) Button1: TButton; procedure Button2Click(Sender: TObject); private { Private declarations } public { Public declarations } end; TSomeObj = class (TObject) public procedure Foo(); destructor Destroy; override; end; var Form36: TForm36; implementation {$R *.dfm} procedure TForm36.Button2Click(Sender: TObject); begin with TSomeObj.Create do try Free; finally Free; end; end; { TSomeObj } destructor TSomeObj.Destroy; begin try Foo; inherited; except ShowMessage("except"); end; end; procedure TSomeObj.Foo; begin Beep; end; end.

← →
теркин © (2012-02-18 16:02) [9]

Да какой специалист, о чем Вы говорите пол года назад начал изучать Delphi и язык паскаль для меня мало знаком. Пол года назад на этом же форуме обсуждал как работать с динамическими массивами, также с косвенной рекурсией, сейчас доросли до динамических списков. Комментировать программы рад бы если бы мог, знаний честно - ноль. Только для кода:
procedure TForm36.Button2Click(Sender: TObject); begin with TSomeObj.Create do try Free; finally Free; end; end;
совершенно непонятно для чего создавать объект, чтобы его проверить не равен ли он nil, для того чтобы его (не созданный объект) удалить получив при этом звуковой сигнал. Если честно я не знаю будет ли объект на основе TSomeObj создан вообще или будет ли он равен nil. Цели этой программы я не вижу никакой по моему будет работать ShowMessage("except"). Вот весь комментарий.

← →
Ega23 © (2012-02-18 16:18) [10]

> Да какой специалист, о чем Вы говорите

Да понятно что никакой. Никаких иллюзий на этот счёт.

> совершенно непонятно для чего создавать объект, чтобы его
> проверить не равен ли он nil, для того чтобы его (не созданный
> объект) удалить получив при этом звуковой сигнал.

Ну если ты не понял, то поясняю: это тупой тестовый пример, который демонстрирует, что будет при повторном вызове деструктора у одного экземпляра класса. То, о чём я писал в [3] и что было пропущено мимо ушей.

> Цели этой программы я не вижу никакой по моему будет работать
> ShowMessage("except"). Вот весь комментарий.

Тебе уже намекнули: выброси "по-моему", "я так считаю", "нужно сделать вот так и с помощью этого". Вот лучше взял бы и посмотрел, что этот код делает. Какое исключение получает. Отрабатывает и try..except в деструкторе при повторном его вызове или нет.

← →
теркин © (2012-02-18 16:19) [11]

> Вобщем, начни с того, что изложи внятно задачу: что конкретно
> тебе надо получить

Задача то из графов. Из исходного списка ребер и узлов (они загружаются из базы данных) необходимо удалить все изолированные узлы, простые и изолированные цепи. Все простые цепи заменить на эквивалентные, все кратные ребра заменить на эквивалентные. На основе этого графа получить главные циклы. Потом когда граф будет полностью описан решить на основе него системы нелинейных уравнений методом Ньютона либо контурным либо узловым методом. Необходимо показать все удаленные узлы и ребра не замененных на эквивалентные как ошибочные. Потом полученное решение обратно передать в базу данных.Вот все решение, которое нужно.

← →
Ega23 © (2012-02-18 16:50) [12]

> Задача то из графов.

Это понятно.

Способов описать граф - много.
Например. Каждый узел обладает своим идентификатором в БД (ID). Соответственно, у каждого узла есть список ID узлов, с которым он соединён (в случае ребра) или 2 списка входящих и исходящих дуг.
Можно и список объектов хранить. Только сами листы переписывать не имеет смысла, обычного тут вполне достаточно.

TNode = class (TObject) private FItems: TList; public constructor Create; destructor Destroy; override; procedure AddEdge(aNode: TNode); overload; procedure AddEdge(aNodesList: TList); overload; procedure DeleteEdge(aNode: TNode); property Items[Index: Integer]: TNode read GetItem; default; property Count: Integer read GetCount; function IndexOf(Node: TNode): Integer; end;

Ну и TObjectList, в котором эти ноды сидят.

Чего-то такого, вроде как, вполне достаточно.

← →
теркин © (2012-02-18 18:08) [13]

> Способов описать граф - много.

Точно способов много, да вот тут есть одна нехорошая гадость,большого выбора способа задания графа нет. На входе жесткий документ(бумага) и схема, на выходе твердая копия, тоже документ жесткий. Оба документа реберные изначально. Документа описывающего узлы нет и выбор способа задания узлов произвольное. Доступный способ решение нелинейных уравнений описан на матрице инциденций и циклов а не матрице смежности. Короче все подталкивает на реберный способ. На счет ID так все и работает, только ID уже очень хитрый, он не позволяет вводить кратные ребра и петли и заранее позволяет пометить хорды, там хитростей много. Эта программа действующая и опробованная на реальных но очень маленьких системах, и все математические алгоритмы заложенные в нее изначально идут тупые и работают медленно. Для 100 ребер производительность еще приемлемая, а вот сейчас у системы 7500 ребер и решение приходится ждать почти сутки. Сейчас идет модификация алгоритмов и применение вместо динамических массивов списков, на них большая надежда.
То что Вы предлагаете несомненно компактней и наверняка будет работать на порядок устойчивей (в смысле ошибок, да и во всех остальных), но согласитесь очень соблазнительно получать все свойства ребер и узлов тупой заменой, тем более что понятия нет никакого как работают списки, а прямая копия и замена не требует никакого понимания и дает результаты на порядок лучше чем динамические массивы не требуя при этом длительного времени на разработку. Появившиеся проблемы устранить при помощи специалистов с незначительной модификацией исходного кода. С такой надеждой к Вам и обращаются.

← →
Ega23 © (2012-02-18 18:15) [14]

> теркин © (18.02.12 18:08) [13]

Я ничего не понял.

С двойным вызовом деструктора и invalid pointer operation - вопросы ещё есть?

За объяснение о повторном вызове деструктора что приводит к ошибке большое спасибо. Объяснили популярно. Вами предложен выход на основе переопределения класса наверняка рабочий, сейчас начну проверку работоспособности. В самом начале наивно думалось, что кто то объяснит как переопределить метод Delete класса TList, так чтобы все работало без ошибок, тем более что возможность его полного перекрытия существует.

Не нужно никакой Delete перекрывать.
1. У TList есть метод Notify. Вот его "перекрыть" - можно.
2. Я бы вообще не листом пользовался, а скрыл бы его в приват, оставив в public только методы обращения к нему.
3. Распиши на бумажке, как должны гулять данные в твоей системе. Вот возьми и разрисуй. И станет самому предельно ясно, где нужно просто указатель из списка удалить, где удалить указатель и вызвать по нему деструктор и т.п.

На счет скрыть в privat(ценное указание) так и сделаю их вообще видно не будет вместе с их свойствами, public они временно, пока необходимо видеть результаты их работы.
На счет

> Распиши на бумажке, как должны гулять данные в твоей системе

Если есть какая то литература как это сделать подскажите, а не то приходится пользоваться матричной информационной моделью, которая таких тонкостей не покрывает(вернее покрывает если будет многомерной- но это геморрой страшный).

> У TList есть метод Notify. Вот его "перекрыть" - можно.

Notify-это что это такое, как его скушать, если есть литература подскажите.
Честно нет ни какого желания пользоваться чужими кодами, тем более если не понимаешь как они работают. Когда дают готовый код (большое Вам конечно спасибо) это делает тупее. А когда говорят куда копать(как с Notify вместо Delete) для головы намного полезнее.

А TInterfaceList не спасет от AV при множественных удалениях?

> А TInterfaceList не спасет от AV при множественных удалениях?

Если от TInterfacedObject наследоваться, либо _Add и _Release перекрывать с реализацией IUnknown.
Вроде так.

Всем кто принял участие в обсуждении большое спасибо. Ega23 благодарю отдельно, за то что вразумил дитятку неразумного, как говорится -".. от глубины до слез...".

Удаление элементов косвенно рекурсивных списков Найти похожие ветки