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

Я сбивал «Learn You a 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]

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

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

источник

2013-05-15 lightlike

Ну, код Haskell не вычисляет b так, как вы. Он на самом деле петли c от 1 до 10, b от 1 до c и от 1 до b. (ОК, он не работает, он генерирует последовательности.) Это объясняет, почему Haskell печатает только одно решение, в то время как ваш LISP генерирует два. –

Нет встроенной функции для генерации последовательностей в LISP; вы можете сделать это с рекурсией хвоста, но использование цикла легче читать и, вероятно, немного более эффективно. Вы можете подражать Haskell функцией * (defun sequence (ab) (цикл для i от a до b собирать i)) * –

Если вы добавите во внешний цикл 'named outer' и имеете в истинном состоянии' (return-from external) ', что сделало бы это * логически правильным. Но уродливый. –

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

Уродливые бит в этом представлении треугольников как «((а б) в) из-за множественные операций определяются как двоичные. Итак, да, теперь у меня есть хорошая загадка, чтобы решить: Определите заданные операции для списков переменных параметров.

Приветствия, макс

EDIT: Я сделал заданные операции п-ичных.Теперь это можно записать так:

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

источник

2013-05-16 15:48:12 max

Приятное касание с помощью знакомого, g! синтаксис с явным gensym, так что defmacro! не нужно было упоминать. –

Хех. Да, синтаксис синтаксиса - это то, что осталось от моего использования defmacro !, я обнаружил, что в конце абстракция была неполной. Я думаю, что он не справлялся с вложенными лямбда-списками. Были некоторые довольно волосатые случаи, но я точно не помню. Должна быть исправлена. – max

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

источник

2013-05-15 20:45:15

Вы можете использовать (рекурсивный) макрос, чтобы получить доступ к списковым:

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

и получать от сюсюкать:

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

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

источник

2013-05-15 20:49:00 Patrick

Ниже приведено решение с использованием 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)

источник

2013-05-20 05:23:29

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

ответ

Смежные вопросы