Разработка фрагментов оболочки экспертной системы

SET-CURSOR!. Курсор появляется на экране только тогда, когда ввод

производится с клавиатуры.

FLUSH-INPUT

Процедура FLUSH-INPUT чистит буфер вводного порта.

Формат (FLUSH-INPUT {port})

Параметр port- вводной порт (необязательный аргумент).

Объяснение:

FLUSH-INPUT отбрасывает любые литеры и включает следующую

"последовательность конца строки" (end-of-line) в буфер ввода, который

связан с port, если он задан, или с текущим вводным портом. Выдается

неопределенное значение.

LAST-PAIR

Возвращает последнюю пару непустого списка.

LIST

Композиции пар, связанных через их cdr-компоненты, называются списками.

Пустой список, обозначаемый как (), также является списком. Когда

цепочка cdr-связей в паре оканчивается пустым списком, тогда пара

называется "собственным списком". Процедура LIST обеспечивает такой список,

состоящий из значений его аргументов. LIST* обеспечивает похожий список,

но имеющий значение его последнего аргумента в cdr-компоненте последней

пары цепочки.

MEMBER

MEMBER, MEMQ, MEMV

Процедура

Данные процедуры выдают подсписок, начинающийся с некоторого специфического

объекта в собственном списке.

Формат (MEMBER оbj list)

(MEMQ оbj list)

(MEMV оbj list)

Параметры obj - любой объект в "ЛИСП-МИКРО";

list - собственный список

Объяснение:

Данные процедуры ищут первое появление obj в list, используя EQVAL?

для сравнения (в случае MEMBER); при MEMQ используется EQ?; при MEMV -

EQV? Если obj найден, подсписок, содержащий obj как первый элемент,

выдается как результат. Если obj не найден в list, выдается "ложь".

DO

Специальное выражение

DO обеспечивает наиболее общую возможность вычисления итераций.

Формат

(DO ((var (init {step}})...)(test exp ...) stmt ...)

Параметры var - любой идентификатор "ЛИСП-МИКРО";

init - любые выражения в "ЛИСП-МИКРО".

Вычисляется каждое init; результат используется как значение

соответствующего var.

Этот аргумент необязательный;

step... - любые выражения "ЛИСП-МИКРО".

Вычисляется каждое init; результат используется как значение

соответствующего var для следующей итерации. Этот необязательный

аргумент может быть описан, только если описан init;

test - любое выражение "ЛИСП-МИКРО". Это

выражение является условием, по которому итерация останавливается;

exp... - любые выражения "ЛИСП-МИКРО". Эти

выражения вычисляются перед выходом из цикла;

stmt... - любые выражения "ЛИСП-МИКРО". Эти

выражения вычисляются по порядку каждый раз как test возвращает "ложь".

8. Отладка программы

Для удобства отладки программа писалась не вся сразу, а постепенно,

отдельными процедурами. Каждая процедура сначала отлаживалась и

проверялась, а потом разрабатывалась следующая. После проверки каждой

процедуры в отдельности отлаживалась вся программа целиком и устранялись

последние недоработки и ошибки.

9. Инструкция пользователю и пример выполнения программы

Необходимые аппаратные средства

Для работы данной программы необходимо: - компьютер : желательно IBM

PC AT или XT; - оперативная память - не менее 512 Кb; - места на

винчестере (или любом другом запоминающем устройстве)- не менее 100 Kb (в

зависимости от размера базы данных); - дисплей с любой графической картой;

- операционная среда - MS-DOS версии 3.0 и выше.

Состав носителей данных:

Для нормальной работы программы необходимо наличие следующих файлов:

fun.lsp - файл запуска (файл содержащий всю программу);

bd2.lsp - файл базы данных (или любой другой файл, содержащий базу

данных пользователя);

Для запуска программы нужно войти в Лисп, загрузить файл

fun.lsp, набрать start и нажать клавишу {ENTER}.

Описание работы с программой

После запуска программы Вы попадаете в ее интегрированную среду. Для

работы с ней нужно знать, что:

- для выбора нужного пункта меню/подменю нужно набрать номер этого

пункта;

- для перехода из нижнего подменю в исходное меню/подменю нужно

