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

A Replace Function in Lisp That Duplicates Mathematica Functionality

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

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

和 return 值 {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)
)

并获得 return 值 ((x y) (f (x y y2)))

哦,天哪,Mathematica 如何通过应用其著名的 NIH 方法来混淆一切。

基本上,您正在寻找一个根据某种模式执行字符串替换的函数。在大多数语言中,这是通过正则表达式完成的。

例如,在使用 cl-ppcre 库的 Common Lisp 中,它看起来像这样:

(cl-ppcre:regex-replace-all
 ;; regular expression you match against with groups
 "f\[{(x[^ ]*), \"\[\", ((y[^ ]* ?)+), \"\]\"}\]"
 ;; your string
 "{f[{x, \"[\", y, \"]\"}], f@f[{x, \"[\", y, y2, \"]\"}]}"
 ;; substitution expression using groups 1 & 2 
 "\1[\2]")

当然,您可以针对这个使用 subst 和递归来匹配和替换子树的问题编写一个专门的 20 行函数,但是如果您想要的只是与所提供的情况类似的情况,您就可以逃脱使用简单的基于正则表达式的方法。

我们再试一次。

首先,安装quicklisp and use it to fetch, install and load optima and alexandria

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

下面引用的 alexandria 中的函数是 ensure-listlast-elt。如果你没有安装它们,你可以使用下面的定义:

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

我们将规则定义为从一种形式到另一种形式的函数。 下面,该函数尝试将输入解构为 (f (<X> "[" <ARGS> "]"),其中 <ARGS> 是零或多个形式。如果解构失败,我们 return NIL (我们期望不匹配的过滤器到 return 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)。如果给出了规则列表,则应returned(待完成)匹配列表。

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