Смекни!
smekni.com

Разработка оболочки экспертной системы (стр. 4 из 4)

(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)))) ))