нажать клавишу {ESC};

- для выхода из программы нужно выбрать пункт главного меню .

Работа с подменю :

- для работы с пунктом :

- наберите на клавиатуре название нужного вам файла базы данных и

нажмите клавишу {ENTER};

- для работы с пунктом :

- наберите имя файла и нажмите {ENTER}.

Работа с подменю :

- для работы с пунктом нужно:

- выбрать будете ли Вы редактировать названия неисправностей или

признаков (нажать соответственно цифру {1} или {2});

- ввести название неисправности или признака для редактирования;

- ввести новые исправленные значения;

- для работы с пунктом нужно:

- выбрать будете ли Вы добавлять названия неисправностей или

признаков (нажать соответственно цифру {1} или {2});

- путем ввода информации с клавиатуры внести новую запись;

- для работы с пунктом нужно:

- выбрать будете ли Вы удалять названия неисправностей или

признаков (нажать соответственно цифру {1} или {2});

- ввести название удаляемой неисправности или признака;

- для работы с пунктом необходимо знать, что:

- информацию на экране можно менять, нажимая клавишу {ESC}.

Работая с подменю , нужно:

- отвечать на вопросы (набирать соответственно 'Д' или 'Н' и нажимать

клавишу {ENTER}).

Заключение

В данной работе была реализована идея создания фрагмента оболочки

экспертной системы. В результате разработки КПР была получена

интегрированная среда по диагностике заболеваний. К плюсам данной

программы можно отнести довольно поверхностные знания пользователя по

работе с компьютером, которые требуются для работы с ней.

Среди возможных пожеланий можно сказать о разработке системы помощи

при работе с программой. Можно также усложнить программу, переписав ее так,

чтобы она работала на основе рассуждений с использованием вероятностного

подхода. Часто к экспертным системам предъявляют дополнительное

требование - способность иметь дело с неопределенностью и неполнотой.

Информация о поставленной задаче может быть неполной или ненадежной;

отношения между объектами предметной области могут быть приближенными.

Например, может не быть полной уверенности в наличии у пользователя

некоторого симптома или в том, что данные, полученные при определении,

верны. Во всех этих случаях как раз и необходимы рассуждения с

использованием вероятностного подхода.

Библиографический список

1. Ин Ц., Соломон Д. Использование Турбо-Пролога: Пер. с англ. -Мир, 1993.-

608 с.

2. Таусенд К., Фохт Д. Проектирование и программная реализация

экспертных систем на персональных ЭВМ: Пер. с англ. - М.: Финансы и

статистика, 1990.- 320 с.

3. Хювенен Э., Сеппянен Й. Мир Лиспа. В 2-х т. Пер. с финск. - М.: Мир,

1990.

Приложение А

