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

Question

在 Mathematica 克隆或任何版本的 Lisp 中完成以下操作的最简单方法是什么(实际上任何语言都可能没问题，甚至 Haskell)？它没有出现任何口齿不清 have a similar replace function .

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

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

它替换了 args 中 f[{x_, "[", y__, "]"}] 的所有实例，其中 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))))