在Lisp中找到直角三角形

时间:2013-05-15 16:22:34

标签: common-lisp

我正在浏览“了解你一个Haskell”并在this page的最底部发现了一种找到三元组(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 个答案:

答案 0 :(得分: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))

由于设置操作被定义为二进制,因此丑陋的位是三角形表示为'((a b)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)))))

如果你添加一个简单的宏→

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

答案 1 :(得分: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))

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

答案 2 :(得分: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))))))

(dotimes (i n))从0 i循环n-1时,abc都会有所不同。因此,不会发现等腰三角形。然而,由于没有等腰直角三角形存在于所有边长都是有理数的情况下,这不是问题。

答案 3 :(得分: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)