2

我正在浏览“Learn You a Haskell”，并在此页面的最底部找到了一种找到表示具有指定周长的直角三角形的三元组（a，b，c）的方法，我发现它非常优雅 -

ghci> let rightTriangles' = [ (a,b,c) | c <- [1..10], b <- [1..c], a <- [1..b], a^2 + b^2 == c^2, a+b+c == 24]

我想知道是否有一种方法可以在 Lisp 中以类似的方式/不显式使用循环来执行此操作。这就是我所做的——

(defun sq (x) (expt x 2))

(loop for c from 1 to 10 do
    (loop for a from 1 to c do
       (let ((b (- 24 a c)))
          (if (= (sq c) (+ (sq a) (sq b)))
              (format t "~a, ~a, ~a~%" a b c)))))

但它显然不如 Haskell 版本好，而且它还打印出两次解决方案 ((6, 8, 10) 和 (8, 6, 10))，因为a从 1 到c.

4

4 回答 4

4

自从我在 CL 中为集合论编写了一个玩具库后，我忍不住试了一下。见http://repo.or.cz/w/flub.git/blob/HEAD:/bachelor-cs/set-theory.lisp。

(use-package '(:alexandria :bachelor-cs.set-theory))

(defun triangles (h)
  (let ((range (iota h :start 1)))
    (∩ (× (× range range) range)
       (lambda (triangle)
         (destructuring-bind ((a b) c) triangle
           (>= c b a))))))

(defun perimeter (n)
  (lambda (triangle)
    (destructuring-bind ((a b) c) triangle
      (= n (+ a b c)))))

(defun right-triangles (triangle)
  (destructuring-bind ((a b) c) triangle
    (= (* c c) (+ (* a a) (* b b)))))

(∩ (∩ (triangles 10) (perimeter 24)) #'right-triangles) ↦ (((6 8) 10))

此处的丑陋之处在于将三角形表示为 '((ab) c)，因为集合操作被定义为二进制。所以是的，现在我有一个很好的谜语要解决：定义变量参数列表的集合操作。

干杯，最大

编辑：我做了 n-ary 的集合操作。现在可以这样写：

(∩ (× (iota 10 :start 1) (iota 10 :start 1) (iota 10 :start 1))
   (lambda (tri)
     (destructuring-bind (a b c) tri
       (>= c b a)))
   (lambda (tri)
     (destructuring-bind (a b c) tri
       (= 24 (+ a b c))))
   (lambda (tri)
     (destructuring-bind (a b c) tri
       (= (+ (* a a) (* b b)) (* c c)))))

如果添加一个简单的宏 →</p> 

(defmacro → (args &rest body)
  (let ((g!element (gensym "element")))
    `(lambda (,g!element)
       (destructuring-bind ,args ,g!element
         ,@body))))

恕我直言，您在可读性方面非常接近 Haskell 版本：

(∩ (× (iota 10 :start 1) (iota 10 :start 1) (iota 10 :start 1))
   (→ (a b c) (>= c b a))
   (→ (a b c) (= 24 (+ a b c)))
   (→ (a b c) (= (+ (* a a) (* b b)) (* c c))))
于 2013-05-16T15:48:12.843 回答
2

您可以使用（递归）宏来访问列表推导：

(defmacro lcomp-h (var domain condition varl)
   (if (= 1 (length var))
     `(loop for ,(car var) from ,(caar domain) to ,(cadar domain) 
          when ,condition
          collect (list ,@varl))
      `(loop for ,(car var) from ,(caar domain) to ,(cadar domain) append
      (lcomp-h ,(cdr var) ,(cdr domain) ,condition ,varl))))

(defmacro lcomp (var domain condition)
  `(lcomp-h ,var ,domain ,condition ,var))

现在你有以下语法：

CL-USER> (lcomp (a b c) ((1 10) (a 10) (1 10)) (= (* c c) (+ (* a a) (* b b))))

并从 lisp 接收：

((3 4 5) (6 8 10))

我花了一段时间，肯定不完整，但似乎工作。

于 2013-05-15T20:49:00.843 回答
1

您可以使用dotimes而不是循环使循环不那么明显。

(defun right-triangles (circ)
       (dotimes (c (/ circ 2))
         (dotimes (b c)
            (dotimes (a b)
               (when (and (= circ (+ a b c))
                          (= (* c c) (+ (* a a) (* b b))))
                  (format t "~a, ~a, ~a~%" a b c))))))

从0(dotimes (i n))循环到, , , 和都会不同。因此不会找到等腰三角形。然而，由于不存在所有边长都是有理数的等腰直角三角形，所以这不是问题。in-1abc

于 2013-05-15T20:45:15.367 回答
1

这是使用Screamer包中基于约束的 DSL 的解决方案（可安装Quicklisp）：

CL-USER>
(in-package :screamer)
#<Package "SCREAMER">
SCREAMER>
(let* ((c (an-integer-betweenv 1 10))
       (b (an-integer-belowv c))
       (a (an-integer-belowv b)))
  (assert! (=v (*v c c)
               (+v (*v a a)
                   (*v b b))))
  (assert! (=v (+v a b c)
               24))
  (one-value
    (solution (list a b c)
              (static-ordering #'linear-force))))
(6 8 10)
于 2013-05-20T05:23:29.820 回答