OberonCore https://forum.oberoncore.ru/ |
|
BB (DLL) - Delphi https://forum.oberoncore.ru/viewtopic.php?f=2&t=132 |
Страница 1 из 3 |
Автор: | Андрей [ Четверг, 16 Март, 2006 12:32 ] |
Заголовок сообщения: | BB (DLL) - Delphi |
Столкнулся с неожиданной проблемой. Реализовал на BB систему нечеткой логики с возможностью загрузки нечеткой модели из fis-файла Matlab. Для этого пришлось написать примитивнейший вариант модуля для работы с Ini - файлом (fis - файл есть ни что иное, как Ini - файл), используя некоторые стандартные модули BB. Это мой первый проект на BB. Как ни странно, все прекрасно работает. Но только внутри самого BB! Мне же необходимо привязать все это к Delphi через DLL. DLL компонуется, но при вызове процедуры генерируется исключение. Код на Delphi: Код: procedure TForm1.Button1Click(Sender: TObject); var h: cardinal; dllwork: procedure(); begin h := LoadLibrary('MyDll.dll'); @dllwork := GetProcAddress(h, 'Work'); if @dllwork <> nil then begin dllwork(); end; end; Код на CP: Код: MODULE MyIni; (*FuzzyModel*)
IMPORT Dialog, Files, TextModels, TextViews, Stores, Converters, FuzzyFIS, FuzzyModel; PROCEDURE Work*(); VAR loc: Files.Locator; name: Files.Name; t: TextModels.Model; fisFile: Files.File; conv: Converters.Converter; s: Stores.Store; fis: FuzzyFIS.FIS; out: ARRAY 2 OF REAL; (*i: INTEGER;*) in: ARRAY 3 OF REAL; mm: FuzzyModel.MamdaniModel; BEGIN t := NIL; loc := NIL; name := ""; Dialog.GetIntSpec("fis", loc, name); IF loc # NIL THEN fisFile := Files.dir.Old(loc, name, Files.shared); IF loc.res = 0 THEN Converters.Import(loc, name, conv, s); IF (s # NIL) & (s IS TextViews.View) THEN t := s(TextViews.View).ThisModel(); fis.LoadFrom(t); mm.Init(fis); in[0] := 6.894; in[1]:= 10.88; in[2]:= 0.5985; mm.Compute(in, out); (* FOR i := 0 TO LEN(out) - 1 DO StdLog.Real(out[i]); StdLog.Ln; END; *) END END END END Work; END MyIni. DLL компонуется командой DevLinker.LinkDynDll MyDll.dll := Kernel+ Files StdLoader Log Dialog Services Fonts Math Strings Stores Meta Converters Ports Sequencers Models Views Controllers Properties Mechanisms Containers TextModels Properties Containers Dates Printers Printing TextRulers TextSetters TextViews TextMappers IniFile FuzzyFIS FuzzySets FuzzyModel MyIni$# В чем моя ошибка? |
Автор: | Trurl [ Четверг, 16 Март, 2006 12:47 ] |
Заголовок сообщения: | |
Одна ошибка видна сразу - нет HostFiles. |
Автор: | Илья Ермаков [ Четверг, 16 Март, 2006 12:53 ] |
Заголовок сообщения: | |
Другая ошибка: dllwork: procedure(), stdcall, т.к. BlackBox по умолачнию использует соглашение stdcall. |
Автор: | Андрей [ Четверг, 16 Март, 2006 13:18 ] |
Заголовок сообщения: | |
Добавление HostFiles и dllwork: procedure(); stdcall; не помогло. Может тут дело в импорте стандартных BB модулей? Ведь стоит этот импорт убрать (то есть реализовать простую DLL) и все работает! А мне без него не обойтись - так не хочется связываться с WinApi, да и времени нет. [/code] |
Автор: | Сергей Губанов [ Четверг, 16 Март, 2006 14:39 ] |
Заголовок сообщения: | |
Попробуйте для начала процедуру Work сделать "безобидной" (чтоб она ничего не делала). Если Delphi всё равно будет падать, значит проблема точно не внутри Work. Потом, потихоньку добавляйте функциональность внутрь Work до того момента пока не начнёт падать... ______________ P.S. В дельфийский код не мешало бы еще добавить CloseHandle(h)... |
Автор: | Trurl [ Четверг, 16 Март, 2006 15:43 ] |
Заголовок сообщения: | |
Илья Ермаков писал(а): Другая ошибка:
dllwork: procedure(), stdcall, т.к. BlackBox по умолачнию использует соглашение stdcall. Для процедур без параметров разницы никакой. А где находится эта MyDll.dll? Если отдельно от ББ, то надо прилинковать значительную часть Host. По крайней мере HostFiles HostRegistry HostFonts HostDialog HostTextConv. |
Автор: | Илья Ермаков [ Четверг, 16 Март, 2006 17:12 ] |
Заголовок сообщения: | |
Да, DLL должна либо лежать в окружениии стандартных подсисем, либо прилинковывать все необходимое статически. |
Автор: | Андрей [ Пятница, 17 Март, 2006 11:23 ] |
Заголовок сообщения: | |
Опыты, проведенные над процедурой Work по совету Сергея Губанова, дали следующие результаты: 1) Пустая процедура Work с такими же локльными переменными такого же модуля с таким же импортом выполняется успешно. При чем как в окружении cтандартных подсисем BB, так и без него. 2) Простое добавление Код: t := NIL; loc := NIL; name := ""; вызывает ошибку при вызове в Delphi.Dialog.GetIntSpec("fis", loc, name); 3) Если заменить вызов диалога на Код: PROCEDURE PathToLoc (IN path: ARRAY OF CHAR; OUT loc: Files.Locator); - ошибка не исчезнет.VAR i, j: INTEGER; ch: CHAR; name: ARRAY 256 OF CHAR; BEGIN loc := Files.dir.This(""); IF path # "" THEN i := 0; j := 0; REPEAT ch := path[i]; INC(i); IF (ch = "/") OR (ch = 0X) THEN name[j] := 0X; j := 0; loc := loc.This(name) ELSE name[j] := ch; INC(j) END UNTIL (ch = 0X) OR (loc.res # 0) END END PathToLoc; ............................................................................................... name := "mamd.fis"; PathToLoc("D:/Tools/Matlab7/work", loc); 4) Все это линковалось командой DevLinker.LinkDynDll MyDll.dll := Kernel+ Files StdLoader Log Dialog Fonts Services Fonts Math Strings Stores Meta Converters Ports Sequencers Models Views Controllers Properties Mechanisms Containers TextModels Properties Containers Dates Printers Printing TextRulers TextSetters TextViews TextMappers IniFile FuzzyFIS FuzzySets FuzzyModel MyIni$# HostFiles Documents Windows HostRegistry HostFonts HostPorts OleData HostMechanisms HostWindows HostPrinters StdDialog StdApi StdCmds StdCFrames HostCFrames HostClipboard HostDialog HostTextConv и загружаемая dll лежала как в окружении BB, так и в без него. 5) Даже после успешного выполнения пустой процедуры Work, вызов CloseHandle(h) генерирует такое же исключение... 6) Если в исходный модуль добавить строки Код: BEGIN и командой
Work; END MyIni. DevLinker.Link MyDll.exe := Kernel+ Files StdLoader Log Dialog Fonts Services Fonts Math Strings Stores Meta Converters Ports Sequencers Models Views Controllers Properties Mechanisms Containers TextModels Properties Containers Dates Printers Printing TextRulers TextSetters TextViews TextMappers IniFile FuzzyFIS FuzzySets FuzzyModel MyIni$ HostFiles Documents Windows HostRegistry HostFonts HostPorts OleData HostMechanisms HostWindows HostPrinters StdDialog StdApi StdCmds StdCFrames HostCFrames HostClipboard HostDialog HostTextConv сгенерировать Exe - шник, его выполнение вызовет исключение "Исключение unknown software exception (0x80000003) в приложении по адресу..." после чего прога сама не завершится. Опять же... пустая процедура Work работает. 7) Исключение в Delphi - "Access violation at address ... in module 'MyDll.dll. Read of address ...'" |
Автор: | Сергей Губанов [ Пятница, 17 Март, 2006 11:52 ] |
Заголовок сообщения: | |
Андрей писал(а): 5) Даже после успешного выполнения пустой процедуры Work, вызов CloseHandle(h) генерирует такое же исключение...
То есть ошибка, на самом деле, находится вне Work. Надо подумать... |
Автор: | Trurl [ Пятница, 17 Март, 2006 13:14 ] |
Заголовок сообщения: | |
Попробуйте в список импорта добавить HostDialog. |
Автор: | Илья Ермаков [ Пятница, 17 Март, 2006 14:51 ] |
Заголовок сообщения: | |
А если попробовать подключать DLL статически, через procedure Do; external 'MyDLL'? И еще - LinkDynDll может иметь некоторые особенности - в документации где-то было написано, что "редко используется, добавлена для полноты", если попробовать использовать просто LinkDll? |
Автор: | Илья Ермаков [ Пятница, 17 Март, 2006 15:14 ] |
Заголовок сообщения: | |
Э, батенька, кажется, нашел я ошибку! Вы главным модулем ($) пометили свой модуль - но если Вы используете механизмы динамической загрузки BlackBox, то главный всегда - Kernel. Естественно, он у вас не инициализировался, и весь Run-Time не работал. Вот, читаем: DevLinker.LinkDynDll (редко используется, представлено для полноты) Компонует набор модулей, включающий динамический загрузчик модулей, в dll-файл. Когда dll подключается к процессу, вызывается тело главного модуля. Когда dll освобождается процессом, вызывается окончание (секция CLOSE) главного модуля. ВОТ: Инициализация и прерывание всех остальных модулей должны выполняться подсистемой времени выполнения. А У ВАС ИНИЦИАЛИЗАЦИЯ ВСЕХ МОДУЛЕЙ ББ не проходила вообще. Допустимые настройки: $ + # Если линкуем без расширяемости, то попроще, т.к. инициализация пройдет в том порядке, в каком модули были в нашем списке: DevLinker.LinkDll Компонует нерасширяемый набор модулей в dll-файл. Когда dll подключается к процессу, тела всех модулей вызываются в правильном порядке. Когда dll освобождается процессом, окончания (секции CLOSE) всех модулей вызываются в обратном порядке. Никакой подсистемы времени выполнения не требуется для инициализации и завершения. Допустимые настройки: + # В принципе, я думаю, что можно попробовать собрать и ваш набор , модулей с Kernel, через простой LinkDll, только нельзя включать в список StdLoader. |
Автор: | Андрей [ Пятница, 17 Март, 2006 18:46 ] |
Заголовок сообщения: | |
Если главным модулем назначить Kernel, то библиотека по LoadLibrary вообще не грузится - возвращается нулевой дескриптор. Импортирование HostDialog тоже не помогает. Если линковать без StdLoader (впрочем, как и с ним) командой LinkDll, и прицепить такую dll статически, то при запуске проги на Delphi возникает ошибка "Ошибка инициализации приложения". Если такую dll грузить динамически по LoadLibrary, также возвращается нулевой дескриптор. (( |
Автор: | Сергей Оборотов [ Суббота, 18 Март, 2006 06:25 ] |
Заголовок сообщения: | |
Жаль, что нельзя увидеть код целиком. Надеюсь, эта ошибка когда-нибудь будет исправлена. P.S. Вместо CloseHandle лучше использовать FreeLibrary, однако. P.P.S. Андрей, это не вполне тот вариант. Вы выложите его здесь, а кому интересно будут отвечать. Тоже здесь. |
Автор: | Андрей [ Суббота, 18 Март, 2006 09:29 ] |
Заголовок сообщения: | |
Почему же нельзя? Если это кому-то действительно интересно - дайте адрес, я вышлю архивом. |
Автор: | Андрей [ Вторник, 21 Март, 2006 10:21 ] |
Заголовок сообщения: | |
Нечеткие множества: Код: MODULE FuzzySets;
(**îïèñàíèå òèïîâ íå÷åòêèõ ìíîæåñòâ**) TYPE (**àáñòðàêòíîå íå÷åòêîå ìíîæåñòâî**) FuzzySet* = ABSTRACT RECORD END; (**òðåóãîëüíîå íå÷åòêîå ìíîæåñòâî**) Triangle* = RECORD(FuzzySet) a, b, c: REAL END; (**òðàïåöèèäàëüíîå íå÷åòêîå ìíîæåñòâî**) Trapezoid* = RECORD(FuzzySet) a, b, c, d: REAL END; (**äðóãèå âèäû íå÷åòêèõ ìíîæåñòâ ìîãóò áûòü îïðåäåëåíû â ñëåäóþùèõ âåðñèÿõ ìîäóëÿ**) (**îïðåäåëåíèå ôóíêöèé ïðèíàäëåæíîñòè íå÷åòêèõ ìíîæåñòâ**) (**àáñòðàêòíàÿ ôóíêöèÿ ïðèíàäëåæíîñòè**) PROCEDURE (VAR fs: FuzzySet) MF* (x: REAL): REAL, NEW, ABSTRACT; (**ôóíêöèÿ ïðèíàäëåæíîñòè òðåóãîëüíîãî íå÷åòêîãî ìíîæåñòâà**) PROCEDURE (VAR tri: Triangle) MF* (x: REAL): REAL; BEGIN (*òðåóãîëüíèê ìîæåò âûðîæäàòüñÿ â ëèíèþ*) IF (tri.a = tri.b) & (tri.b = tri.c) THEN IF (x = tri.a) THEN RETURN 1 ELSE RETURN 0 END END; IF (tri.a = tri.b) THEN IF (tri.b <= x) & (x <= tri.c) THEN RETURN ((tri.c - x) / (tri.c - tri.b)) ELSE RETURN 0 END END; IF (tri.b = tri.c) THEN IF (tri.a <= x) & (x <= tri.b) THEN RETURN ((x - tri.a) / (tri.b - tri.a)) ELSE RETURN 0 END END; RETURN MAX(MIN((x - tri.a) / (tri.b - tri.a), (tri.c - x) / (tri.c - tri.b)), 0) END MF; (**ôóíêöèÿ ïðèíàäëåæíîñòè òðàïåöèèäàëüíîãî íå÷åòêîãî ìíîæåñòâà**) PROCEDURE (VAR trap: Trapezoid) MF* (x: REAL): REAL; VAR y1, y2: REAL; BEGIN y1 := 0; y2 := 0; (*òðàïåöèÿ ìîæåò âûðîæäàòüñÿ â òðåóãîëüíèê*) IF (trap.b <= x) THEN y1 := 1 ELSIF (x < trap.a) THEN y1 := 0 ELSIF (trap.a # trap.b) THEN y1 := (x - trap.a) / (trap.b - trap.a) END; IF (x <= trap.c) THEN y2 := 1 ELSIF (trap.d < x) THEN y2 := 0 ELSIF (trap.c # trap.d) THEN y2 := (trap.d - x) / (trap.d - trap.c) END; RETURN MIN(y1, y2) END MF; (**îïðåäåëåíèå ôóíêöèé èíèöèàëèçàöèè íå÷åòêèõ ìíîæåñòâ**) (**óñòàíîâêà ïàðàìåòðîâ òðåóãîëüíîãî íå÷åòêîãî ìíîæåñòâà**) PROCEDURE (VAR tri: Triangle) SetParams* (a, b, c: REAL), NEW; BEGIN ASSERT(~(a > b) & ~(b > c)); tri.a := a; tri.b := b; tri.c := c END SetParams; (**óñòàíîâêà ïàðàìåòðîâ òðàïåöèèäàëüíîãî íå÷åòêîãî ìíîæåñòâà**) PROCEDURE (VAR trap: Trapezoid) SetParams* (a, b, c, d: REAL), NEW; BEGIN ASSERT(~(a > b) & ~(b > c) & ~(c > d)); trap.a := a; trap.b := b; trap.c := c; trap.d := d END SetParams; (**äèíàìè÷åñêîå ðàçìåùåíèå òðåóãîëüíîãî íå÷åòêîãî ìíîæåñòâà**) PROCEDURE NewTriangle* (a, b, c: REAL): POINTER TO FuzzySet; VAR tri: POINTER TO Triangle; BEGIN NEW(tri); tri.SetParams(a, b, c); RETURN tri END NewTriangle; (**äèíàìè÷åñêîå ðàçìåùåíèå òðàïåöèèäàëüíîãî íå÷åòêîãî ìíîæåñòâà**) PROCEDURE NewTrapezoid* (a, b, c, d: REAL): POINTER TO FuzzySet; VAR trap: POINTER TO Trapezoid; BEGIN NEW(trap); trap.SetParams(a, b, c, d); RETURN trap END NewTrapezoid; (**îïåðàöèè íàä íå÷åòêèìè ìíîæåñòâàìè**) (*ïåðåñå÷åíèå*) PROCEDURE Crossing* (IN Lset, Rset: FuzzySet; x: REAL): REAL; BEGIN RETURN MIN(Lset.MF(x), Rset.MF(x)); END Crossing; (*îáúåäèíåíèå*) PROCEDURE Association* (IN Lset, Rset: FuzzySet; x: REAL): REAL; BEGIN RETURN MAX(Lset.MF(x), Rset.MF(x)); END Association; (*äîïîëíåíèå*) PROCEDURE Not* (IN set: FuzzySet; x: REAL): REAL; BEGIN RETURN (1 - set.MF(x)); END Not; END FuzzySets. |
Автор: | Андрей [ Вторник, 21 Март, 2006 10:33 ] |
Заголовок сообщения: | |
Сорри за комментарии, какие-то проблемы с кодировками, решать их некогда, поэтому лучше удалю их вообще... Нечеткая модель (пока реализована только модель Мамдани): Код: MODULE FuzzyModel;
IMPORT FuzzySets, FuzzyFIS; TYPE Rule = RECORD Prem, Concl: POINTER TO ARRAY OF Label; PremMethod: PROCEDURE (x, y: REAL): REAL END; Label = RECORD ToLingVar, ToTerm: INTEGER; END; TYPE InLingVar = EXTENSIBLE RECORD Term: POINTER TO ARRAY OF POINTER TO FuzzySets.FuzzySet; END; OutLingVar = RECORD (InLingVar) Min, Max, dx : REAL; END; TYPE Model* = ABSTRACT RECORD Rule: POINTER TO ARRAY OF Rule; InVar: POINTER TO ARRAY OF InLingVar; OutVar: POINTER TO ARRAY OF OutLingVar; ImplMethod: PROCEDURE (x, y: REAL): REAL; END; SugenoModel* = RECORD (Model) END; MamdaniModel* = RECORD (Model) Figure: POINTER TO ARRAY OF POINTER TO Figure; NoNul: POINTER TO ARRAY OF BOOLEAN; AggMethod: PROCEDURE (x, y: REAL): REAL; DefuzzMethod: PROCEDURE (IN figure: Figure; min, dx: REAL): REAL END; TYPE Figure = ARRAY OF REAL; (*ìàññèâ òî÷åê*) PROCEDURE Min (x, y: REAL): REAL; BEGIN RETURN MIN(x, y) END Min; PROCEDURE Max (x, y: REAL): REAL; BEGIN RETURN MAX(x, y) END Max; PROCEDURE (VAR this: Model) Implication (IN InVars: ARRAY OF REAL; IN rule: Rule): REAL, NEW; VAR i, v, t: INTEGER; mf, val: REAL; BEGIN v := rule.Prem[0].ToLingVar; t := rule.Prem[0].ToTerm; IF t > 0 THEN val := this.InVar[v].Term[t-1].MF(InVars[v]); ELSE val := 1 - this.InVar[v].Term[2*t-t-1].MF(InVars[v]); END; FOR i := 1 TO LEN(rule.Prem) - 1 DO v := rule.Prem[i].ToLingVar; t := rule.Prem[i].ToTerm; IF t > 0 THEN mf := this.InVar[v].Term[t - 1].MF(InVars[v]); ELSE mf := 1 - this.InVar[v].Term[ABS(t) - 1].MF(InVars[v]); END; val := rule.PremMethod(val, mf); END; RETURN val; END Implication; PROCEDURE Yes (VAR this: MamdaniModel; v, t: INTEGER; x: REAL): REAL; BEGIN RETURN (this.OutVar[v].Term[t-1].MF(x)) END Yes; PROCEDURE Not (VAR this: MamdaniModel; v, t: INTEGER; x: REAL): REAL; BEGIN RETURN (1 - this.OutVar[v].Term[ABS(t) - 1].MF(x)) END Not; PROCEDURE (VAR this: MamdaniModel) NewFigure (cut: REAL; OUT figure: Figure; ToOutVar: Label), NEW; VAR i, v, t: INTEGER; mf, x: REAL; met: PROCEDURE (VAR this: MamdaniModel; v, t: INTEGER; x: REAL): REAL; BEGIN v := ToOutVar.ToLingVar; t := ToOutVar.ToTerm; IF t > 0 THEN met := Yes ELSE met := Not END; FOR i := 0 TO LEN(figure) - 1 DO x := this.OutVar[v].Min + i*this.OutVar[v].dx; mf := met(this, v, t, x); (*îcóùåñòâëÿåì èìïëèêàöèþ*) figure[i] := this.ImplMethod(cut, mf); END; END NewFigure; PROCEDURE (VAR this: MamdaniModel) Aggregation (cut: REAL; VAR figure: Figure; ToOutVar: Label), NEW; VAR i, v, t: INTEGER; x, mf, impl: REAL; met: PROCEDURE (VAR this: MamdaniModel; v, t: INTEGER; x: REAL): REAL; BEGIN v := ToOutVar.ToLingVar; t := ToOutVar.ToTerm; IF t > 0 THEN met := Yes ELSE met := Not END; FOR i := 0 TO LEN(figure) - 1 DO x := this.OutVar[v].Min + i*this.OutVar[v].dx; mf := met(this, v, t, x); impl := this.ImplMethod(cut, mf); figure[i] := this.AggMethod(impl, figure[i]); END; END Aggregation; PROCEDURE (VAR m: Model) Compute* (IN InVars: ARRAY OF REAL; OUT OutVars: ARRAY OF REAL), NEW, ABSTRACT; PROCEDURE (VAR m: SugenoModel) Compute* (IN InVars: ARRAY OF REAL; OUT OutVars: ARRAY OF REAL); VAR i: INTEGER; BEGIN END Compute; PROCEDURE (VAR this: MamdaniModel) Compute* (IN InVars: ARRAY OF REAL; OUT OutVars: ARRAY OF REAL); VAR i, j, k: INTEGER; cut: REAL; BEGIN ASSERT((LEN(InVars) = LEN(this.InVar)) & (LEN(OutVars) = LEN(this.OutVar))); FOR i := 0 TO LEN(this.Rule) - 1 DO cut := this.Implication(InVars, this.Rule[i]); FOR j := 0 TO LEN(this.Rule[i].Concl) - 1 DO k := 0; WHILE (k < LEN(this.OutVar)) & (ABS(this.Rule[i].Concl[j].ToLingVar) # k) DO INC(k) END; IF ABS(this.Rule[i].Concl[j].ToLingVar) = k THEN IF ~this.NoNul[k] THEN this.NewFigure(cut, this.Figure[k], this.Rule[i].Concl[j]); this.NoNul[k] := TRUE ELSE this.Aggregation(cut, this.Figure[k], this.Rule[i].Concl[j]) END; END; END; END; FOR i := 0 TO LEN(this.OutVar) - 1 DO IF this.Figure[i] # NIL THEN OutVars[i] := this.DefuzzMethod(this.Figure[i], this.OutVar[i].Min, this.OutVar[i].dx) END; END; FOR i := 0 TO LEN(this.OutVar) - 1 DO this.NoNul[i] := FALSE END; END Compute; PROCEDURE Centroid (IN figure: Figure; min, dx: REAL): REAL; VAR i: INTEGER; x, num, den: REAL; BEGIN num := 0; den := 0; FOR i := 0 TO LEN(figure) - 1 DO den := den + figure[i]; num := num + figure[i] * (min + dx*i); END; RETURN (num/den); END Centroid; PROCEDURE (VAR m: MamdaniModel) Init* (IN fis: FuzzyFIS.FIS), NEW; VAR i, j, NumLabel, k: INTEGER; BEGIN ASSERT(fis.ModelType = 'mamdani'); NEW(m.InVar, LEN(fis.InMFsParamReal)); NEW(m.OutVar, LEN(fis.OutMFsParamReal)); FOR i := 0 TO LEN(m.InVar) - 1 DO NEW(m.InVar[i].Term, LEN(fis.InMFsParamReal[i])); FOR j := 0 TO LEN(m.InVar[i].Term) - 1 DO IF fis.InMFsType[i, j] = 'trimf' THEN m.InVar[i].Term[j] := FuzzySets.NewTriangle( fis.InMFsParamReal[i, j, 0], fis.InMFsParamReal[i, j, 1], fis.InMFsParamReal[i, j, 2]) ELSIF fis.InMFsType[i, j] = 'trapmf' THEN m.InVar[i].Term[j] := FuzzySets.NewTrapezoid( fis.InMFsParamReal[i, j, 0], fis.InMFsParamReal[i, j, 1], fis.InMFsParamReal[i, j, 2], fis.InMFsParamReal[i, j, 3]) ELSE HALT(0) END; END; END; NEW(m.Figure, LEN(m.OutVar)); NEW(m.NoNul, LEN(m.OutVar)); FOR i := 0 TO LEN(m.OutVar) - 1 DO NEW(m.OutVar[i].Term, LEN(fis.OutMFsParamReal[i])); FOR j := 0 TO LEN(m.OutVar[i].Term) - 1 DO IF fis.OutMFsType[i, j] = 'trimf' THEN m.OutVar[i].Term[j] := FuzzySets.NewTriangle( fis.OutMFsParamReal[i, j, 0], fis.OutMFsParamReal[i, j, 1], fis.OutMFsParamReal[i, j, 2]) ELSIF fis.OutMFsType[i, j] = 'trapmf' THEN m.OutVar[i].Term[j] := FuzzySets.NewTrapezoid( fis.OutMFsParamReal[i, j, 0], fis.OutMFsParamReal[i, j, 1], fis.OutMFsParamReal[i, j, 2], fis.OutMFsParamReal[i, j, 3]) ELSE HALT(0) END; END; m.NoNul[i] := FALSE; m.OutVar[i].Min := fis.OutRange[i, 0]; m.OutVar[i].Max := fis.OutRange[i, 1]; NEW(m.Figure[i], (1000*LEN(m.OutVar[i].Term))); m.OutVar[i].dx := (m.OutVar[i].Max - m.OutVar[i].Min)/LEN(m.Figure[i]); END; NEW(m.Rule, LEN(fis.TypeImpl)); FOR i := 0 TO LEN(m.Rule) - 1 DO NumLabel := 0; FOR j := 0 TO LEN(m.InVar) - 1 DO IF fis.InRuleLabel[i, j] # 0 THEN INC(NumLabel) END; END; NEW(m.Rule[i].Prem, NumLabel); NEW(m.Rule[i].Concl, NumLabel); k := 0; FOR j := 0 TO LEN(m.InVar) - 1 DO IF fis.InRuleLabel[i, j] # 0 THEN m.Rule[i].Prem[k].ToLingVar := j; m.Rule[i].Prem[k].ToTerm := fis.InRuleLabel[i, j]; INC(k); END; END; NumLabel := 0; FOR j := 0 TO LEN(m.OutVar) - 1 DO IF fis.OutRuleLabel[i, j] # 0 THEN INC(NumLabel) END; END; NEW(m.Rule[i].Concl, NumLabel); NEW(m.Rule[i].Concl, NumLabel); k := 0; FOR j := 0 TO LEN(m.OutVar) - 1 DO IF fis.OutRuleLabel[i, j] # 0 THEN m.Rule[i].Concl[k].ToLingVar := j; m.Rule[i].Concl[k].ToTerm := fis.OutRuleLabel[i, j]; INC(k); END; END; CASE fis.TypeImpl[i] OF 1: m.Rule[i].PremMethod := Min; | 2: m.Rule[i].PremMethod := Max; ELSE HALT(0) END END; IF fis.AggMethod = "max" THEN m.AggMethod := Max ELSIF fis.AggMethod = "min" THEN m.AggMethod := Min ELSE HALT(0) END; IF fis.DefuzzMethod = "centroid" THEN m.DefuzzMethod := Centroid; ELSE HALT(0) END; IF fis.ImpMethod = "max" THEN m.ImplMethod := Max ELSIF fis.ImpMethod = "min" THEN m.ImplMethod := Min ELSE HALT(0) END; END Init; END FuzzyModel. |
Автор: | Андрей [ Вторник, 21 Март, 2006 10:38 ] |
Заголовок сообщения: | |
Модуль, необходимый для инициализации нечеткой модели из fis-файла: Код: MODULE FuzzyFIS;
IMPORT IniFile, TextModels, Strings; TYPE String = ARRAY 35 OF CHAR; FIS* = RECORD ModelType-, AndMethod-, OrMethod-, ImpMethod-, AggMethod-, DefuzzMethod-: String; InMFsParamReal-, OutMFsParamReal-: POINTER TO ARRAY OF POINTER TO ARRAY OF POINTER TO ARRAY OF REAL; OutRange-: POINTER TO ARRAY OF ARRAY 2 OF REAL; InMFsType-, OutMFsType-: POINTER TO ARRAY OF POINTER TO ARRAY OF String; InRuleLabel-, OutRuleLabel-: POINTER TO ARRAY OF ARRAY OF INTEGER; TypeImpl-: POINTER TO ARRAY OF INTEGER; END; PROCEDURE SpaceNum (IN str: ARRAY OF CHAR): INTEGER; VAR spacenum, i: INTEGER; BEGIN spacenum := 0; FOR i := 0 TO LEN(str$) - 1 DO IF str[i] = ' ' THEN INC(spacenum) END; END; RETURN spacenum; END SpaceNum; PROCEDURE StrToRealArray(IN str: ARRAY OF CHAR; OUT ra: ARRAY OF REAL); VAR i, j, start, res: INTEGER; rl: REAL; num: String; BEGIN j := 0; FOR i := 0 TO LEN(ra) - 1 DO start := j; WHILE (j <= LEN(str$)) & (str[j] # ' ') DO INC(j) END; Strings.Extract(str, start, j - start, num); Strings.StringToReal(num, rl, res); IF (res # 1) & (res # 2) THEN ra[i] := rl ELSE ra[i] := 0 END; INC(j); END; END StrToRealArray; PROCEDURE StrToIntArray(IN str: ARRAY OF CHAR; OUT ri: ARRAY OF INTEGER); VAR i, j, start, res: INTEGER; rl: INTEGER; num: String; BEGIN j := 0; FOR i := 0 TO LEN(ri) - 1 DO start := j; WHILE (j <= LEN(str$)) & (str[j] # ' ') DO INC(j) END; Strings.Extract(str, start, j - start, num); Strings.StringToInt(num, rl, res); IF (res # 1) & (res # 2) THEN ri[i] := rl ELSE ri[i] := 0 END; INC(j); END; END StrToIntArray; PROCEDURE GetLingVarSettigs (IN SectionName: String; VAR MFsParamReal: POINTER TO ARRAY OF POINTER TO ARRAY OF REAL; VAR MFsType: POINTER TO ARRAY OF String); VAR NumMFs, j, strlen, start: INTEGER; MFName: String; SettingsString, ParamString: String; BEGIN IniFile.ReadInteger(SectionName, 'NumMFs', NumMFs); NEW(MFsParamReal, NumMFs); NEW(MFsType, NumMFs); FOR j := 0 TO NumMFs - 1 DO Strings.IntToString(j+1, MFName); MFName := 'MF' + MFName; IniFile.ReadString(SectionName, MFName, SettingsString); Strings.Find(SettingsString, '[', 0, start); INC(start); strlen := LEN(SettingsString$) - start - 1; Strings.Extract(SettingsString, start, strlen, ParamString); NEW(MFsParamReal[j], SpaceNum(ParamString) + 1); StrToRealArray(ParamString, MFsParamReal[j]); Strings.Find(SettingsString, ':', 0, start); INC(start, 2); Strings.Find(SettingsString, ',', 0, strlen); DEC(strlen, start); DEC(strlen); Strings.Extract(SettingsString, start, strlen, MFsType[j]); END; END GetLingVarSettigs; PROCEDURE GetRules(VAR fis: FIS; NumRules, NumInputs, NumOutputs: INTEGER); VAR ParamString: String; start, strlen, i, res: INTEGER; strs: POINTER TO ARRAY OF String; BEGIN NEW(fis.InRuleLabel, NumRules, NumInputs); NEW(fis.OutRuleLabel, NumRules, NumOutputs); NEW(fis.TypeImpl, NumRules); NEW(strs, NumRules); IniFile.ReadSection('Rules', strs); FOR i := 0 TO NumRules - 1 DO Strings.Find(strs[i], ',', 0, start); INC(start, 2); Strings.Find(strs[i], '(', 0, strlen); DEC(strlen, start); DEC(strlen); Strings.Extract(strs[i], start, strlen, ParamString); StrToIntArray(ParamString, fis.OutRuleLabel[i]); strlen := start - 2; Strings.Extract(strs[i], 0, strlen, ParamString); StrToIntArray(ParamString, fis.InRuleLabel[i]); Strings.Find(strs[i], ':', 0, start); INC(start, 2); strlen := LEN(strs[i]$) + 1 - start; Strings.Extract(strs[i], start, strlen, ParamString); Strings.StringToInt(ParamString, fis.TypeImpl[i], res); END; END GetRules; PROCEDURE ReadString(IN variable: ARRAY OF CHAR; OUT res: ARRAY OF CHAR); VAR str: String; i, j: INTEGER; BEGIN IniFile.ReadString('System', variable, str); j := 0; FOR i := 0 TO LEN(str$) - 1 DO IF str[i] # "'" THEN res[j] := str[i]; INC(j) END; END; END ReadString; PROCEDURE (VAR fis: FIS) LoadFrom* (t: TextModels.Model), NEW; VAR i, NumInputs, NumOutputs, NumRules: INTEGER; SectionName, Range: String; stop: INTEGER; str: ARRAY 4 OF CHAR; BEGIN IniFile.ConnectTo(t); ReadString('Type', fis.ModelType); ReadString('AndMethod', fis.AndMethod); ReadString('OrMethod', fis.OrMethod); ReadString('ImpMethod', fis.ImpMethod); ReadString('AggMethod', fis.AggMethod); ReadString('DefuzzMethod', fis.DefuzzMethod); IniFile.ReadInteger('System', 'NumInputs', NumInputs); IniFile.ReadInteger('System', 'NumOutputs', NumOutputs); IniFile.ReadInteger('System', 'NumRules', NumRules); NEW(fis.InMFsParamReal, NumInputs); NEW(fis.InMFsType, NumInputs); FOR i := 0 TO NumInputs - 1 DO Strings.IntToString(i+1, str); SectionName := 'Input' + str; GetLingVarSettigs(SectionName, fis.InMFsParamReal[i], fis.InMFsType[i]) END; NEW(fis.OutMFsParamReal, NumOutputs); NEW(fis.OutMFsType, NumOutputs); NEW(fis.OutRange, NumOutputs); FOR i := 0 TO NumOutputs - 1 DO Strings.IntToString(i+1, str); SectionName := 'Output' + str; GetLingVarSettigs(SectionName, fis.OutMFsParamReal[i], fis.OutMFsType[i]); IniFile.ReadString(SectionName, 'Range', Range); Strings.Find(Range, ']', 0, stop); Strings.Extract(Range, 0, stop, Range); StrToRealArray(Range, fis.OutRange[i]); END; GetRules(fis, NumRules, NumInputs, NumOutputs); END LoadFrom; END FuzzyFIS. |
Автор: | Андрей [ Вторник, 21 Март, 2006 10:42 ] |
Заголовок сообщения: | |
И последнее, чтение fis-файла (или любого другого ini-файла) (а точнее, текстовой модели, ассоциированной с этим файлом): Код: MODULE IniFile;
IMPORT TextModels, TextMappers, Strings; CONST defdelimiter = '='; sectiontag = '['; endstring = 0DX; VAR scan: TextMappers.Scanner; delimiter*: CHAR; TYPE String* = ARRAY 256 OF CHAR; PROCEDURE ReadLn (OUT str: ARRAY OF CHAR); VAR ch: CHAR; i: INTEGER; BEGIN scan.rider.ReadChar(ch); i := 0; WHILE (ch # endstring) & (~scan.rider.eot) & (i < 256) DO str[i] := ch; scan.rider.ReadChar(ch); INC(i); END; str[i] := 0X; END ReadLn; PROCEDURE FindSection (IN SectionName: ARRAY OF CHAR): BOOLEAN; VAR compstr, str: String; i: INTEGER; BEGIN compstr := '[' + SectionName + ']'; scan.SetPos(0); ReadLn(str); WHILE (compstr # str) & (~scan.rider.eot) DO ReadLn(str) END; RETURN ~(compstr # str); END FindSection; PROCEDURE FindVar (IN SectionName: ARRAY OF CHAR; IN varname: ARRAY OF CHAR): BOOLEAN; VAR ch, newsec: CHAR; equal: BOOLEAN; str: String; i: INTEGER; BEGIN equal := FALSE; IF FindSection(SectionName) THEN scan.rider.ReadChar(ch); LOOP i := 0; WHILE (ch # delimiter) & (ch # endstring) & (~scan.rider.eot) & (ch # ' ') & (ch # 09X) DO str[i] := ch; scan.rider.ReadChar(ch); INC(i); END; str[i] := 0X; IF str = varname THEN equal := TRUE; WHILE (ch = delimiter) OR (ch = 09X) OR (ch = ' ') DO scan.rider.ReadChar(ch) END; scan.SetPos(scan.Pos()-1); EXIT; ELSE WHILE (ch # endstring) DO scan.rider.ReadChar(ch) END; scan.rider.ReadChar(ch); IF (scan.rider.eot) OR (ch = '[') THEN EXIT END; END; END END; RETURN equal; END FindVar; PROCEDURE ConnectTo* (m: TextModels.Model); BEGIN scan.ConnectTo(m) END ConnectTo; PROCEDURE ReadSection* (IN SectionName: ARRAY OF CHAR; OUT strs: ARRAY OF ARRAY OF CHAR); VAR i: INTEGER; str: String; BEGIN i := 0; IF FindSection(SectionName) THEN ReadLn(str); WHILE (str[0] # '[') & (str[0] # 0X) DO strs[i] := str$; INC(i); ReadLn(str); END; END; END ReadSection; PROCEDURE ReadString* (IN SectionName: ARRAY OF CHAR; IN vrbl: ARRAY OF CHAR; OUT val: ARRAY OF CHAR); VAR i: INTEGER; str: String; ch: CHAR; BEGIN IF FindVar(SectionName, vrbl) THEN ReadLn(val) ELSE val := 0X END; END ReadString; PROCEDURE ReadInteger* (IN SectionName: ARRAY OF CHAR; IN vrbl: ARRAY OF CHAR; OUT int: INTEGER); VAR str: String; x, res: INTEGER; BEGIN ReadString(SectionName, vrbl, str); Strings.StringToInt(str, x, res); IF (res # 1) & (res # 2) THEN int := x END; END ReadInteger; BEGIN delimiter := defdelimiter; END IniFile. |
Автор: | Илья Ермаков [ Вторник, 21 Март, 2006 12:52 ] |
Заголовок сообщения: | |
В течение дня постараюсь посмотреть. "Вскрытие покажет" |
Страница 1 из 3 | Часовой пояс: UTC + 3 часа |
Powered by phpBB® Forum Software © phpBB Group https://www.phpbb.com/ |