fork download
copy 
  1. (declaim (optimize (speed 3) (safety 0) (debug 0))
  2. 				 (inline distance))
  3.  
  4. (defun distance (pos1 pos2)
  5. 	(+ (expt (- (the unsigned-byte (car pos1)) (the unsigned-byte (car pos2))) 2)
  6. 		 (expt (- (the unsigned-byte (cdr pos1)) (the unsigned-byte (cdr pos2))) 2)))
  7.  
  8. (defun print-as-board (size poss)
  9. 	(loop
  10. 		 for x below size
  11. 		 do (loop
  12. 					 for y below size
  13. 					 do (format t "~a"
  14. 											(if (find (cons x y) poss :test #'equalp)
  15. 													"o"
  16. 													"+")))
  17. 		 (format t "~%")))
  18.  
  19. ;; 遅いバージョン
  20. (defun solve (size num)
  21. 	(labels
  22. 			((rec (i poss distances)
  23. 				 (when (zerop i)
  24. 					 (print-as-board size poss)
  25. 					 (return-from solve))
  26. 				 (loop
  27. 						for x below size
  28. 						do (loop
  29. 									for y below size
  30. 									for pos = (cons x y)
  31. 									for ds = (mapcar (lambda (pos1) (distance pos pos1)) poss)
  32. 									when (= (length poss)
  33. 													(length (remove-duplicates ds)))
  34. 									unless (find pos poss :test #'equalp)
  35. 									unless (intersection distances ds)
  36. 									do (rec (1- i) (cons pos poss) (append ds distances))))))
  37. 		(rec num () ())))
  38.  
  39.  
  40. (defun solve2 (size num)
  41. 	(declare (unsigned-byte size num))
  42. 	(let ((pos-array (make-array num :fill-pointer 0))
  43. 				(dist-array (make-array (the unsigned-byte (/ (* num (1- num)) 2))
  44. 																:element-type 'unsigned-byte
  45. 																:initial-element 0)))
  46. 		(labels
  47. 				((rec (i di)
  48. 					 (when (zerop i)
  49. 						 (print-as-board size pos-array) (terpri)
  50. 						 (return-from solve2))
  51. 					 (loop
  52. 							for x fixnum below size
  53. 							do (loop
  54. 										for y fixnum below size
  55. 										for pos = (cons x y)
  56. 										unless (find pos pos-array :test #'equalp)
  57. 										unless (loop
  58. 															for p across pos-array
  59. 															for i from di
  60. 															for d = (the unsigned-byte (distance pos p))
  61. 															when (find d dist-array :end i)
  62. 															return t
  63. 															do (setf (aref dist-array i) d))
  64. 										do (vector-push pos pos-array)
  65. 										(rec (the unsigned-byte (1- i)) (+ di (length pos-array) -1))
  66. 										(vector-pop pos-array)))))
  67. 			(rec num 0))))
  68.  
  69. (solve2 5 5)
  70. (solve2 6 6)
Success #stdin #stdout 0.26s 11064KB
comments (?)
stdin
copy 
Standard input is empty
stdout
copy 
oo++o
+++++
+o+++
+++++
+++o+

oo++++
+++o++
++++++
+++++o
++++++
++o++o
https://ideone.com/hgmA7b
language:
Common Lisp (clisp 2.49.92)
created:
9 years ago
visibility:
secret

Share or Embed source code

Discover > Sphere Engine API

The brand new service which powers Ideone!

Discover > IDE Widget

Widget for compiling and running the source code in a web browser!