Dutch national flag problem: Difference between revisions
Content added Content deleted
({{header|jq}}) |
(Add Common Lisp (based on Clojure's structure)) |
||
| Line 1,048: | Line 1,048: | ||
(sort-in-dutch-flag-order balls) ; (:red :red :red :red :red :white :white :white :white :white |
(sort-in-dutch-flag-order balls) ; (:red :red :red :red :red :white :white :white :white :white |
||
; :white :white :blue :blue :blue :blue :blue :blue :blue :blue) |
; :white :white :blue :blue :blue :blue :blue :blue :blue :blue) |
||
</pre> |
|||
=={{header|Common Lisp}}== |
|||
{{trans|Clojure}} |
|||
<syntaxhighlight lang="lisp"> |
|||
(defun dutch-flag-order (color) |
|||
(case color (:red 1) (:white 2) (:blue 3))) |
|||
(defun sort-in-dutch-flag-order (balls) |
|||
(sort (copy-list balls) #'< :key #'dutch-flag-order)) |
|||
(defun make-random-balls (count) |
|||
(loop :repeat count |
|||
:collect (nth (random 3) '(:red :white :blue)))) |
|||
(defun make-balls (count) |
|||
(loop :for balls = (make-random-balls count) |
|||
:while (equal balls (sort-in-dutch-flag-order balls)) |
|||
:finally (return balls))) |
|||
;; Alternative version showcasing iterate's finding clause |
|||
(defun make-balls2 (count) |
|||
(iter (for balls = (make-random-balls count)) |
|||
(finding balls such-that (not (equal balls (sort-in-dutch-flag-order balls)))))) |
|||
</syntaxhighlight> |
|||
{{out}} |
|||
<pre> |
|||
CL-USER> (defvar *balls* (make-balls 20)) |
|||
*BALLS* |
|||
CL-USER> *balls* |
|||
(:WHITE :WHITE :WHITE :WHITE :RED :BLUE :RED :RED :WHITE :WHITE :RED :BLUE :RED |
|||
:RED :BLUE :WHITE :BLUE :BLUE :BLUE :BLUE) |
|||
CL-USER> (sort-in-dutch-flag-order *balls*) |
|||
(:RED :RED :RED :RED :RED :RED :WHITE :WHITE :WHITE :WHITE :WHITE :WHITE :WHITE |
|||
:BLUE :BLUE :BLUE :BLUE :BLUE :BLUE :BLUE) |
|||
</pre> |
</pre> |
||