Lisp中的替换函数复制Mathematica功能

Question

在Mathematica克隆或任何版本的Lisp中完成以下内容的最简单方法是什么(任何语言实际上甚至可能都是Haskell)？它似乎没有任何lisps 具有类似的替换功能.

Replace[{
  f[{x, "[", y, "]"}],
  f@f[{x, "[", y, y2, "]"}]
  }
 , f[{x_, "[", y__, "]"}] :> x[y],
 Infinity]

和返回值 {x[y], f[x[y, y2]]}

它替换f[{x_, "[", y__, "]"}]args中x_表示单个变量并y__表示一个或多个变量的所有实例.

在lisp中,函数和替换可能是等价的(原谅我,我不是最好用Lisp).我正在寻找表格的功能(replace list search replace).

(replace
  '(
   (f (x "[" y "]"))
   (f (f '(x "[" y y2 "]")))
  )
  '(f (x_ "[" y__ "]"))
  '(x y)
)

并获得返回值((x y) (f (x y y2))).

Answer 1

让我们再试一次。

首先，安装 quicklisp并使用它来获取、安装和optima加载alexandria.

(ql:quickload :optima)
(ql:quickload :alexandria)
(use-package :alexandria)

alexandria下面引用的函数是ensure-list和last-elt。如果您没有安装它们，您可以使用以下定义：

(defun ensure-list (list) (if (listp list) list (list list)))
(defun last-elt (list) (car (last list)))

我们将规则定义为从一种形式到另一种形式的函数。下面，该函数尝试将输入解构为(f (<X> "[" <ARGS> "]")，其中<ARGS>是零个或多个形式。如果解构失败，我们返回NIL（我们期望不匹配的过滤器随后返回NIL）。

(defun match-ugly-funcall (form)
  (optima:match form
    ((list 'f (cons x args))
     (unless (and (string= "[" (first args))
                  (string= "]" (last-elt args)))
       (optima:fail))
     `(,x ,@(cdr (butlast args))))))

(match-ugly-funcall '(f (g "[" 1 3 5 4 8 "]")))
; => (G 1 3 5 4 8)

然后，我们用这个函数模仿 Mathematica 的 Replace，它采用一个表格和一个要尝试的规则列表。可以通过单个规则（感谢ensure-list）。如果给出了规则列表的列表，则应返回匹配列表（待完成）。

(defun match-replace (form rules &optional (levelspec '(0)))
  (setf rules (ensure-list rules))
  (multiple-value-bind (match-levelspec-p recurse-levelspec-p)
      (optima:ematch levelspec
        ((list n1 n2) (if (some #'minusp (list  n1 n2))
                          (optima:fail)
                          (values (lambda (d) (<= n1 d n2))
                                  (lambda (d) (< d n2)))))
        ((list n) (if (minusp n)
                      (optima:fail)
                      (values (lambda (d) (= d n))
                              (lambda (d) (< d n)))))
        (:infinity (values (constantly t) (constantly t))))
    (labels
        ((do-replace (form depth)
           (let ((result
                   (and (funcall match-levelspec-p depth)
                        (some (lambda (r) (funcall r form)) rules))))
             (cond
               (result (values result t))
               ((and (listp form)
                     (funcall recurse-levelspec-p depth))
                (incf depth)
                (do (newlist
                     (e (pop form) (pop form)))
                    ((endp form) (values form nil))
                  (multiple-value-bind (result matchedp) (do-replace e depth)
                    (if matchedp
                        (return (values (nconc (nreverse newlist) 
                                               (list* result form)) t))
                        (push e newlist)))))
               (t (values form nil))))))
      (do-replace form 0))))

还有一个测试：

(match-replace '(a b (f (x "[" 1 2 3 "]")) c d)
               #'match-ugly-funcall
               :infinity)
; => (A B (X 1 2 3) C D)
;    T

为了替换所有表达式而不是第一个匹配的表达式，请使用以下命令：

  (defun match-replace-all (form rules &optional (levelspec '(0)))
      (setf rules (ensure-list rules))
      (multiple-value-bind (match-levelspec-p recurse-levelspec-p)
          (optima:ematch levelspec
            ((list n1 n2) (if (some #'minusp (list  n1 n2))
                              (optima:fail)
                              (values (lambda (d) (<= n1 d n2))
                                      (lambda (d) (< d n2)))))
            ((list n) (if (minusp n)
                          (optima:fail)
                          (values (lambda (d) (= d n))
                                  (lambda (d) (< d n)))))
            (:infinity (values (constantly t) (constantly t))))
        (labels
            ((do-replace (form depth)
               (let ((result
                       (and (funcall match-levelspec-p depth)
                            (some (lambda (r) (funcall r form)) rules))))
                 (cond
                   (result result)
                   ((and (listp form)
                         (funcall recurse-levelspec-p depth))
                    (incf depth)
                    (mapcar (lambda (e) (do-replace e depth)) form))
                   (t form)))))
          (do-replace form 0))))