LISP - программа для поиска конкретной функции по ее параметрам
Для курсового проекта мне нужно написать программу на lisp.
Программа должна содержать наиболее важные функции lisp, их входные и выходные параметры и, возможно, дополнительные параметры.
Например: функция - первая, вход - список, выход - объект (первый член списка).
Программа должна работать двумя разными способами:
Вы даете программе имя функции, и она должна возвращать параметры функции.
Вы вводите параметры функции, и если функция с этими параметрами существует, она должна возвращать имя функции.
Мои вопросы:
Как правильно подходить к такой задаче в LISP? Я думаю, может быть, дерево будет способ справиться с этим? (создайте дерево со всеми функциями и параметрами, а затем напишите программу, которая его обрабатывает).
Кто-нибудь есть идея лучше, чем это, чтобы подойти к этой задаче? Или какие-то предложения, где / как начать? Или учебники, содержащие какую-либо информацию?
На данный момент я немного растерялся, как начать. Любая помощь, которую вы можете оказать, будет высоко оценена.
Английский не мой родной язык, поэтому я надеюсь, что все понятно.
Привет.
3 ответа
На первый взгляд задача, по-видимому, заключается в создании простой символической базы данных в памяти, доступной для поиска двумя способами. Записи в базе данных считаются функциями. "Выходные параметры", вероятно, можно понимать как одно или несколько возвращаемых значений. Эти вещи не названы в ANSI Lisp. Полезная интерпретация задачи состоит в том, чтобы в любом случае давать возвращаемые значения символическим меткам. Более того, мы можем использовать символы типа для возвращаемых значений, а также параметров. Так, например, запись в базе данных для функции cons может выглядеть так:
(cons (t t) cons) ;; function named cons takes two objects, returns a cons
Тип t является супертипом всех типов в ANSI Lisp; это означает "любое значение".
Список таких записей может быть помещен в некоторую глобальную переменную. Затем мы пишем функцию, которая, возможно, называется get-params-by-name такой что:
(get-params-by-name 'cons) -> (t t)
и еще один: get-names-by-params:
(get-names-by-params '(t t)) -> (cons)
Эта функция возвращает все соответствующие функции в виде списка. Эта функция может иметь несколько функций.
Хитрость заключается в том, чтобы найти хорошее представление необязательных и остальных параметров. Это может быть просто та же запись, которую использует язык:
(list (&rest t) list) ;; list takes rest arguments of any type, returns list
Поскольку нас интересуют только точные совпадения, нам не нужно анализировать &rest нотации. Когда пользователь выполняет запрос по параметру, его объект запроса будет буквально (&rest t)в том же синтаксисе.
equal Функция может использоваться для определения идентичности двух списков символов:
(equal '(&rest t) '(&rest t)) -> t
(equal '(t t) '(t t)) -> nil
Так что упражнение несложное: просто составлять списки, искать совпадения.
(defun get-name-by-params (database params)
(let ((matching-entries (remove-if-not (lambda (entry)
(equal (second entry) params))
database)))
(mapcar #'first matching-entries))) ;; just the names, please
Здесь функция принимает список базы данных в качестве параметра, а не ссылается на глобальную переменную. Общая программа, в которую мы интегрируем это, может предоставить альтернативные интерфейсы, но это наша функция поиска низкого уровня.
Тестовое задание:
[1]> (get-name-by-params '((cons (t t) cons) (list (&rest t) list)) '(integer string))
NIL
[3]> (get-name-by-params '((cons (t t) cons) (list (&rest t) list)) '(t t))
(CONS)
[4]> (get-name-by-params '((cons (t t) cons) (list (&rest t) list)) '(&rest t))
(LIST)
Я получил бы разъяснение от инструктора, является ли это правильной интерпретацией расплывчатых требований, прежде чем задание будет назначено.
First of all take a look to prepare your common lisp development environment. After that I think that you should, investigate:
create functions with defun,
and things like that. Ffter that take a look to two common lisp functions:
Here is a little example:
CL-USER> (defun my-sum (a b) "Add my-sum parameters A and B." (+ a b))
MY-SUM
CL-USER> (my-sum 2 3)
5 (3 bits, #x5, #o5, #b101)
CL-USER> (describe #'my-sum)
#<FUNCTION MY-SUM>
[compiled function]
Lambda-list: (A B)
Derived type: (FUNCTION (T T) (VALUES NUMBER &OPTIONAL))
Documentation:
Add my-sum parameters A and B.
Source form:
(SB-INT:NAMED-LAMBDA MY-SUM
(A B)
"Add my-sum parameters A and B."
(BLOCK MY-SUM (+ A B)))
; No values
CL-USER> (documentation 'my-sum 'function)
"Add my-sum parameters A and B."
CL-USER> (defun my-sum (a b) "Add my-sum parameters A and B." (declare (type fixnum a b)) (+ a b))
WARNING: redefining COMMON-LISP-USER::MY-SUM in DEFUN
MY-SUM
CL-USER> (describe #'my-sum)
#<FUNCTION MY-SUM>
[compiled function]
Lambda-list: (A B)
Derived type: (FUNCTION (FIXNUM FIXNUM)
(VALUES
(INTEGER -9223372036854775808 9223372036854775806)
&OPTIONAL))
Documentation:
Add my-sum parameters A and B.
Source form:
(SB-INT:NAMED-LAMBDA MY-SUM
(A B)
"Add my-sum parameters A and B."
(DECLARE (TYPE FIXNUM A B))
(BLOCK MY-SUM (+ A B)))
; No values
Finally, one last tip to work with strings from the output of describe:
CL-USER> (with-output-to-string (*standard-output*)
(describe #'my-sum))
"#<FUNCTION MY-SUM>
[compiled function]
Lambda-list: (A B)
Derived type: (FUNCTION (FIXNUM FIXNUM)
(VALUES
(INTEGER -9223372036854775808 9223372036854775806)
&OPTIONAL))
Documentation:
Add my-sum parameters A and B.
Source form:
(SB-INT:NAMED-LAMBDA MY-SUM
(A B)
\"Add my-sum parameters A and B.\"
(DECLARE (TYPE FIXNUM A B))
(BLOCK MY-SUM (+ A B)))
"
Учитывая, что это курсовой проект, я собираюсь дать неполный ответ и оставлю вас заполнять пробелы.
Что должна делать программа
Моя интерпретация того, что вас просят сделать, это предоставить утилиту, которая будет
- по названию функции вернуть список аргументов (называемый ниже "лямбда-списком");
- по лямбда-списку вернуть все функции с этим лямбда-списком.
Итак, прежде всего вам необходимо решить, являются ли два лямбда-списка одинаковыми или нет. В качестве примера (x) такой же как (y), как лямбда-лист? Да, это так: имена формальных параметров имеют значение только при реализации функции, и вы, как правило, не будете их знать: оба этих лямбда-списка означают "функцию одного аргумента".
Интересная вещь - необязательные аргументы разных видов: (a &optional b) явно не то же самое, что (a), но такой же как (b &optional c) но это так же, как (a &optional (b 1 bp))? В этом коде я говорю, что да, это то же самое: значения по умолчанию и существующие параметры для необязательных аргументов не изменяют, являются ли лямбда-списки одинаковыми. Это потому, что очень часто это детали реализации функций.
Упаковка
Мы поместим его в пакет, чтобы было понятно, что это за интерфейс:
(defpackage :com.stackru.lisp.fdesc-search
(:use :cl)
(:export
#:defun/recorded
#:record-function-description
#:clear-recorded-functions
#:name->lambda-list
#:lambda-list->names))
(in-package :com.stackru.lisp.fdesc-search)
Запись информации
Итак, для начала нам нужен механизм записи информации о функциях. Мы сделаем это с макросом, который похож на defun но записывает информацию, которую я назову defun/recorded, Мы хотим иметь возможность записывать информацию о вещах еще до того, как программа существует, и мы делаем это, имея defun/recorded Храните "ожидающие" записи в списке, который, как только программа существует, будет выполняться и записываться правильно. Это позволяет нам использовать defun/recorded по всему этому коду.
;;; These define whether there is a recorder, and if not where pending
;;; records should be stashed
;;;
(defvar *function-description-recorder* nil)
(defvar *pending-function-records* '())
(defmacro defun/recorded (name lambda-list &body forms)
"Like DEFUN but record function information."
;; This deals with bootstrapping by, if there is not yet a recording
;; function, stashing pending records in *PENDING-FUNCTION-RECORDS*,
;; which gets replayed into the recorder at the point it becomes
;; available.
`(progn
;; do the DEFUN first, which ensures that the LAMBDA-LIST is OK
(defun ,name ,lambda-list ,@forms)
(if *function-description-recorder*
(progn
(dolist (p (reverse *pending-function-records*))
(funcall *function-description-recorder*
(car p) (cdr p)))
(setf *pending-function-records* '())
(funcall *function-description-recorder*
',name ',lambda-list))
(push (cons ',name ',lambda-list)
*pending-function-records*))
',name))
Соответствие лямбда-спискам, первые шаги
Теперь мы хотим соответствовать лямбда-спискам. Поскольку мы, очевидно, собираемся хранить вещи, индексированные лямбда-списком, в каком-то дереве, нам действительно нужно иметь дело с соответствующими элементами из них. И (см. Выше) нас не волнуют такие вещи, как значения по умолчанию. Я решил сделать это, прежде всего упрощая лямбда-списки, чтобы удалить их, а затем сопоставив элементы упрощений: есть и другие подходы.
simplify-lambda-list делает упрощение и argument-matches-p сообщает вам, если два аргумента совпадают: интересный момент заключается в том, что он должен знать о ключевых словах лямбда-списка, которые должны точно совпадать, а все остальное совпадает с чем-либо lambda-list-keywords константа удобно обеспечивается стандартом CL.
(defun/recorded simplify-lambda-list (ll)
;; Simplify a lambda list by replacing optional arguments with inits
;; by their names. This does not validate the list
(loop for a in ll
collect (etypecase a
(symbol a)
(list (first a)))))
(defun/recorded argument-matches-p (argument prototype)
;; Does an argument match a prototype.
(unless (symbolp argument)
(error "argument ~S isn't a symbol" argument))
(unless (symbolp prototype)
(error "prototype ~S isn't a symbol" prototype))
(if (find-if (lambda (k)
(or (eq argument k) (eq prototype k)))
lambda-list-keywords)
(eq argument prototype)
t))
Описание функций (частичное)
Информация о функциях хранится в объектах, называемых fdescs: здесь не дано определение этих объектов, но нам нужно ответить на один вопрос: "сделай два fdescs ссылаются на версии одной и той же функции? Ну, они делают, если имена функций совпадают. Помните, что имена функций не обязательно должны быть символами ((defun (setf x) (...) ...) разрешено), поэтому мы должны сравнить с equal не eql:
(defun/recorded fdescs-equivalent-p (fd1 fd2)
;; do FD1 & FD2 refer to the same function?
(equal (fdesc-name fd1)
(fdesc-name fd2)))
хранения fdescиндексируется лямбда-списком (частично)
Для эффективной индексации по лямбда-списку мы строим дерево. Узлы в этом дереве называются lambda-list-tree-nodeи их определение здесь не приводится.
Есть функции, которые интернируют fdesc в дереве, и которые возвращают список fdescs индексируется данным лямбда-списком. Здесь тоже нет реализации, но вот как они выглядят:
(defun/recorded intern-lambda-list (lambda-list tree-node fdesc)
;; return the node where it was interned
...)
(defun/recorded lambda-list-fdescs (lambda-list tree-node)
;; Return a list of fdescs for a lambda list & T if there were any
;; or NIL & NIL if there were not (I don't think () & T is possible,
;; but it might be in some future version)
...)
Для реализации этих функций, вероятно, потребуется использовать argument-matches-p а также fdescs-equivalent-p,
Базы данных верхнего уровня (немного частичные)
Теперь мы можем определить объекты базы данных верхнего уровня: корень дерева для индексации по лямбда-списку и хеш-таблицу для индексации по имени
(defvar *lambda-list-tree* (make-lambda-list-tree-node))
(defvar *tree-nodes-by-name* (make-hash-table :test #'equal))
Обратите внимание, что *tree-nodes-by-name* сопоставляет имена с узлом, где хранится информация об этой функции: это сделано для упрощения переопределения, как показано в следующей функции:
(defun/recorded record-function-description (name lambda-list)
"Record information about a function called NAME with lambda list LAMBDA-LIST.
Replace any existing information abot NAME. Return NAME."
(let ((fdesc (make-fdesc :name name :lambda-list lambda-list)))
;; First of all remove any existing information
(multiple-value-bind (node foundp) (gethash name *tree-nodes-by-name*)
(when foundp
(setf (lambda-list-tree-node-values node)
(delete fdesc (lambda-list-tree-node-values node)
:test #'fdescs-equivalent-p))))
(setf (gethash name *tree-nodes-by-name*)
(intern-lambda-list lambda-list *lambda-list-tree* fdesc)))
name)
Обратите внимание, что эта функция в первую очередь ищет любую существующую информацию для nameи, если он существует, он удаляет его из узла, где он был найден. Это гарантирует, что переопределение функции не оставляет устаревшую информацию в дереве.
Эта функция является фактическим рекордером, который defun/recorded хочет знать о, так что скажите это, что:
(setf *function-description-recorder*
#'record-function-description)
Теперь в следующий раз мы вызываем defun/recorded он загрузит систему, вставив все ожидающие определения.
record-function-description является частью API для пакета: его можно использовать для записи информации о функциях, которые мы не определяем.
Функции пользовательского интерфейса
Помимо defun/recorded & record-function-description нам нужны некоторые функции, которые позволяют нам делать запросы в базу данных, а также функция, которая сбрасывает вещи:
(defun/recorded clear-recorded-functions ()
"Clear function description records. Return no values"
(setf *lambda-list-tree* (make-lambda-list-tree-node)
*tree-nodes-by-name* (make-hash-table :test #'equal))
(values))
(defun/recorded name->lambda-list (name)
"Look up a function by name.
Return either its lambda list & T if it is found, or NIL & NIL if not."
(multiple-value-bind (node foundp) (gethash name *tree-nodes-by-name*)
(if foundp
(values
(fdesc-lambda-list
(find-if (lambda (fd)
(equal (fdesc-name fd) name))
(lambda-list-tree-node-values node)))
t)
(values nil nil))))
(defun/recorded lambda-list->names (lambda-list)
"find function names matching a lambda-list.
Return a list of name & T if there are any, or NIL & NIL if none.
Note that lambda lists are matched so that argument names do not match, and arguments with default values or presentp parameters match just on the argument."
(multiple-value-bind (fdescs foundp) (lambda-list-fdescs lambda-list
*lambda-list-tree*)
(if foundp
(values (mapcar #'fdesc-name fdescs) t)
(values nil nil))))
И это все.
Примеры
После компиляции, загрузки и использования пакета (с добавлением недостающих битов) мы можем сначала добавить в него некоторые полезные дополнительные функции (это просто случайное рассеяние)
> (dolist (x '(car cdr null))
(record-function-description x '(thing)))
nil
> (dolist (x '(car cdr))
(record-function-description `(setf ,x) '(new thing)))
nil
> (record-function-description 'cons '(car cdr))
cons
> (record-function-description 'list '(&rest args))
Теперь мы можем сделать несколько запросов:
> (lambda-list->names '(x))
(null cdr
car
lambda-list->names
name->lambda-list
com.stackru.lisp.fdesc-search::simplify-lambda-list)
t
> (lambda-list->names '(&rest anything))
(list)
t
> (name->lambda-list 'cons)
(car cdr)
t
Пример хранения вещей на деревьях
Ниже приведен код, демонстрирующий один подход к хранению информации в деревьях (часто называемый попытками). Это не применимо выше по многим причинам, но чтение может помочь реализовать недостающие части.
;;;; Storing things in trees of nodes
;;;
;;; Node protocol
;;;
;;; Nodes have values which may or may not be bound, and which may be
;;; assigned. Things may be interned in (trees of) nodes with a
;;; value, and the value associated with a thing may be retrieved
;;; along with an indicator as to whether it is present in the tree
;;; under the root.
;;;
(defgeneric node-value (node)
;; the immediate value of a node
)
(defgeneric (setf node-value) (new node)
;; Set the immediate value of a node
)
(defgeneric node-value-boundp (node)
;; Is a node's value bound?
)
(defgeneric intern-thing (root thing value)
;; intern a thing in a root, returning the value
(:method :around (root thing value)
;; Lazy: this arround method just makes sure that primary methods
;; don't need to beother returning the value
(call-next-method)
value))
(defgeneric thing-value (root thing)
;; return two values: the value of THING in ROOT and T if is it present, or
;; NIL & NIL if not
)
;;; Implementatation for STRING-TRIE-NODEs, which store strings
;;;
;;; The performance of these will be bad if large numbers of strings
;;; with characters from a large alphabet are stored: how might you
;;; fix this without making the nodes enormous?
;;;
(defclass string-trie-node ()
;; a node in a string trie. This is conceptually some kind of
;; special case of an abstract 'node' class, but that doesn't
;; actually exist.
((children-map :accessor string-trie-node-children-map
:initform '())
(value :accessor node-value)))
(defmethod node-value-boundp ((node string-trie-node))
(slot-boundp node 'value))
(defmethod intern-thing ((root string-trie-node) (thing string) value)
;; intern a string into a STRING-TRIE-NODE, storing VALUE
(let ((pmax (length thing)))
(labels ((intern-loop (node p)
(if (= p pmax)
(setf (node-value node) value)
(let ((next-maybe (assoc (char thing p)
(string-trie-node-children-map node)
:test #'char=)))
(if next-maybe
(intern-loop (cdr next-maybe) (1+ p))
(let ((next (cons (char thing p)
(make-instance (class-of node)))))
(push next (string-trie-node-children-map node))
(intern-loop (cdr next) (1+ p))))))))
(intern-loop root 0))))
(defmethod thing-value ((root string-trie-node) (thing string))
;; Return the value associated with a string in a node & T or NIL &
;; NIL if there is no value for this string
(let ((pmax (length thing)))
(labels ((value-loop (node p)
(if (= p pmax)
(if (node-value-boundp node)
(values (node-value node) t)
(values nil nil))
(let ((next (assoc (char thing p)
(string-trie-node-children-map node)
:test #'char=)))
(if next
(value-loop (cdr next) (1+ p))
(values nil nil))))))
(value-loop root 0))))
;;; Draw node trees in LW
;;;
#+LispWorks
(defgeneric graph-node-tree (node))
(:method ((node string-trie-node))
(capi:contain
(make-instance 'capi:graph-pane
:roots `((nil . ,node))
:children-function (lambda (e)
(string-trie-node-children-map (cdr e)))
:edge-pane-function (lambda (pane parent child)
(declare (ignore pane parent))
(make-instance
'capi:labelled-line-pinboard-object
:text (format nil "~A" (car child))))
:print-function (lambda (n)
(let ((node (cdr n)))
(format nil "~A"
(if (node-value-boundp node)
(node-value node)
""))))))))