[Snippet] Triângulo de Sierpinski

[thoga31]

Vamos festejar a mudança de plataforma com mais um snippet que eu acho ser engraçado e muito educativo 😛

Mais uma brincadeira com a unit Graph... Já alguém ouviu falar do Triângulo de Sierpinski? Muito famoso entre os entusiastas da Geometria Fractal.

Querem saber como é este triângulo? Este programa calcula os pontos do triângulo segundo um método de aleatoriedade e que só falha 1~3% dos pontos - isto explicará um ou outro pixel fora do triângulo.

Enjoy! 😉

PROGRAM Sierpinski;

USES sysutils, graph;

VAR Driver, Modus : smallint;
   x, y, n : real;
   k : integer;

BEGIN
    try
       writeln('A desenhar o Triangulo de Sierpinski...');

       try
          DetectGraph(Driver, Modus);
          InitGraph(Driver, Modus, '');

          randomize;
          x := random;
          y := random;

          for k:=1 to 30000 do begin
              n := random;

              if (n<=1/3) then begin
                 x := x/2;
                 y := y/2;
              end
              else if (n>1/3) and (n<=2/3) then begin
                 x := (x+0.5)/2;
                 y := (1+y)/2;
              end
              else if (n>2/3) then begin
                 x := (x+1)/2;
                 y := y/2;
              end;

              PutPixel(round(500*x), round(500-500*y), White);
          end

       except
             ON ex:exception do begin
                writeln('ERRO: ',ex.message);
                CloseGraph;
             end;
       end

    finally
           write('ENTER para terminar...');
           readln; // pausa
           CloseGraph;
    end;
END.

Disponível na Wiki

[nunopicado]

Entusiastas da Geometria Fractal?

Mas isso existe? Sempre pensei que isso dos entusiastas era um mito urbano, e que na verdade era tudo feito com espelhos! 😄

Tá boa moço! 🙂

[thoga31]

Com espelhos ou sem espelhos, diz-me lá se o triângulo não é bonito? 😄

Eu acho que a Geometria Fractal é uma área muito interessante... como um método aleatório tão simples produz um resultado que, à partida, pareceria muito difícil de resolver.

[EMCM]

não consigo correr esse código. dá-me erro no try.

[nunopicado]

não consigo correr esse código. dá-me erro no try.

Isso é porque o teu compilador não deve estar a apanhar correctamente a unit SysUtils.

Podes ver isso entretanto, mas para poderes testar agora, aqui fica o mesmo snippet do Thoga31 mas sem o uso da estrutura try.

PROGRAM triang;
USES
sysutils, graph;
VAR
  Driver, Modus : smallint;
  x, y, n : real;
  k : integer;
BEGIN
 writeln('A desenhar o Triangulo de Sierpinski...');
 DetectGraph(Driver, Modus);
 InitGraph(Driver, Modus, '');
 randomize;
 x := random;
 y := random;
 for k:=1 to 30000 do
	 begin
		  n := random;
		  if (n<=1/3)
			 then begin
					   x := x/2;
					   y := y/2;
				  end
			 else if (n>1/3) and (n<=2/3)
					 then begin
							   x := (x+0.5)/2;
							   y := (1+y)/2;
						  end
					 else if (n>2/3)
							 then begin
									   x := (x+1)/2;
									   y := y/2;
								  end;
		  PutPixel(round(500*x), round(500-500*y), White);
	 end;
 write('ENTER para terminar...');
 readln; // pausa
 CloseGraph;
END.

Thoga, dá um efeito castiço! Sem os cálculos, nunca na vida se conseguia fazer tal coisa!

Edited May 16, 2012 at 07:57 PM by nunopicado

[Gnrtuga]

É pá agora deixaram-me curioso...deviam por umas fotos ou um video para os cuscos como eu poderem ver, sem ter que instalar o pascal e a copiar o código.. 😉

[pmg]

O artigo da Wikipedia sobre o tal do triangulo de Sierpinski tem uma imagem satisfatoria.

[thoga31]

Aqui está o resultado final através do programa 😉

[nunopicado]

É pá agora deixaram-me curioso...deviam por umas fotos ou um video para os cuscos como eu poderem ver, sem ter que instalar o pascal e a copiar o código.. 😉

Lindo... Vale a pena instalar o pascal e correr isto! 😉

[thoga31]

Ena, já temos duas imagens! 😄

Quanto ao Try... mete a directiva {$mode objfpc} antes do código, ou então a {$mode objpas} caso a primeira não funcione. O Free Pascal só corre o Try com uma destas directivas, o que é um pouco frustrante...

Edited May 16, 2012 at 09:15 PM by thoga31

[Gnrtuga]

Obrigado por matarem a minha curiosidade!

É de facto um resultado curioso...

p.s já estava a fazer download de um compilador de pascal, mas entretanto deu erro.

[thoga31]

Um que corre este bem e é pequeno é o Dev-Pascal... Não o recomendo para programar, mas serve para estas coisinhas pequenas... 😉

[nunopicado]

Qual é que estavas a fazer download?

Tenta este: http://sourceforge.net/projects/freepascal/files/latest/download?source=files

[Gnrtuga]

Um que corre este bem e é pequeno é o Dev-Pascal... Não o recomendo para programar, mas serve para estas coisinhas pequenas... 😉

Já instalei, criei um novo projecto em console (ou algo parecido) copiei e colei o código, mas dá erro, diz " Resource file. icon file not found(please change it in project Options)

[nunopicado]

Vais a Project, depois a Options, e onde tem a opção Icon (ou Application Icon, já não me lembro), defines o ícone qualquer (ficheiro .ico). Se não tiveres nenhum à mão, saca um qualquer, não é importante. Mas tens de por algum!

[Gnrtuga]

Qual é que estavas a fazer download?

Tenta este: http://sourceforge.n...ad?source=files

Já instalei (tenho a impressão que foi este que tentei instalar, mas de outro link) e já funciona..Só tem um problemazito (não é bem problema) é rapido de mais, 🙂 acabo por só conseguir ver o resultado final!

[nunopicado]

Insere a linha seguinte imediatamente após a que diz PutPixel(.........);

sleep(1);

Isto vai fazer o programa esperar 1 ms entre cada pixel que escreve.

Edited May 16, 2012 at 10:20 PM by nunopicado

[thoga31]

O Dev-Pascal dava esse problema porque criaste um Project e não um New Source File fora de qualquer projecto: um projecto necessita sempre de umas quantas coisas extras que só atrapalham quando queremos testar algo em 5 minutos 😉

[thoga31]

Após muitas modificações pelas quais a Wiki passou, finalmente pude disponibilizar o presente snippet na Wiki 😉

https://wiki.portugal-a-programar.pt/dev_geral/pascal/pronto-a-usar/sierpinski/