Реализации алгоритмов/Ковёр Серпинского: различия между версиями

Lisp from Lee Mac
м (иллюстрация)
(Lisp from Lee Mac)
ZoomExtents
End Sub
</source>
 
== Построение методом [[w:en:Iterated Function System|IFS]] на [[w:Lisp|Lisp]] для [[w:Система автоматизированного проектирования|CAD-систем]] ==
Использована [[w:en:Iterated Function System|IFS]]-функция, реализованная программистом [http://www.lee-mac.com/iteratedfunctionsystems.html Lee Mac].
<source lang="lisp">
(defun c:gasket (/ ptlst pt probability)
;; Thanks to Lee Mac ~ 23.06.2014
(repeat 100000
(setq probability (rng))
 
(Point (setq pt (cond ( (< probability 0.125)
(iterate pt '((0.333 0.0)
(0.0 0.333)) '(-1.0 -1.0)))
( (<= 0.125 probability 0.25)
(iterate pt '((0.333 0.0)
(0.0 0.333)) '(-1.0 0.0)))
( (<= 0.25 probability 0.325)
(iterate pt '((0.333 0.0)
(0.0 0.333)) '(-1.0 1.0)))
( (<= 0.325 probability 0.5)
(iterate pt '((0.333 0.0)
(0.0 0.333)) '(0.0 1.0)))
( (<= 0.5 probability 0.625)
(iterate pt '((0.333 0.0)
(0.0 0.333)) '(1.0 1.0)))
( (<= 0.625 probability 0.75)
(iterate pt '((0.333 0.0)
(0.0 0.333)) '(1.0 0.0)))
( (<= 0.75 probability 0.825)
(iterate pt '((0.333 0.0)
(0.0 0.333)) '(1.0 -1.0)))
(t (iterate pt '((0.333 0.0)
(0.0 0.333)) '(0.0 -1.0)))))))
(princ))
;; Function written by Lee Mac
(defun iterate (point matrix vector)
(mapcar
(function +)
(mapcar
(function
(lambda (row)
(apply (function +)
(mapcar (function *) row point)))) matrix) vector))
;; Function written by Lee Mac
(defun rng (/ modulus multiplier increment random) ;; Stig
(if (not seed) (setq seed (getvar "DATE")))
(setq modulus 4294967296.0 multiplier 1664525 increment 1
seed (rem (+ (* multiplier seed) increment) modulus)
random (/ seed modulus)))
;; Function written by Lee Mac
(defun Point (pt)
(entmakex (list (cons 0 "POINT") (cons 10 pt) (cons 62 40))))
</source>