Полный текст программы на языке micro-LISP (файл "FUN.LSP):

(define mainw(make-window "ДОКТОР" #!true))

(define mmenuw(make-window "МЕНЮ" #!true))

(define menufw(make-window "__ФАЙЛЫ" #!true))

(define menudbw(make-window "БазаДанных" #!true))

(define menucw(make-window "_____________________________ДИАГНОСТИКА"

#!true))

(define vieww(make-window "____________ПРОСМОТР" #!true))

(define addiw(make-window "____________ДОБАВЛЕНИЕ БОЛЕЗНИ" #!true))

(define addsw(make-window "__________ДОБАВЛЕНИЕ СИМПТОМОВ" #!true))

(define rediw(make-window "________РЕДАКТИРОВАНИЕ БОЛЕЗНИ" #!true))

(define redsw(make-window "_______РЕДАКТИРОВАНИЕ СИМПТОМА" #!true))

(define deliw(make-window "______________УДАЛЕНИЕ БОЛЕЗНИ" #!true))

(define delsw(make-window "_____________УДАЛЕНИЕ СИМПТОМА" #!true))

(define submenuw(make-window "___Работа с:" #!true))

(define menulw(make-window "Введите ИМЯ ФАЙЛА :" #!true))

(define f)

(define *symptom*)

(define *it_is*)

(define *yes* '())

(define *no* '())

(define (start)

(window-set-position! mainw 1 1)

(window-set-size! mainw 23 78)

(window-clear mainw)

(mainmenu))

; Главное меню

(define (mainmenu)

(define ch)

(Window-Set-Position! mmenuw 3 15)

(Window-Set-Size! mmenuw 1 47)

(Window-Clear mmenuw)

(display " 1.Files 2.DataBase 3.Diagnosticka 4.Quit" mmenuw)

(do ((i 0 (+ i 0)))

((> i 5)i)

(Window-Set-Cursor! mainw 22 30)

(display "Ваш выбор :" mainw)

(set! ch (read-char mainw))

(Window-Set-Cursor! mainw 22 30)

(display " " mainw)

(cond

((eq? ch #\1) (menufiles))

((eq? ch #\2) (menudb))

((eq? ch #\3) (menucons))

((eq? ch #\4) (exit))

)))

; Меню Файлов

(define (menufiles)

(define ch)

(Window-Set-Position! menufw 5 16)

(Window-Set-Size! menufw 4 8)

(Window-Clear menufw)

(Window-Set-Cursor! menufw 1 1)

(display "1.LOAD" menufw)

(Window-Set-Cursor! menufw 2 1)

(display "2.SAVE" menufw)

(do ((i 0 (+ i 0)))

((> i 5)i)

(Window-Set-Cursor! mainw 22 30)

(display "ВАШ ВЫБОР :" mainw)

(set! ch (read-char mainw))

(Window-Set-Cursor! mainw 22 30)

(display " " mainw)

(cond

((eq? ch #\1) (loading))

((eq? ch #\2) (saving))

((eq? ch #\ESCAPE)

(Window-Delete menufw)

(mainmenu))

)))

; Меню БазыДанных

(define (menudb)

(define ch)

(Window-Set-Position! menudbw 5 26)

(Window-Set-Size! menudbw 6 10)

(Window-Clear menudbw)

(Window-Set-Cursor! menudbw 1 1)

(display "1.ADD " menudbw)

(Window-Set-Cursor! menudbw 2 1)

(display "2.DELETE" menudbw)

(Window-Set-Cursor! menudbw 3 1)

(display "3.REDACT" menudbw)

(Window-Set-Cursor! menudbw 4 1)

(display "4.VIEW" menudbw)

(do ((i 0 (+ i 0)))

((> i 5)i)

(Window-Set-Cursor! mainw 22 30)

(display "ВАШ ВЫБОР :" mainw)

(set! ch (read-char mainw))

(Window-Set-Cursor! mainw 22 30)

(display " " mainw)

(cond

((eq? ch #\1)

(adding) (menudb))

((eq? ch #\2)

(deleting) (menudb))

((eq? ch #\3)

(redacting) (menudb))

((eq? ch #\4)

(viewing) (menudb))

((eq? ch #\ESCAPE)

(Window-Delete menudbw) (mainmenu))

)))

; Загрузка файла

(define (loading)

(Window-Set-Position! menulw 20 20)

(Window-Set-Size! menulw 1 40)

(Window-Clear menulw)

(Window-Set-Cursor! menulw 1 3)

(set! f (read-line menulw))

(Window-Delete menulw)

(with-input-from-file f

(lambda ()

(set! *symptom* (read))

(set! *it_is* (read))

(flush-input)

)))

; Запись файла

(define (saving)

(Window-Set-Position! menulw 20 20)

(Window-Set-Size! menulw 1 40)

(Window-Clear menulw)

(Window-Set-Cursor! menulw 2 3)

(set! f (read-line menulw))

(Window-Delete menulw)

(with-output-to-file f

(lambda ()

(write *symptom*)

(write *it_is*)

)))

;Меню диагностики

(define (menucons)

(Window-Set-Position! menucw 6 10)

(Window-Set-Size! menucw 17 57)

(Window-Clear menucw)

(experting *it_is*)

(window-delete menucw) )

(define (experting spis_ill)

(cond ((null? spis_ill) (board)

(display " НЕВОЗМОЖНО ОПРЕДЕЛИТЬ ДИАГНОЗ "

menucw)

(wait menucw)

(set! *yes* '())

(set! *no* '()))

((exp_ill (cadar spis_ill) (caar spis_ill)))

(t (experting (cdr spis_ill))) ))

(define (exp_ill spis_num ill)

(define nums)

(define s)

(cond ((null? spis_num) (window-clear menucw) (window-set-cursor! menucw

1 1)

(display " У ВАС " menucw) (display ill

menucw)

(display "." menucw)

(set! nums (find_sym ill *it_is*))

(set! *yes* '())

(set! *no* '())

(log_out nums))

(t (set! s (find_sym (car spis_num) *symptom*))

(yesno? s spis_num ill)) ))

(define (into y a)

(cond ((eq? a 'д) (set! *yes* (append *yes* (list y))))

(t (set! *no* (append *no* (list y)))) ))

(define (yesno? y spis_num ill)

(define ans)

(cond ((member y *no*) nil)

((member y *yes*) (exp_ill (cdr spis_num) ill))

(t (and (board) (display " СИМПТОМ: " menucw)

(display y menucw)

(display " [Д/Н] ? " menucw)

(set! ans (read menucw))

(into y ans) (eq? 'д ans)

(exp_ill (cdr spis_num) ill))) ))

(define (log_out nums)

(cond ((null? nums) (wait menucw))

(t (newline menucw) (display " " menucw)

(display (find_sym (car nums) *symptom*) menucw)

(log_out (cdr nums))) ))

(define (board)

(define gr)

(set! gr (window-get-cursor menucw))

(if (< (car gr) 18) (newline menucw)

(begin (window-clear menucw)

(window-set-cursor! menucw 1 1))))

(define (find_sym n spis_sym)

(if (equal? (caar spis_sym) n) (cadar spis_sym)

(find_sym n (cdr spis_sym)) ))

(define (wait wname)

(cond ((eq? (read-char wname) #\ESCAPE) t)

(t (wait wname)) ))

;Просмотр

(define (viewing)

(Window-Set-Position! vieww 11 15)

(Window-Set-Size! vieww 12 47)

(Window-Clear vieww)

(view_ill *it_is*)

(window-delete vieww) )

(define (view_ill spis_ill)

(cond ((null? spis_ill) t)

(t (window-set-cursor! vieww 1 2) (display "БОЛЕЗНЬ: " vieww)

(display (caar spis_ill) vieww)

(view_sym (cadar spis_ill))

(view_ill (cdr spis_ill))) ))

(define (view_sym spis_num)

(cond ((null? spis_num) (wait vieww) (window-clear vieww))

(t (newline vieww)

(display " " vieww)

(display (find_sym (car spis_num) *symptom*) vieww)

(view_sym (cdr spis_num))) ))

;Вспомогательное подменю

(define (submenu)

(Window-Set-Position! submenuw 11 25)

(Window-Set-Size! submenuw 4 14)

(Window-Clear submenuw)

(window-set-cursor! submenuw 1 1)

(display "1.БОЛЕЗНЯМИ" submenuw)

(window-set-cursor! submenuw 2 1)

(display "2.СИМПТОМАМИ" submenuw) )

;Добавление

(define (adding)

(define ch)

(submenu)

(Window-Set-Cursor! mainw 22 30)

(display "ВАШ ВЫБОР :" mainw)

(set! ch (read-char mainw))

(Window-Set-Cursor! mainw 22 30)

(display " " mainw)

(window-delete submenuw)

(cond ((eq? ch #\1) (Window-Set-Position! addiw 6 10)

(Window-Set-Size! addiw 17 57)

(Window-Clear addiw) (add_ill)

(window-delete addiw))

((eq? ch #\2) (Window-Set-Position! addsw 6 10)

(Window-Set-Size! addsw 17 57)

(Window-Clear addsw) (add_sym)

(window-delete addsw))

((eq? ch #\ESCAPE))

(t (adding)) ))

(define ill)

(define sym)

;Добавление болезни

(define (add_ill)

(define n)

(window-set-cursor! addiw 1 1)

(display "Введите название новой БОЛЕЗНИ: " addiw)

(set! ill (read-line addiw))

(display " Чтобы ЗАКОНЧИТЬ вводить симптомы НАБЕРИТЕ: end" addiw)

(newline addiw)

(set! n (caar (last-pair *symptom*)))

(set! *it_is* (append *it_is* (list (list ill

(addsyms (+ n 1) '() '() addiw)))

)) )

;Добавление симптомов

(define (add_sym)

(define n)

(define nums)

(window-set-cursor! addsw 1 2)

(display "БОЛЕЗНЬ: " addsw)

(set! ill (read-line addsw))

(display " Чтобы ЗАКОНЧИТЬ вводить симптомы НАБЕРИТЕ: end" addsw)

(newline addsw)

(set! n (caar (last-pair *symptom*)))

(set! nums (find_sym ill *it_is*))

(set! *it_is* (delete! (list ill nums) *it_is*))

(set! *it_is* (append *it_is* (list (list ill

(addsyms (+ n 1) '() nums addsw)))

)) )

(define (addsyms nn spis_num nums nwin)

(display " СИМПТОМ: " nwin)

(set! sym (read-line nwin))

(if (equal? sym "end") (append nums spis_num)

(begin (set! *symptom* (append *symptom* (list (list nn sym))))

(addsyms (+ nn 1) (append spis_num (list nn)) nums nwin))

))

;Редактирование

(define (redacting)

(define ch)

(submenu)

(Window-Set-Cursor! mainw 22 30)

(display "ВАШ ВЫБОР :" mainw)

(set! ch (read-char mainw))

(Window-Set-Cursor! mainw 22 30)

(display " " mainw)

(window-delete submenuw)

(cond ((eq? ch #\1) (Window-Set-Position! rediw 11 10)

(Window-Set-Size! rediw 6 57)

(Window-Clear rediw) (red_ill)

(window-delete rediw))

((eq? ch #\2) (Window-Set-Position! redsw 11 10)

(Window-Set-Size! redsw 8 57)

(Window-Clear redsw) (red_sym)

(window-delete redsw))

((eq? ch #\ESCAPE))

(t (redacing)) ))

;Редактирование болезни

(define (red_ill)

(define nums)

(define ill1)

(window-set-cursor! rediw 1 1)

(display " Введите БОЛЕЗНЬ, название которой хотите" rediw)

(newline rediw)

(display " ИСПРАВИТЬ: " rediw)

(set! ill (read-line rediw))

(newline rediw)

(display " Введите ИСПРАВЛЕННОЕ название: " rediw)

(set! ill1 (read-line rediw))

(set! nums (find_sym ill *it_is*))

(set! *it_is* (delete! (list ill nums) *it_is*))

(set! *it_is* (append *it_is* (list (list ill1 nums)) )) )

;Редактирование симптома

(define (red_sym)

(define n1)

(define nums)

(define sym1)

(window-set-cursor! redsw 1 1)

(display " Введите БОЛЕЗНЬ, СИМПТОМ которой хотите" redsw)

(newline redsw)

(display " ИСПРАВИТЬ: " redsw)

(set! ill (read-line redsw))

(newline redsw)

(display " Введите СИМПТОМ, который хотите" redsw)

(newline redsw)

(display " ИСПРАВИТЬ: " redsw)

(set! sym (read-line redsw))

(display " Введите ИСПРАВЛЕННОЕ ЗНАЧЕНИЕ: " redsw)

(set! sym1 (read-line redsw))

(set! nums (find_sym ill *it_is*))

(set! n1 (sub sym *symptom* nums))

(set! *symptom* (delete! (list n1 sym) *symptom*))

(set! *symptom* (append *symptom* (list (list n1 sym1)) )) )

(define (sub x spis spis_x)

(let ((n (find_index x spis)))

(cond ((memb? n spis_x) n)

(t (sub x (cdr spis) spis_x)) )))

(define (find_index x spis)

(cond ((equal? (cadar spis) x) (caar spis))

(t (find_index x (cdr spis))) ))

(define (memb? a l)

(cond ((null? l) nil)

((equal? a (car l)) t)

(t (memb? a (cdr l))) ))

;Удаление

(define (deleting)

(define ch)

(submenu)

(Window-Set-Cursor! mainw 22 30)

(display "ВАШ ВЫБОР :" mainw)

(set! ch (read-char mainw))

(Window-Set-Cursor! mainw 22 30)

(display " " mainw)

(window-delete submenuw)

(cond ((eq? ch #\1) (Window-Set-Position! deliw 11 10)

(Window-Set-Size! deliw 4 57)

(Window-Clear deliw) (del_ill)

(window-delete deliw))

((eq? ch #\2) (Window-Set-Position! delsw 6 10)

(Window-Set-Size! delsw 17 57)

(Window-Clear delsw) (del_sym)

(window-delete delsw))

((eq? ch #\ESCAPE))

(t (deleting)) ))

;Удаление болезни

(define (del_ill)

(define nums)

(window-set-cursor! deliw 1 2)

(display "Введите название БОЛЕЗНИ, которую хотите" deliw)

(newline deliw)

(display " УДАЛИТЬ: " deliw)

(set! ill (read-line deliw))

(set! nums (find_sym ill *it_is*))

(set! *it_is* (delete! (list ill nums) *it_is*))

(delsyms nums) )

(define (delsyms spis_nums)

(cond ((null? spis_nums) t)

(t (set! *symptom* (delete!

(list (car spis_nums)

(find_sym (car spis_nums) *symptom*))

*symptom*))

(delsyms (cdr spis_nums))) ))

;Удаление симптомов

(define (del_sym)

(define nums)

(window-set-cursor! delsw 1 2)

(display "Введите название БОЛЕЗНИ, СИМПТОМЫ которой хотите" delsw)

(newline delsw)

(display " УДАЛИТЬ: " delsw)

(set! ill (read-line delsw))

(display " Чтобы ЗАКОНЧИТЬ вводить симптомы НАБЕРИТЕ: end" delsw)

(newline delsw)

(set! nums (find_sym ill *it_is*))

(subdel nums ill) )

(define n0)

(define (subdel spis_nums ill)

(display " СИМПТОМ: " delsw)

(set! sym (read-line delsw))

(if (equal? sym "end") t

(begin (set! n0 (sub sym *symptom* spis_nums))

(set! *symptom* (delete! (list n0 sym) *symptom*))

(set! *it_is* (delete! (list ill spis_nums)

*it_is*))

(set! *it_is* (append *it_is* (list (list ill

(del n0 spis_nums))) ))

(subdel (del n0 spis_nums) ill)) ))

(define (del x l)

(cond ((null? l) nil)

((equal? x (car l)) (cdr l))

(t (cons (car l) (del x (cdr l)))) ))

Приложение В

Листинг файла базы знаний "BD2.LSP":

((1 "общее недомогание")

(2 "сухость, першение, саднение")

(3 "кашель сначала сухой, затем с мокротой")

(4 "голос хриплый или беззвучный")

(5 "иногда боль при глотании")

(6 "головная боль")

(7 "повышение температуры тела")

(8 "быстрая утомляемость голоса")

(9 "периодический кашель с мокротой")

(10 "охриплость с афонией")

(11 "ощущение неловкости")

(12 "жжение в горле")

(13 "кашель при обострении")

(14 "сухой кашель")

(15 "слизистая покрыта густой слизью ")

(16 "откашливание с прожилками крови"))

(("ларингит острый" (1 2 3 4 5 6 7))

("ларингит хронический катаральный" (1 2 4 8 9))

("ларингит хронический гипертрофический" (1 10 11 12 13))

("ларингит хронический атрофический" (1 2 4 14 15 16)))

-----------------------

Главная процедура

Вывод главного меню, получение выбора и запуск выбранного режима

Вывод подменю "Файлы", получение выбора, запуск выбранной процедуры

Выход

Логический вывод, режим консультации

Вывод подменю "БазаДанных", получение выбора, запуск выбранной процедуры

Объяснение логического вывода

Запись БД

Редактирование симптомов и болезней

Просмотр содержимого БД

Удаление симптомов и болезней из БД, получнение выбора, запуск выбранной

процедуры

Добавление симптомов и болезней в БД, получение выбора, запуск выбранной

процедуры

Загрузка БД

Редактирование симптомов

Редактирование болезни

Удаление симптомов

Удаление болезни с ее симптомами

Добавление новых симптомов

Добавление новой болезни

Страницы: 1, 2, 3