OberonCore

Библиотека  Wiki  Форум  BlackBox  Компоненты  Проекты
Текущее время: Четверг, 28 Март, 2024 23:10

Часовой пояс: UTC + 3 часа




Начать новую тему Ответить на тему  [ Сообщений: 53 ]  На страницу 1, 2, 3  След.
Автор Сообщение
 Заголовок сообщения: BB (DLL) - Delphi
СообщениеДобавлено: Четверг, 16 Март, 2006 12:32 

Зарегистрирован: Среда, 22 Февраль, 2006 10:35
Сообщения: 144
Откуда: Новочеркасск
Столкнулся с неожиданной проблемой. Реализовал на 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$#

В чем моя ошибка?


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Четверг, 16 Март, 2006 12:47 

Зарегистрирован: Понедельник, 28 Ноябрь, 2005 10:28
Сообщения: 1428
Одна ошибка видна сразу - нет HostFiles.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Четверг, 16 Март, 2006 12:53 
Модератор
Аватара пользователя

Зарегистрирован: Понедельник, 14 Ноябрь, 2005 18:39
Сообщения: 9459
Откуда: Россия, Орёл
Другая ошибка:

dllwork: procedure(), stdcall,

т.к. BlackBox по умолачнию использует соглашение stdcall.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Четверг, 16 Март, 2006 13:18 

Зарегистрирован: Среда, 22 Февраль, 2006 10:35
Сообщения: 144
Откуда: Новочеркасск
Добавление HostFiles и
dllwork: procedure(); stdcall;
не помогло. Может тут дело в импорте стандартных BB модулей? Ведь стоит этот импорт убрать (то есть реализовать простую DLL) и все работает! А мне без него не обойтись - так не хочется связываться с WinApi, да и времени нет.
[/code]


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Четверг, 16 Март, 2006 14:39 
Аватара пользователя

Зарегистрирован: Пятница, 25 Ноябрь, 2005 18:55
Сообщения: 2272
Откуда: Россия, Нижний Новгород
Попробуйте для начала процедуру Work сделать "безобидной" (чтоб она ничего не делала). Если Delphi всё равно будет падать, значит проблема точно не внутри Work. Потом, потихоньку добавляйте функциональность внутрь Work до того момента пока не начнёт падать... :D

______________
P.S. В дельфийский код не мешало бы еще добавить CloseHandle(h)...


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Четверг, 16 Март, 2006 15:43 

Зарегистрирован: Понедельник, 28 Ноябрь, 2005 10:28
Сообщения: 1428
Илья Ермаков писал(а):
Другая ошибка:

dllwork: procedure(), stdcall,

т.к. BlackBox по умолачнию использует соглашение stdcall.

Для процедур без параметров разницы никакой.

А где находится эта MyDll.dll?
Если отдельно от ББ, то надо прилинковать значительную часть Host. По крайней мере HostFiles HostRegistry HostFonts HostDialog HostTextConv.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Четверг, 16 Март, 2006 17:12 
Модератор
Аватара пользователя

Зарегистрирован: Понедельник, 14 Ноябрь, 2005 18:39
Сообщения: 9459
Откуда: Россия, Орёл
Да, DLL должна либо лежать в окружениии стандартных подсисем, либо прилинковывать все необходимое статически.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пятница, 17 Март, 2006 11:23 

Зарегистрирован: Среда, 22 Февраль, 2006 10:35
Сообщения: 144
Откуда: Новочеркасск
Опыты, проведенные над процедурой Work по совету Сергея Губанова, дали следующие результаты:

1) Пустая процедура Work с такими же локльными переменными такого же модуля с таким же импортом выполняется успешно. При чем как в окружении cтандартных подсисем BB, так и без него.

2) Простое добавление
Код:
 t := NIL; loc := NIL; name := "";
      Dialog.GetIntSpec("fis", loc, name);
вызывает ошибку при вызове в Delphi.

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 
Аватара пользователя

Зарегистрирован: Пятница, 25 Ноябрь, 2005 18:55
Сообщения: 2272
Откуда: Россия, Нижний Новгород
Андрей писал(а):
5) Даже после успешного выполнения пустой процедуры Work, вызов CloseHandle(h) генерирует такое же исключение...


То есть ошибка, на самом деле, находится вне Work. Надо подумать...


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пятница, 17 Март, 2006 13:14 

Зарегистрирован: Понедельник, 28 Ноябрь, 2005 10:28
Сообщения: 1428
Попробуйте в список импорта добавить HostDialog.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пятница, 17 Март, 2006 14:51 
Модератор
Аватара пользователя

Зарегистрирован: Понедельник, 14 Ноябрь, 2005 18:39
Сообщения: 9459
Откуда: Россия, Орёл
А если попробовать подключать DLL статически, через
procedure Do; external 'MyDLL'?

И еще - LinkDynDll может иметь некоторые особенности - в документации где-то было написано, что "редко используется, добавлена для полноты", если попробовать использовать просто LinkDll?


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пятница, 17 Март, 2006 15:14 
Модератор
Аватара пользователя

Зарегистрирован: Понедельник, 14 Ноябрь, 2005 18:39
Сообщения: 9459
Откуда: Россия, Орёл
Э, батенька, кажется, нашел я ошибку!

