Целочисленный фрактал Мандельброта

[Tronix]

Случайно никто не подскажет целочисленный алгоритм построения фрактала Мандельброта? То есть без использования вещественных чисел.
Полагаю, что нужно подобрать некие коффициенты для умножения/деления в основной формуле. Если это важно, нужно для разрешения 320x240.

То, что это можно сделать доказывает приложенный файл на ассемблере размером 65 байт, который использует только 16-битные регистры и целочисленные операции. Но по нему очень все-таки трудно понять или восстановить оригинальный алгоритм на языке высокого уровня (дельфи или паскаль, например).

Меня бы вполне устроила картинка, которая получается с помощью этой программы.

[NetSpace]

Вот программа, рисующая множество мандельброта
там нужно подбирать коэффициенты C1 и C2.
Думаю, поможет. Комментарии отображаются нормально под DOS'ом.

program MnojestvoMandelbrota;
uses graph,crt;                   (* Ї®¤Є«озҐ*ЁҐ Ја*дЁЄЁ           *)
var
 x,y,w,c1,c2,c10,c20,dc1,dc2:real;
 gd,gm,i,j,k                :integer;
 begin
  clrscr;
  dc1:=0.001;
  dc2:=0.001;
  writeln('‚ўҐ¤ЁвҐ c10 (**ЇаЁ¬Ґа: -1.75 Ё«Ё 0.5)');
  write('c10=');
  readln(c10);
  writeln('‚ўҐ¤ЁвҐ c20 (**ЇаЁ¬Ґа 0)');
  write('c20=');
  readln(c20);
  gd:=DETECT;                     (* Ё*ЁжЁ*«Ё§Ёа㥬 Ја*дЁЄг        *)
  initgraph(gd,gm,'D:\PROGRAM\TP70\BGI');

  for i:=-320 to 320 do begin
   c1:=c10+dc1*i;

   for j:=-240 to 240 do begin
    c2:=c20+dc2*j;
    x:=0;
    y:=0;
    k:=0;
    repeat
     x:=x*x-y*y+c1;
     y:=2*x*y+c2;
     k:=k+1;
     w:=x*x+y*y;
     if w>5 then k:=30;
     until k>10;
     if(w<=5) then putpixel(320+i,240-j,10);
   end;
  end;
  readln;
 closegraph;
end.

[p51x]

целочисленный алгоритм

 x,y,w,c1,c2,c10,c20,dc1,dc2:real;

Мда... я что-то упустил...

[NetSpace]

Знаю, что тип переменных не тот, что просили. Но как ещё множество Мандельброта нарисвоать? Если это задание было на зачёт, то, видать, препод просто постебался над вами. Во всяком случае, можно поработать с округлением в этих строках - вот вам и будет целочисленный фрактал. Уравнения есть, а дальше дело за вашей фантазией. А вот скриншот очень уж похожий на тот, что моя программа выдаёт...задумайтесь...

[Tronix]

Да не, ну представьте, что в паскале/дельфях нет типа REAL, EXTENDED и прочих. И соответственно нет Round и Trunc. Есть только скажем WORD, или INTEGER. То, что можно используя лишь эти типы построить фрактал - это точно, это доказывает программа на ассемблере.

Щаз вот ознакомился со статьей http://habrahabr.ru/blogs/crazydev/62043/ , попробовал перевести все на паскаль, но в итоге не работает. На ассемблерные вставки не смотрите, просто влом было с Graph возиться. Там просто процедура вывода точки на экран и ожидания нажатия любой клавиши.

var
   xPixels, yPixels, xStart, yStart, Xsize, YSize, maxiter : longint;
   xStep, yStep : longint;
   ix,iy,x,y,x0,y0,iteration,xtemp,dist : longint;
function keypressed : boolean; assembler;
asm
 mov ah,$b
 int $21
 and al,$fe
end;

procedure put(x,y:word; c:byte); assembler;
asm
 mov dx,$3c4
 mov al,2
 out dx,al
 add dx,2
 mov al,[c]
 out dx,al
 mov bx,80
 mov es,sega000
 mov ax,[y]
 mul bx
 mov di,[x]
 shr di,3
 add di,ax
 mov dl,[es:di]
 mov ch,byte(x)
 and ch,7
 mov cl,7
 sub cl,ch
 mov ch,1
 shl ch,cl
 or dl,ch
 mov [es:di],dl
end;

begin
  asm mov ax,$12; int $10; end;
  XPixels := 180;
  YPixels := 120;
  XStart := -22000; { $AA10;}
  YStart := -10000; { $D8F0;}
  XSize := 32000;
  YSize := 20000;
  MaxIter := 32; {16}

  XStep := XSize div XPixels;
  YStep := YSize div YPixels;

  For iy := 0 to yPixels do
      For ix := 0 to xPixels do
          begin
               x := xStart + ix * xStep;
               y := yStart + iy * yStep;
               x0 := x;
               y0 := y;
               iteration := 0;
               Repeat
                     xtemp := (x*x) div 10000 - (y*y) div 10000 + x0;
                     y := (2*x*y) div 10000 + y0;
                     x := xtemp;
                     Inc(iteration);
                     dist := (x*x) div 10000 + (y*y) div 10000;
               Until (dist > 40000) or (iteration = maxiter);
               If iteration = maxiter then
                  Put(ix,iy,0)
               else
                  Put(ix,iy,iteration);
          end;

  repeat until keypressed;
  asm mov ax,$3; int $10; end;
end.

[veniside]

