Добавил:
Upload Опубликованный материал нарушает ваши авторские права? Сообщите нам.
Вуз: Предмет: Файл:
2ргр.doc
Скачиваний:
3
Добавлен:
27.10.2018
Размер:
111.1 Кб
Скачать

Список использованных источников

  1. http://ru.wikipedia.org/wiki/Лисп.

  2. Курс лекций.

Приложение а

Листинг задачи №1

(setf filep (Open “D:\\pattern.txt”:direction :input))// Считывание таблицы из файла

(setf db (read filep))

(close filep)

(defun str-to-int (str)// Функция преобразует строку цифр в положительное целое число

(setf number 0)

(dotimes (i (length str) number)

(setf number (+ (* number 10) (- (char-code (aref str i)) 48)))))

(defun search-predp(aw af)// Функция отыскивает предприятия с годом до aw и видом деятельности af

(setf res "")

(dolist (l db)

(cond ((and (>= (str-to-int (nth 2 l)) (str-to-int aw))

(equalp (nth 5 l) af))

(setf res (concatenate 'string res " " (nth 1 l))))))

res)

(defun word-equalp (p d)// Функция сравнивает два слова с учетом специальных символов $ и ?

(cond ((> (length p) 1)

(setf p1 (mapcar 'string (coerce p 'list)))

(setf d1 (mapcar 'string (coerce d 'list)))

(match p1 d1))

(t (equalp p d))))

(defun list-of-string (bigstr)// Функция преобразует строку в список строк, состоящих из слов этой строки

(setf str '() substr "")

(dotimes (k (length bigstr) str)

(cond ((equalp (aref bigstr k) #\space)

(cond ((not (equalp substr "")) (setf str (append str (list substr)))))

(setf substr ""))

(t (setf substr (concatenate 'string substr (string (aref bigstr k)))))))

(cond ((not (equalp substr "")) (setf str (append str (list substr)))))

str)

(defun match (obr fact)//Функция сопоставляет образец и факт, заданных в виде списка строк

(cond

((and (null obr) (null fact)) t) //Правило 1

((and (null (cdr obr)) (equalp (car obr) "$") (null fact)) t)// Правило 2

((and (not (null obr))//Правило 3

(not (null fact))

(word-equalp (car obr) (car fact))

(match (cdr obr) (cdr fact))) t)

((and (not (null obr))//Правило 4;

(not (null fact))

(equalp (car obr) "?")

(match (cdr obr) (cdr fact))) t)

((and (not (null obr))//Правило с присваиванием значения переменной

(not (null fact))

(equalp (aref (car obr) 0) #\>)

(match (cdr obr) (cdr fact))) (set (intern (coerce (cdr (mapcar 'char-upcase (coerce (car obr) 'list))) 'string)) (car fact)) t)

((and (not (null obr))//Правило 5;

(not (null fact))

(equalp (car obr) "$")

(match (cdr obr) fact)) t)

((and (not (null obr))//Правило 6;

(not (null fact))

(equalp (car obr) "$")

(match obr (cdr fact))) t)))

(print "Ваш вопрос:")

(setf user (list-of-string (read)))//Задание вопроса и формирование ответа на этот вопрос

(cond ((or (match (list-of-string "? предприятий основанных до$ >god и основной вид деятельности=vid") user)

(match (list-of-string "$ название$ ? предприяти? $ основанных до$ >god и $ вид деятельности =vid") user))

(princ (concatenate 'string "Предприятия основанные до " god

" и видом деятельности " vid " имеют следующие названия:" (search-predp god vid))))

(t (princ "Ваш вопрос непонятен!")))

Ваш вопрос:

У каких предприятий основанных до 1989 года основной вид деятельности оптовая торговля.

Предприятия основанные до 1989 и видом деятельности оптовая торговля имеют следующие названия: "Янтарь" "Марианда"

Соседние файлы в предмете [НЕСОРТИРОВАННОЕ]