A few more

p91.lisp

@@ -0,0 +1,32 @@
+(defun dot (a b)
+  "Returns the dot product of vectors A and B"
+  (reduce #'+ (mapcar #'* a b)))
+
+(defun right-triangle-p (o p q)
+  "Returns non-NIL if the triangle made by points O, P, and Q (integer coordinates) is a right triangle"
+  (loop with op = (mapcar #'- o p)
+	with pq = (mapcar #'- p q)
+	with qo = (mapcar #'- q o)
+	repeat 3
+	do (when (= 0 (dot op pq))
+	     (return t))
+	   (rotatef op pq qo)))
+
+(defun right-triangles-with-integer-coordinates (&optional (max 50))
+  (let ((count 0)
+	(mirrored (make-hash-table :test 'equal))
+	(o (list 0 0)))
+    (loop for x1 from 0 upto max do
+      (loop for y1 from 0 upto max do
+	(loop for x2 from 0 upto max do
+	  (loop for y2 from 0 upto max do
+	    (let ((p (list x1 y1))
+		  (q (list x2 y2)))
+	      (when (and (not (equal p q))
+			 (not (equal o p))
+			 (not (equal o q))
+			 (not (gethash (append p q) mirrored))
+			 (right-triangle-p o p q))
+		(setf (gethash (append q p) mirrored) t)
+		(incf count)))))))
+    count))

p93.lisp

@@ -0,0 +1,62 @@
+;;; Approach: Try all permutations for 4 digits (1 - 9) and try all
+;;; permutations of arithmetic operators, using both possible
+;;; three-operator computation trees.
+
+(defparameter *arithmetic-operations* (list #'+
+					    #'-
+					    #'*
+					    #'/))
+
+(defun possible-results (digits)
+  "Returns all the possible arithmetic results from the digits in the ascending list LIST"
+  (ret (results nil)
+    (for-each-permutation
+     (lambda (list)
+       (loop for op1 in *arithmetic-operations* do
+	 (loop for op2 in *arithmetic-operations* do
+	   (loop for op3 in *arithmetic-operations* do
+	     ;; Note: There are only two tree structures; test them both
+	     (let ((values nil))
+	       ;; E.g. (1 + 2) * (3 + 4)
+	       (ignore-errors
+		(let* ((a (funcall op1 (first list) (second list)))
+		       (b (funcall op2 (third list) (fourth list)))
+		       (result (funcall op3 a b)))
+		  (pushnew result values)))
+	       ;; E.g. (1 + 2) * 3 / 4
+	       (ignore-errors
+		(let ((result (first list)))
+		  (setf result (funcall op1 result (second list)))
+		  (setf result (funcall op2 result (third list)))
+		  (setf result (funcall op3 result (fourth list)))
+		  (pushnew result values)))
+	       ;; Add valid results
+	       (loop for result in values do
+		 (when (and (integerp result)
+			    (>= result 1))
+		   (pushnew result results))))))))
+     digits)))
+
+(defun consecutive (values)
+  "Returns the number of consecutive positive integers from 1 that are in VALUES"
+  (loop for count upfrom 0
+	for last-value = 0 then value
+	for value in values
+	while (= (1+ last-value) value)
+	finally (return count)))
+
+(defun arithmetic-expressions ()
+  (loop with best = 0
+	with best-list = nil
+	for a from 1 upto 6
+	do (loop for b from (1+ a) upto 7 do
+	  (loop for c from (1+ b) upto 8 do
+	    (loop for d from (1+ c) upto 9
+		  for list = (list a b c d)
+		  for possible = (possible-results list)
+		  for consecutive = (consecutive (sort possible #'<))
+		  do (when (> consecutive best)
+		       (setf best consecutive)
+		       (setf best-list list)))))
+	finally (return (values (concatenate 'string (mapcar #'digit-char best-list))
+				best))))