Нахождение правильных треугольников в Лиспе

Question

Я пролистал "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]

и мне было интересно, есть ли способ сделать это в Лиспе аналогичным образом / без явного использования циклов. Вот что я сделал -

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

Answer 1

Я не удержался, попробовав это, поскольку написал библиотеку игрушек для теории множеств в 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-арый. Теперь это можно записать так:

(∩ (× (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 с точки зрения читабельности imho:

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

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

Это заняло у меня некоторое время и, конечно, не завершено, но, похоже, работает.

Answer 3

Вы можете сделать петли менее выраженными, используя 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)) зацикливается iот 0 до n-1, a, b, а также c все будет по-другому. Таким образом, равнобедренный треугольник не будет найден. Однако, поскольку не существует равнобедренного прямоугольного треугольника, где все длины сторон являются рациональными числами, это не проблема.

Answer 4

Вот решение с использованием DSL на основе ограничений из пакета Screamer (устанавливается 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)