'Program 2LOGMAPS.BAS analyzes system of 2 coupled logistic maps 'Compile with PowerBASIC 3.2 (http://www.powerbasic.com/) '(c) 1997 by J. C. Sprott (http://sprott.physics.wisc.edu/) screen 12 defext a-z randomize timer n%=2 'Number of maps dxo=1e-8 'Initial perturbation redim xnew(n%), x(n%), xonew(n%), xo(n%), a(n%), eps(n%) for neps=0 to 20 eps=neps/20 chaotic&=0: periodic&=0 cls line(0,0)-(479,479),,b for xp%=478 to 1 step -1 eps(1)=eps a(1)=3+xp%/479 for yp%=479-xp% to 1 step -1 for i%=1 to n%: x(i%)=rnd: next i% eps(2)=eps a(2)=3+(1-yp%/479) for i%=1 to n%: xo(i%)=x(i%): next i% ki%=100 'iterations to discard for k%=1 to 10000 if k%=ki% then 'assume we are on the attractor xo(1)=x(1)+.707*dxo xo(2)=x(2)+.707*dxo end if for i%=1 to n% j%=1+(i% mod n%) xnew(i%)=(1-eps(i%))*a(i%)*x(i%)*(1-x(i%))+eps(i%)*a(j%)*x(j%)*(1-x(j%)) xonew(i%)=(1-eps(i%))*a(i%)*xo(i%)*(1-xo(i%))+eps(i%)*a(j%)*xo(j%)*(1-xo(j%)) next i% dx2=0 for i%=1 to n% x(i%)=xnew(i%) xo(i%)=xonew(i%) dx=x(i%)-xo(i%) dx2=dx2+dx*dx next i% if k%>ki%+50 and (dx2<1e-8*dxo*dxo or dx2>1e8*dxo*dxo) then exit for next k% le=.5*log(dx2/dxo/dxo)/(k%-ki%) if le>0 then incr chaotic& else incr periodic& if le>0 then pset(xp%,yp%): pset(479-yp%,479-xp%) if len(inkey\$) then end next yp% next xp% locate 2,3: print using"#.##";eps; locate 3,3: print using"## %";100*chaotic&/(chaotic&+periodic&); call scn2bmp(chr\$(65+neps)+".BMP") next neps end SUB scn2bmp (filename\$) 'Captures the screen to a file filename\$ in bitmaped (BMP) format 'Palette correct in EGA and VGA color modes 7 - 12 only x1% = 0: y1% = 0: x2% = 479: y2% = 479 'Corners of image x2% = x1% + 16 * ceil((x2% - x1%) \ 16 + .01) - 1 beep sw% = 1 + x2% - x1% 'Width of image in pixels sh% = 1 + y2% - y1% 'Height of image in pixels sf& = sw% * sh% \ 2 'Bytes in image f% = FREEFILE OPEN filename\$ FOR OUTPUT AS f% PRINT #f%, mkhex\$("42 4D"); 'ASCII "BM" PRINT #f%, MKL\$(sf& + 118); 'Size of file in bytes PRINT #f%, mkhex\$("00 00 00 00"); 'Must be zero PRINT #f%, mkhex\$("76 00 00 00 28 00 00 00"); PRINT #f%, MKL\$(sw%); 'Screen width PRINT #f%, MKL\$(sh%); 'Screen height PRINT #f%, mkhex\$("01 00 04 00 00 00 00 00"); PRINT #f%, MKL\$(sf&); 'Size of image in bytes PRINT #f%, mkhex\$("00 00 00 00 00 00 00 00 00 00 00 00 00 00 00 00"); PRINT #f%, mkhex\$("FF FF FF 00"); 'Palette RGB values (0 - 15) PRINT #f%, mkhex\$("AA 00 00 00"); PRINT #f%, mkhex\$("00 AA 00 00"); PRINT #f%, mkhex\$("AA AA 00 00"); PRINT #f%, mkhex\$("00 00 AA 00"); PRINT #f%, mkhex\$("AA 00 AA 00"); PRINT #f%, mkhex\$("00 55 AA 00"); PRINT #f%, mkhex\$("AA AA AA 00"); PRINT #f%, mkhex\$("FF FF FF 00"); PRINT #f%, mkhex\$("FF 55 55 00"); PRINT #f%, mkhex\$("55 FF 55 00"); PRINT #f%, mkhex\$("FF FF 55 00"); PRINT #f%, mkhex\$("55 55 FF 00"); PRINT #f%, mkhex\$("FF 55 FF 00"); PRINT #f%, mkhex\$("55 FF FF 00"); PRINT #f%, mkhex\$("00 00 00 00"); a\$ = SPACE\$(sw% \ 2) FOR y% = y2% TO y1% STEP -1 x% = x1% WHILE x% < x2% a? = POINT(x%, y%) SHIFT LEFT a?, 4 INCR x% a? = a? OR POINT(x%, y%) INCR x% MID\$(a\$, (x% - x1%) \ 2, 1) = MKBYT\$(a?) WEND PRINT #f%, a\$; NEXT y% CLOSE f% beep END SUB FUNCTION mkhex\$ (a\$) 'Converts a sequence of space-delimited hexadecimal bytes to a string 'For example, mkhex\$("4A 4B 4C") evaluates to "JKL" bytes% = (LEN(a\$) + 1) / 3 c\$ = "" FOR i% = 1 TO bytes% b\$ = "&H" + MID\$(a\$, 3 * i% - 2, 3) c\$ = c\$ + CHR\$(VAL(b\$)) NEXT mkhex\$ = c\$ END FUNCTION