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

Материал из Викиучебника — открытых книг для открытого мира
Содержимое удалено Содержимое добавлено
Создал
 
Строка 54: Строка 54:


<source lang="vb">
<source lang="vb">
Sub Gasket()
Dim i 'iterations
ThisDrawing.SetVariable "PDMODE", 0
Dim R 'random
ThisDrawing.SetVariable "PDSIZE", 1
Dim x

Dim y
Dim pointObj
Dim pointObj As AcadPoint
Dim x As Double
Dim y As Double

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


For i = 1 To 10000
For i = 1 To 10000
Строка 92: Строка 97:


ZoomExtents
ZoomExtents
End Sub
</source>
</source>



Версия от 06:28, 4 октября 2016

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

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

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

<?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);
?>

Построение методом хаоса на Visual Basic for Applications для CAD-систем

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

Sub Gasket()
ThisDrawing.SetVariable "PDMODE", 0
ThisDrawing.SetVariable "PDSIZE", 1

Dim pointObj As AcadPoint
Dim x As Double
Dim y As Double

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

For i = 1 To 10000
 R = Rnd(1)
 If R < 0.125 Then
  x = (x - 0.5) / 3
  y = (y - 0.5) / 3
 ElseIf R < 0.25 Then
  x = (x - 0.5) / 3
  y = y / 3
 ElseIf R < 0.375 Then
  x = (x - 0.5) / 3
  y = (y + 0.5) / 3
 ElseIf R < 0.5 Then
  x = x / 3
  y = (y + 0.5) / 3
 ElseIf R < 0.625 Then
  x = (x + 0.5) / 3
  y = (y + 0.5) / 3
 ElseIf R < 0.75 Then
  x = (x + 0.5) / 3
  y = y / 3
 ElseIf R < 0.875 Then
  x = (x + 0.5) / 3
  y = (y - 0.5) / 3
 Else
  x = x / 3
  y = (y - 0.5) / 3
End If

Set pointObj = ThisDrawing.ModelSpace.AddPoint(CStr(x)+","+CStr(y))
Next i

ZoomExtents
End Sub

См. также