Вы главным модулем ($) пометили свой модуль - но если Вы используете механизмы динамической загрузки BlackBox, то главный всегда - Kernel. Естественно, он у вас не инициализировался, и весь Run-Time не работал. Вот, читаем:

DevLinker.LinkDynDll
(редко используется, представлено для полноты)
Компонует набор модулей, включающий динамический загрузчик модулей, в dll-файл.
Когда dll подключается к процессу, вызывается тело главного модуля.
Когда dll освобождается процессом, вызывается окончание (секция CLOSE) главного модуля.
ВОТ:
Инициализация и прерывание всех остальных модулей должны выполняться подсистемой времени выполнения. А У ВАС ИНИЦИАЛИЗАЦИЯ ВСЕХ МОДУЛЕЙ ББ не проходила вообще.
Допустимые настройки: $ + #


Если линкуем без расширяемости, то попроще, т.к. инициализация пройдет в том порядке, в каком модули были в нашем списке:
DevLinker.LinkDll
Компонует нерасширяемый набор модулей в dll-файл.
Когда dll подключается к процессу, тела всех модулей вызываются в правильном порядке.
Когда dll освобождается процессом, окончания (секции CLOSE) всех модулей вызываются в обратном порядке.
Никакой подсистемы времени выполнения не требуется для инициализации и завершения.
Допустимые настройки: + #



В принципе, я думаю, что можно попробовать собрать и ваш набор , модулей с Kernel, через простой LinkDll, только нельзя включать в список StdLoader.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Пятница, 17 Март, 2006 18:46 

Зарегистрирован: Среда, 22 Февраль, 2006 10:35
Сообщения: 144
Откуда: Новочеркасск
Если главным модулем назначить Kernel, то библиотека по LoadLibrary вообще не грузится - возвращается нулевой дескриптор. Импортирование HostDialog тоже не помогает. Если линковать без StdLoader (впрочем, как и с ним) командой LinkDll, и прицепить такую dll статически, то при запуске проги на Delphi возникает ошибка "Ошибка инициализации приложения". Если такую dll грузить динамически по LoadLibrary, также возвращается нулевой дескриптор.
:(((


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Суббота, 18 Март, 2006 06:25 

Зарегистрирован: Вторник, 29 Ноябрь, 2005 21:41
Сообщения: 1030
Жаль, что нельзя увидеть код целиком. Надеюсь, эта ошибка когда-нибудь будет исправлена.
P.S. Вместо CloseHandle лучше использовать FreeLibrary, однако.
P.P.S. Андрей, это не вполне тот вариант. Вы выложите его здесь, а кому интересно будут отвечать. Тоже здесь.


Последний раз редактировалось Сергей Оборотов Суббота, 18 Март, 2006 09:34, всего редактировалось 1 раз.

Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Суббота, 18 Март, 2006 09:29 

Зарегистрирован: Среда, 22 Февраль, 2006 10:35
Сообщения: 144
Откуда: Новочеркасск
Почему же нельзя? Если это кому-то действительно интересно - дайте адрес, я вышлю архивом.


Вернуться к началу
 Профиль  
 
 Заголовок сообщения:
СообщениеДобавлено: Вторник, 21 Март, 2006 10:21 

Зарегистрирован: Среда, 22 Февраль, 2006 10:35
Сообщения: 144
Откуда: Новочеркасск
Нечеткие множества:
Код:
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 

Зарегистрирован: Среда, 22 Февраль, 2006 10:35
Сообщения: 144
Откуда: Новочеркасск
Сорри за комментарии, какие-то проблемы с кодировками, решать их некогда, поэтому лучше удалю их вообще...
Нечеткая модель (пока реализована только модель Мамдани):
Код:
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 

Зарегистрирован: Среда, 22 Февраль, 2006 10:35
Сообщения: 144
Откуда: Новочеркасск
Модуль, необходимый для инициализации нечеткой модели из 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 

Зарегистрирован: Среда, 22 Февраль, 2006 10:35
Сообщения: 144
Откуда: Новочеркасск
И последнее, чтение 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 
Модератор
Аватара пользователя

Зарегистрирован: Понедельник, 14 Ноябрь, 2005 18:39
Сообщения: 9459
Откуда: Россия, Орёл
В течение дня постараюсь посмотреть. "Вскрытие покажет" :-)


Вернуться к началу
 Профиль  
 
Показать сообщения за:  Поле сортировки  
Начать новую тему Ответить на тему  [ Сообщений: 53 ]  На страницу 1, 2, 3  След.

Часовой пояс: UTC + 3 часа


Кто сейчас на конференции

Сейчас этот форум просматривают: нет зарегистрированных пользователей и гости: 2


Вы не можете начинать темы
Вы не можете отвечать на сообщения
Вы не можете редактировать свои сообщения
Вы не можете удалять свои сообщения
Вы не можете добавлять вложения

Найти:
cron
Вся информация, размещаемая участниками на конференции (тексты сообщений, вложения и пр.) © 2005-2024, участники конференции «OberonCore», если специально не оговорено иное.
Администрация не несет ответственности за мнения, стиль и достоверность высказываний участников, равно как и за безопасность материалов, предоставляемых участниками во вложениях.
Без разрешения участников и ссылки на конференцию «OberonCore» любое воспроизведение и/или копирование высказываний полностью и/или по частям запрещено.
Powered by phpBB® Forum Software © phpBB Group
Русская поддержка phpBB