Реализации алгоритмов/Ковёр Серпинского

Ковёр Серпинского (квадрат Серпинского) — фрактал, один из двумерных аналогов множества Кантора, предложенный польским математиком Вацлавом Серпинским.

Ковёр (квадрат) Серпинского

Построение итеративным методом на php

править
 
6 итераций построения ковра Серпинского.
<?php
	set_time_limit(5);

	$i = 6;		// Количество итераций
	$xy = 1500;	// Размер стороны картинки

	$img = imagecreatetruecolor($xy, $xy);

	$black = imagecolorallocate($img, 0, 0, 0);
	$white = imagecolorallocate($img, 255, 255, 255);

	$cycle = 0;
	drawCarpet(0, 0, $xy, $xy, $i);
	function drawCarpet($a, $b, $c, $d, $n) {
		global $img, $white, $cycle;
		$cycle++;

		if($n <= 0) return;

		$a1 = 2 * $a / 3 + $c / 3;
		$c1 = $a / 3 + 2 * $c / 3;
		$b1 = 2 * $b / 3 + $d / 3;
		$d1 = $b / 3 + 2 * $d / 3;

		imagefilledrectangle($img, $a1, $b1, $c1, $d1, $white);

		drawCarpet($a, $b, $a1, $b1, $n - 1);
		drawCarpet($a1, $b, $c1, $b1, $n - 1);
		drawCarpet($c1, $b, $c, $b1, $n - 1);

		drawCarpet($a, $b1, $a1, $d1, $n - 1);
		drawCarpet($c1, $b1, $c, $d1, $n - 1);

		drawCarpet($a, $d1, $a1, $d, $n - 1);
		drawCarpet($a1, $d1, $c1, $d, $n - 1);
		drawCarpet($c1, $d1, $c, $d, $n - 1);
	}

	imagefilledrectangle($img, 0, 0, (strlen($cycle) * 9) , 16, $white);
	imagestring($img,21,0,0,$cycle,$black);

	header('Content-Type: image/png');
	imagepng($img);
?>

Построение рекурсивным методом на GDL для ArchiCAD

править

Поскольку язык GDL не предполагает процедур, для рекурсии используем переходы по меткам.

  1. Сразу переходим на i-ю метку
  2. i-я метка устанавливает параметры для метки (i-1) и переходит на метку рекурсивного алгоритма
  3. Метка рекурсивного алгоритма устанавливает позицию (x, y) и переходит на метку i-1
  4. ...
  5. Метка 0 строит квадрат

Рекурсивный алгоритм описывает 2D-матрицу, по которой строится каждая итерация ковра Серпинского.

В среде ArchiCAD вызываем интерфейс разработки библиотечных объектов (Ctrl+Shift+O). На вкладке «Параметры» задаём целую переменную i – число итераций.

Переходим в 3D-скрипт.

!!!3D Script

GOSUB i

END

4:
	n = 3
	d = 27
	GOSUB 100
RETURN

3:
	n = 2
	d = 9
	GOSUB 100
	n = 3
	d = 27
RETURN

2:
	n = 1
	d = 3
	GOSUB 100
	n = 2
	d = 9
RETURN

1:
	n = 0
	d = 1
	GOSUB 100
	n = 1
	d = 3
RETURN

0:
	PLANE 4, 0,0,0, 1,0,0, 1,1,0, 0,1,0
RETURN

100:
	GOSUB n		!11
	AddX d		!1: 2,1
	GOSUB n		!21
	AddX d		!2: 3,1
	GOSUB n		!31
	DEL 2		!0: 1,1

	AddY d		!1: 1,2
	GOSUB n		!12
	AddX 2*d	!2: 3,2
	GOSUB n		!32
	DEL 1		!1: 1,2

	AddY d		!2: 1,3
	GOSUB n		!13
	AddX d		!3: 2,3
	GOSUB n		!23
	AddX d		!4: 3,3
	GOSUB n		!33
	DEL 4		!0: 1,1
RETURN

Построение методом хаоса на VBA для CAD-систем

править

Строится ковёр Серпинского с центром в начале координат и стороной 1, т.е. каждая вершина удалена от центра на 0.5 по оси x и на 0.5 по оси y.

Sub Gasket()

Dim pointObj As AcadPoint
Dim location(0 To 2) As Double	'Координаты искомых точек xi, yi, zi; zn = 0

Dim i As Double		'Iteration Number
Dim R As Double		'Random Number

For i = 1 To 100000	
 R = Rnd(1)
 If R < 0.125 Then
  location(0) = (location(0) - 1) / 3	'location(0) = (location(0) - 2*0.5) / 3
  location(1) = (location(1) - 1) / 3
 ElseIf R < 0.25 Then
  location(0) = (location(0) - 1) / 3
  location(1) = location(1) / 3		'location(0) = (location(0) - 2*0) / 3
 ElseIf R < 0.375 Then
  location(0) = (location(0) - 1) / 3
  location(1) = (location(1) + 1) / 3
 ElseIf R < 0.5 Then
  location(0) = location(0) / 3
  location(1) = (location(1) + 1) / 3
 ElseIf R < 0.625 Then
  location(0) = (location(0) + 1) / 3
  location(1) = (location(1) + 1) / 3
 ElseIf R < 0.75 Then
  location(0) = (location(0) + 1) / 3
  location(1) = location(1) / 3
 ElseIf R < 0.875 Then
  location(0) = (location(0) + 1) / 3
  location(1) = (location(1) - 1) / 3
 Else
  location(0) = location(0) / 3
  location(1) = (location(1) - 1) / 3
End If

 Set pointObj = ThisDrawing.ModelSpace.AddPoint(location)
Next i
ZoomExtents
End Sub

Построение методом IFS на Lisp для CAD-систем

править

Использована IFS-функция, реализованная программистом Lee Mac.

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

См. также

править