Приложение 1

Листинг 1. ЭС для оценки надежности поставщика (в среде GURU)

/* Программа выбора поставщика */

clear /* очистка экрана */

e.stat = false /* блокировка вывода трассировки на экран */

e.supd = true /* блокировка вывода сообщений на экран при вводе из файла */

finish all /* закрытие всех активных баз данных */

/* Следующие базы данных делаются активными */

use progr

use proizv

use postav

use specif

at 5,5 ? «****** ЭКСПЕРТНАЯ СИСТЕМА ******»

at 6,5 ? «*** ПРОГРАММА ВЫБОРА ПОСТАВЩИКА ***»

at 7,5 ? «********* press any key ***********»

wait;

obtain first from progr; /* получение первой записи из БД progr */

while not (eot (progr)) do /* eot() – функция, опред. конец файла */

clear;

? « *** Код иэделия: », progr.kodizd;

? « *** Изделие: », progr.izdel;

flag2 = 0;

/* получение из файла базы данных 'specif' первой записи, для которой запись в поле 'kodizd' совпадает с текущей записью в поле 'kodizd' базы данных 'progr' */

obtain first from specif for progr.kodizd = specif.kodizd;

while (not (eot (specif)) and flag2 = 0) do

potrebn = progr.odiem * specif.spec;

output « **** Код продукта: », specif.kodprod;

? « **** потребность: », potrebn;

/* получение из файла базы данных 'proizv' первой записи, для которой запись в поле 'kodprod' совпадает с текущей записью в поле 'kodprod' базы данных 'specif' */

obtain first from proizv for specif.kodprod = proizv.kodprod;

if #found = false then /* если запись не найдена, то поставщика нет */

at 8,2 output « <><> Поставщик не найден <><> »;

wait;

flag2 = 1;

endif;

flag1 = 0;

while (not (eot (proizv)) and flag1 = 0 and flag2 = 0) do

at 8,2 output « **** Код поставщика: », proizv.kodpred;

? «**** цена продукта: », proizv.cena, « ру6лей за 1 шт.»;

/* из файла базы данных 'postav' выбирается поставщик, который может предложить товар по цене, не превышающей имеющиеся фонды */

obtain from postav for postav.kodpred = proizv.kodpred and

progr.fond > potrebn * proizv.cena;

? «*** Поставщик: », postav.name;

if #found = false then

? «**** Фонды меньше чем цена * потребность»;

? «**** Поставщик исключается из рассмотрения»;

flag1 = 0; flag2 = 0;

break;

endif;

/* если цена, предлагаемая поставщиком, не превышает имеющиеся фонды, то поставщика необходимо проверить на надежность */

consult n to test nad; /* Определение надежности поставщика с помощью ЭС*/

if nad = true then

at 14,2 output « **** Поставщик », postav.kodpred, « надежный»;

else

at 14,2 output « **** Поставщик », postav.kodpred, « НЕнадежный»

endif;

wait;

/* получение следующей записи из базы данных 'proizv' */

obtain next from proizv for specif.kodprod = proizv.kodprod;

if #found = false then flag1 = 1; endif;

endwhile;

/* получение следующей записи из базы данных 'specif' */

obtain next from specif for progr.kodizd = specif.kodizd;

if #found = false then break; endif;

endwhile;

/* получение следующей записи из базы данных 'progr' */

obtain next from progr;

enbdwile;

wait;

clear;

at 19, 10 ? « **** Конец консультации **** »;

at 20, 10 ? « ********* bye, bye **********»;

wait;

clear;

finish all;

/* Набор правил – Определение надежности поставщика */

GOAL: NAD /* НАДЕЖНОСТЬ */

INITIAL:

form main /* описание главной формы */

at 10, 25 put «********************************»;

at 11, 25 put «* Экспертная Система *»;

at 12, 25 put «* Оценка надежности поставщика *»;

at 13, 25 put «******** press any key *********»;

endform /* окончание описания формы main */

form vivod /* описание формы для вывода результатов */

at 3, 25 put «********************************»;

at 4, 25 put «* Экспертная Система *»;

at 5, 25 put «* Оценка надежности поставщика *»;

at 6, 25 put «* Вывод результатов *»;

at 7, 25 put «********************************»;

endform /*окончание описания формы vivod */

e.trac = «n» /* отмена трассировки. v – включить трассировку */

e.sord = «ph» /* критерии, по которым устанавливается очередность проверки правил; ph – по приоритету + по наибольшей достоверности результата */

e.rigr = «a» /* режим проверки конфликтующих правил для достижения результата с заданной степенью точности; а – все правила, дающие минимально допустимый фактор уверенности + правила, увеличивающие достоверность результата */

e.tryp = «s» /* режимы оценки; s – проверка неизвестных переменных, пока значение какой-либо из них не будет получено */

e.cfva = «pp» /* задание вероятностной логики */

e.lnum = 5 /* длина числового значения для округления */

e.deci = 0 /* число значащих цифр после запятой */

e.lstr = 75 /* максимальная длина строки */

/******* Следующие переменные имеют тип UNKNOWN *******/

ZAD = UNKNOWN /* Задолженность поставщика. Boolean */

REN = UNKNOWN /* Рентабельность. Boolean */

REC = UNKNOWN /* Наличие рекламаций. Boolean */

UD = UNKNOWN /* Удаленность поставщика. Integer */

ST = UNKNOWN /* Статус поставщика. String */

NAD = UNKNOWN /* Надёжность поставщика */

FIN = UNKNOWN /* Финансовое состояние */

WORK = UNKNOWN /* Рабочая переменная */