перевёл оригинальный ассемблерный код в более-менее читаемый исходник, вроде рисует. По пути немного прокомментировал, что где. Ширину и высоту можно менять, как и набор цветов. Так же, как и сдвиг по вертикали/горизонтали (см. комменты в коде).

// --  --
function paintBXCL(col: Integer; var row: Integer; Color: byte): bool;
var
  c: integer;
begin
  c := RGB(Color and 7 * 84, (Color shr 3) and 7 * 84, (Color shr 5) and 3 * 127);   // make some 256 colors
  //
  Form1.Canvas.Pixels[100 + col, 100 + row] := c;
  //
  if (0 = col) then begin
    //
    Application.ProcessMessages();
    inc(row);
    result := (240 < row); // stop painting after 240 rows
  end
  else
    result := false;
end;

// --  --
procedure TForm1.Button1Click(Sender: TObject);
var
  Summ: SmallInt;
  VShift: Integer;                    // Vertical Shift
  Column, Row: Integer;
  Color: Byte;
  BP: SmallInt;
  i: Integer;
begin
  VShift := 128;
  Row := 0;
  //
  repeat // row
    //
    Column := -321;                       // max width
    Dec(VShift);
    //
    repeat // col
      //
      Summ := 0;
      Inc(Column);
      if (0 > Column) then begin
        //
        BP := 0;
        for Color := 0 to 255 do begin // use full 256 color range
          //
          Inc(BP, Column + 127);  // 127 is horizontal shift
          //
          Inc(Summ, VShift);
          i := Summ * Summ;
          Summ := (Summ * BP) shr 5 + 1;
          //
          if (LongWord(i) > 65535) then
            break;        // overflow, skip to paint
          //
          BP := (Word(BP * BP) - Word(i)) shr 6;
        end; // for Color
        //
        if (paintBXCL(-Column - 1, Row, Color)) then
          Exit; // end of paint
        //
      end // if (0 < Column)
      else
        break;  // new Row
      //
    until false;
    //
  until false;
end;

[Tronix]

Жестока ) Спасибо, буду разбираться. О результатах отпишусь.

[veniside]

Слегка доработал. Упрощать уже вроде некуда. Не скажу, что стало всё ясно, но понятно, что для каждого пиксела оно крутит цикл по цвету, пока y не выйдет за диапазон [-255..255] (или пока цвета не закончатся), после чего рисует пиксель в [Column, Row] с тем цветом, который оказался при выходе из цикла.

// --  --
procedure TForm1.Button1Click(Sender: TObject);
var
  y, x: Integer;
  Column, Row: Integer;
  Color: Byte;
  temp: Word;
begin
  for Row := 0 to 400 do begin        // height
    for Column := 0 to 400 do begin   // width
      //
      y := 0;
      x := 0;
      Color := 0;
      while (Color < 255) do begin // use full 256 color range
        //
        Inc(x, 200 - Column);  // 200 - horizontal shift
        Inc(y, 200 - Row);     // 200 - vertical shift
        //
        if ((y < 255) and (y > -256)) then begin
          //
          temp := y * y;
          y := SmallInt((y * x) shr 5) + 1;      // 1 - deformity? try other values for crazy results
          x := (Word(x * x) - temp) shr 6;
        end
        else
          break; // done with color, draw it now
        //
        inc(Color);
      end;
      //
      // draw pixel
      pixelAt(Column, Row, Color);
      //
    end; // for Col
  end; // for Row
end;

[Tronix]

Спасибо за перевод исходника. Теперь бы вообще избавиться от integer, и оставить только word тип данных... Пока это не получается сделать.

Кстати, тот исходник, что я переводил со статьи хабра из бат-файла, таки заработал. Оказалось, что у меня процедура рисования точки глючила. На всякий случай оставлю его здесь, вдруг кто-то через поиск сюда выйдет.

var
   xPixels, yPixels, xStart, yStart, Xsize, YSize, maxiter : integer;
   xStep, yStep : longint;
   ix,iy,y,y0,x0,x,iteration,dist,xtemp : longint;
   F : Text;
function keypressed : boolean; assembler;
asm
 mov ah,$b
 int $21
 and al,$fe
end;

procedure put(x,y:word; c:byte);
Begin
     Mem[$A000:y*320+x] := c;
End;

begin
  asm mov ax,$13; int $10; end;
  XPixels := 320;
  YPixels := 200;
  XStart := -220;
  YStart := -100;
  XSize := 320;
  YSize := 200;
  MaxIter := 16; {16}

  XStep := XSize div XPixels;
  YStep := YSize div YPixels;

  For iy := 0 to yPixels do
      For ix := 0 to xPixels do
          begin
               x := xStart + ix * xStep;
               y := yStart + iy * yStep;

               x0 := x;
               y0 := y;
               iteration := 0;
               Repeat
                     xtemp := (x*x) div 100 - (y*y) div 100 + x0;
                     y := 2*((x*y) div 100) + y0;
                     x := xtemp;
                     Inc(iteration);
                     dist := (x*x) div 100 + (y*y) div 100;
               Until (dist > 400) or (iteration = maxiter);
               If iteration = maxiter then
                  Put(ix,iy,0)
               else
                  Put(ix,iy,iteration+15);
          end;

  repeat until keypressed;
  asm mov ax,$3; int $10; end;
end.

[veniside]

> вообще избавиться от integer

можно и так:

var
  y, x: SmallInt;
  Column, Row: Word;

SmallInt — это ж просто знаковый Word. Знак нужен, т.к. иначе алгоритм начинает не то считать.

У хабра-исходника, кстати, похожий алгоритм, только div вместо shr и немного другие коэффициенты.