DO:

putform vivod;

if 50 < hicf(nad) then

at 12,27 output «Надежность поставщика – TRUE», hival(nad);

at 13,27 output «Фактор уверенности = », hicf(nad);

else

at 12,27 output «Надежность поставщика – FALSE»;

at 13,27 output «Фактор уверенности = », 100 - hicf(nad);

endif;

RULE: R1

PRIORITY: 100

COST: 100

IF: ren = true and zad = false

THEN: fin = true

REASON: Если рентабельность высокая и нет задолженности, то финансовое состояние достаточно высокое.

RULE: R2

PRIORITY: 100

COST: 100

IF: ren = false and zad = true

THEN: fin = false

REASON: Если рентабельность низкая, то финансовое состояние плохое

RULE: R3

PRIORITY: 100

COST: 90

IF: ren = true and zad = true

THEN: work = false

REASON: Если есть задолженность, то финансовое состояние достаточно плохое

RULE: R33

PRIORITY: 100

COST: 90

IF: ren = false and zad = false

THEN: work = true

REASON: Если нет рентабельности, но и нет задолженности, то финансовое состояние можно считать удовлетворительным

RULE: R4

PRIORITY: 100

IF: fin = true

THEN: nad += true cf 90

REASON: Если финансовое состояние хорошее, то надежность поставщика высокая

RULE: R44

PRIORITY: 100

IF: work = true

THEN: nad += true cf 54

REASON: Если финансовое состояние удовлетворительное, то надёжность поставщика повышается

RULE: R5

PRIORITY: 100

IF: fin = false

THEN: nad -= true cf 90

REASON: Если финансовое состояние плохое, то надежность поставщика низкая

RULE: R55

PRIORITY: 100

IF: work = false

THEN: nad -= true cf 63

REASON: Если есть задолженность, то надёжность поставщика снижается

RULE: R6

PRIORITY: 90

IF: rec = 1

THEN: nad -= true cf 60

REASON: Если есть рекламации, то надежность поставщика низкая

RULE: R7

PRIORITY: 90

IF: rec = 2

THEN: nad += true cf 80

REASON: Если рекламаций нет, то надежность поставщика высокая

RULE: R8

PRIORITY: 80

IF: st = «gosud»

THEN: nad += true cf 70

REASON: Если предприятие государственное, то надежность высокая

RULE: R9

PRIORITY: 80

IF: st = «akc»

THEN: nad += true cf 70

REASON: Если предприятие акционерное, то надежность высокая

RULE: R10

PRIORITY: 80

IF: st = «sovmest»

THEN: nad += true cf 70

REASON: Если предприятие совместное, то надежность высокая

RULE: R11

PRIORITY: 80

IF: st = «maloe»

THEN: nad += true cf 50

REASON: Если предприятие малое, то надежность средняя

RULE: R12

PRIORITY: 80

IF: st = «kooper»

THEN: nad += true cf 50

REASON: Если предприятие кооперативное, то надежность средняя

RULE: R13

PRIORITY: 80

IF: st = «individ»

THEN: nad += true cf 20

REASON: Если предприятие индивидуальное, то надежность низкая

RULE: R14

PRIORITY: 70

IF: ud <= 1000

THEN: nad += true cf 70

REASON: Если удаленность поставщика небольшая, то надежность высокая

RULE: R15

PRIORITY: 70

IF: ud > 1000

THEN: nad -= true cf 30

REASON: Если удаленность поставщика большая, то надежность низкая

VAR: NAD

TYPE: pp

LABEL: Надежность поставщика

VAR: REN

FIND:

clear;

let deci = e.deci;

let lnum = e.lnum;

let e.deci = 0;

let e.lnum = 1;

putform main;

wait;

clear;

at 5,10 input tmpv num with «Введите рентабельность: (1–Есть, 2–Нет)»

if tmpv = 1 then

let ren = true;

else

let ren = false;

endif;

LABEL: Рентабельность

VAR: ZAD

FIND:

at 7,10 input tmpv num with «Введите задолженность: (1–Есть, 2–Нет)»

if tmpv = 1 then

let zad = true;

else

let zad = false;

endif;

LABEL: Задолженность

VAR: FIN

LABEL: Финансовое состояние

VAR: REC

FIND:

let e.icf = true;

at 9,10 input rec int with «Введите рекламации (1 – Есть, 2 – Нет): »

let e.icf = false;

LABEL: Рекламации

VAR: ST

FIND:

at 11,11 ? «Статус предприятия:»

at 12,10 ? « 1 – государственное,»;

at 13,10 ? « 2 – акционерное,»;

at 14,10 ? « 3 – совместное,»;

at 15,10 ? « 4 – малое,»;

at 16,10 ? « 5 – кооперативное,»;

at 17,10 ? « 6 – индивидуальное»;

at 18,10 input tmp num with «Укажите статус предприятия: »

if tmp = 1 then let st = «gosud»;

else if tmp = 2 then let st = «akc»;

else if tmp = 3 then let st = «sovmest»;

else if tmp = 4 then let st = «maloe»;

else if tmp = 5 then let st = «kooper»;

else let st = «individ»;

endif; endif; endif; endif; endif;

e.deci = deci;

e.lnum = lnum;

LABEL: Статус предприятия

VAR: UD

FIND:

at 20,10 input ud num with «Введите удаленность поставщика в км: »

at 23,21 ? «*** Ввод значений завершен. ***»;

at 24,21 ? «*** press any key ***»;

wait;

clear;

LABEL: Удаленность поставщика

VAR: WORK

LABEL: Финансовое состояние

END: