Студопедия
Случайная страница | ТОМ-1 | ТОМ-2 | ТОМ-3
АрхитектураБиологияГеографияДругоеИностранные языки
ИнформатикаИсторияКультураЛитератураМатематика
МедицинаМеханикаОбразованиеОхрана трудаПедагогика
ПолитикаПравоПрограммированиеПсихологияРелигия
СоциологияСпортСтроительствоФизикаФилософия
ФинансыХимияЭкологияЭкономикаЭлектроника

var temp, t,tkon, r, tc, dt, hu,hv, rx, ry, sx,sy:real;

(Отстывание кофе) cof.pas

uses crt,graph;

var temp, t,tkon, r, tc, dt, hu,hv, rx, ry, sx,sy:real;

 

procedure init;

var d, m:integer;

begin

d:=detect;

initgraph(d,m,'');

temp:=95;

t:=0;

tkon:=30;

dt:=0.001;

r:=1;

tc:=22;

hu:=5;

hv:=getmaxy-5;

rx:=tkon;

ry:=100;

sx:=getmaxx/rx;

sy:=getmaxy/ry; line(round(hu),0,round(hu),getmaxy); line(0,round(hv),getmaxx,round(hv))

end;

 

procedure outres(x,y:real; color:word);

var u,v:word;

begin

u:=round(x*sx+hu);

v:=round(-y*sy+hv);

putpixel(u,v,color);

end;

 

procedure euler;

begin

while t<tkon do

begin

temp:=temp-r*(temp-tc)*dt;

t:=t+dt;

outres(t,temp,white);

end;

end;

 

BEGIN

init;

outres(t,temp,white);

euler;

repeat until keypressed;

closegraph;

END.

(Отстывание кофе, выводит значения в виде таблице) cof1.pas

uses crt,graph;

var temp, t,tkon, r, tc, dt, hu,hv, rx, ry, sx,sy:real;

 

procedure init;

var d, m:integer;

begin

crlscr;

d:=detect;

temp:=83;

t:=0;

tkon:=15;

dt:=1;

r:=0.04;

tc:=22;

hu:=5;

hv:=getmaxy-5;

rx:=tkon;

ry:=100;

sx:=getmaxx/rx;

sy:=getmaxy/ry;

end;

 

procedure outres(x,y:real; color:word);

var u,v:word;

begin

writeln(x:5:0,’’,y:5:1);

end;

 

procedure euler;

begin

while t<tkon do

begin

temp:=temp-r*(temp-tc)*dt;

t:=t+dt;

outres(t,temp,white);

end;

end;

 

BEGIN

init;

outres(t,temp,white);

euler;

repeat until keypressed;

END.

 

(падает относительно горизонта) gr.pas

program gr;

uses crt,graph;

var v,tk,h,a,t,rx,ry,tc,dt,hu,hv,x,y,

sx,sy,ax,ay,vx,vy,mas:real;

 

procedure init;

var d,m:integer;

begin

d:=detect;

initgraph(d,m,'');

x:=0;

v:=20;

vx:=v*cos(pi/4);

vy:=v*sin(pi/4);

h:=0.05;

dt:=0.001;

hu:=5;

hv:=getmaxy-5;

tc:=20;

rx:=tc;

ry:=100;

sx:=getmaxx/rx;

sy:=getmaxy/ry; line(round(hu),0,round(hu),round(getmaxy));

line(0,round(hv),getmaxx,round(hv));

end;

 

procedure outres(x,y:real;color:word);

var u,v:word;

begin

u:=round(x*sx+hu);

v:=round(-y*sy+hv);

putpixel(u,v,color);

end;

 

procedure Paden;

begin

while h>0 do

begin

ax:=0;

ay:=-9.8;

vx:=vx+ax*dt;

vy:=vy+ay*dt;

x:=x+vx*dt;

h:=h+vy*dt;

t:=t+dt;

outres(x,h,red);

end;

end;

{учётCопрот:v:=sqrt(vx*vx+vy*vy);

Ax:= -k*v*vx

Ay:=-9.8-k*v*vy}

{ветер: ax:=-k*v*vx+3;}

BEGIN

init;

outres(x,h,red);

paden;

repeat until keypressed;

closegraph;

END.

(падает относительно вертикали) pad1.pas

uses crt,graph;

const g=9.8;

k=1;

var a,v,h,y,m,r,t, dt, hu,hv, rx, ry, sx,sy:real;

 

procedure init;

var d, m:integer;

begin

d:=detect;

initgraph(d,m,'');

m:=5;

h:=90;

t:=0;

dt:=0.0001;

hu:=5;

hv:=getmaxy-5;

rx:=10;

ry:=100;

sx:=getmaxx/rx;

sy:=getmaxy/ry;

line(round(hu),0,round(hu),getmaxy);

line(0,round(hv),getmaxx,round(hv))

end;

 

procedure outres(x,y:real; color:word);

var u,v:word;

begin

u:=round(x*sx+hu);

v:=round(-y*sy+hv);

putpixel(u,v,color);

setcolor(1);

circle(630,v,10);

delay(3);

setcolor(0);

circle(630,v,10);

end;

 

procedure euler;

begin

while h>0 do

begin

a:=-9.8;

v:=v+a*dt;

h:=h+v*dt;

t:=t+dt;

outres(t,h,white);

end;

end;

 

BEGIN

init;

outres(t,h,white);

euler;

repeat until keypressed;

closegraph;

END.

 

 

(грузик на пружинке) gruzik.pas

program gr;

uses crt,graph;

var x,v,a,w0,gamma,w,t,dt,tk,f0:real;

Hu,Hv,Sx,Sy,rx,ry:real;

 

procedure init;

var d,m:integer;

begin

d:=detect;

initgraph(d,m,'');

Hu:=5;

Hv:=getmaxy/2;

tk:=20;

rx:=tk;

ry:=3;

Sx:=getmaxx/rx;

Sy:=getmaxy/ry;

dt:=0.00001;

t:=0;

x:=1;

v:=1;

w0:=1;

gamma:=1;

f0:=0.1;

w:=1; line(round(Hu),0,round(Hu),round(getmaxx)); line(0,round(Hv),getmaxx,round(Hv));

end;

 

procedure outres(x,y:real;color:word);

var u,v:word;

begin

u:=round(x*Sx+Hu);

v:=round(-y*Sy+Hv);

putpixel(u,v,color);

end;

 

procedure euler;

begin

while t<tk do

begin

a:= -w0*w0*x-gamma*v+f0*cos(w*t);

v:=v+a*dt;

x:=x+v*dt;

t:=t+dt;

outres(t,x,red);

end;

end;

{для1случ.:a:=-w0*w0*x;

для2случ.:a:=-w0*x-gamma+v;}

BEGIN

init;

outres(t,x,red);

euler;

repeat until keypressed;

closegraph;

END.

(Кролики и лисы) kroliki.pas

program lisi;

uses crt,graph;

var Hu,Hv,Sx,Sy,rx,ry:real; f,g,r,t,dt,tk,krbr,krdr,krbf,krdf:real;

 

procedure Init;

var d,m:integer;

begin

d:=detect;

Initgraph(d,m,'');

Hu:=5;

Hv:=getmaxy-5;

g:=6;

r:=5;

f:=4;

t:=0;

dt:=0.0001;

tk:=30;

krbr:=0.5;

krdr:=0.5;

krbf:=0.05;

krdf:=0.5;

rx:=tk;

ry:=100;

Sx:=getmaxx/rx;

Sy:=getmaxy/ry; line(round(Hu),0,round(Hu),round(getmaxx)); line(0,round(Hv),getmaxx,round(Hv));

end;

 

Procedure outres(x,y:real;color:word);

var u,v:word;

begin

u:=round(x*Sx+Hu);

v:=round(-y*Sy+Hv);

PutPixel(u,v,color);

end;

 

procedure euler;

begin

while t<tk do

begin

r:=(krbr*g*r-krdr*f*r)*dt+r;

f:=(krbf*r*f-krdf*f)*dt+f;

t:=t+dt;

{ outres(f,r,red);{fazovaya 4astota}

outres(t,f,red);

outres(t,r,white);

end;

end;

 

BEGIN

init;

outres(t,f,red);

outres(t,r,white);

{outres(f,r,red);{fazovaya 4astota}

euler;

repeat until keypressed;

closegraph;

END.

(глайдер) life.pas

program life;

uses crt;

const n=10;

type matrix=array[1..n,1..n] of 0..1;

var a,b:matrix;

i,j,t,tk:integer;

s:byte;

 

procedure init;

begin

t:=1;

tk:=100;

for i:=1 to n do

begin

for j:=1 to n do

a[i,j]:=0;

end;

a[5,3]:=1;

a[5,4]:=1;

a[5,5]:=1;

{ a[4,5]:=1;{glaider}

{a[3,4]:=1;{glauder}

b:=a;

end;

 

procedure print (x:matrix);

begin

clrscr;

for i:=1 to n do begin

for j:=1 to n do

if x[i,j]=1 then write('*') else write(' '); writeln;

end;

end;

function sosedi(i,j:integer):byte;

var im,ip,jm,jp:byte;

begin

im:=i-1; ip:=i+1;

jm:=j-1; jp:=j+1;

if im=0 then im:=n;

if ip=n+1 then ip:=1;

if jm=0 then jm:=n;

if jp=n+1 then jp:=1;

sosedi:=a[im,jm]+a[im,j]+a[im,jp]+a[i,jm]+a[i,jp]+a[ip,jm]+a[ip,j]+a[ip,jp];

end;

BEGIN

clrscr;

Init;

print(a);

writeln;

repeat

for i:=1 to n do

for j:=1 to n do

begin

s:=sosedi(i,j);

if (s=3) then b[i,j]:=1;

if (s<2) or (s>3) then b[i,j]:=0;

end;

print(b);

a:=b;

t:=t+1;

delay(10000); {glaider}

until t>tk; readln;

END.

(падает под углом) pod_ug.pas

program gr; {bez soprotiv}

uses crt,graph;

var v,t,k,a,rx,ry,dt,hu,hv,x,y,

sx,sy,ax,ay,vx,vy,mas:real;

 

procedure init;

var d,m:integer;

begin

d:=detect;

initgraph(d,m,'');

k:=1;{pri soprot}

v:=150;

a:=pi*45/180;{iz gradusov v radian}

x:=0;

y:=0.0001;

t:=0;

dt:=0.00001;

vx:=v*cos(a);

vy:=v*sin(a);

hu:=5;

hv:=getmaxy-3;

rx:=10;

ry:=20;

sx:=getmaxx/rx;

sy:=sx; line(round(hu),0,round(hu),round(getmaxy)); line(0,round(hv),getmaxx,round(hv));

end;

 

procedure outres(x,y:real;color:word);

var u,v:word;

begin

u:=round(x*sx+hu);

v:=round(-y*sy+hv);

putpixel(u,v,color);

end;

 

procedure euler;

begin

while y>0 do

begin

{ax:=0;{bez sopr}

{ay:=-9.8;{bez sopr}

v:=sqrt(vx*vx+vy*vy);{pri sopr}

ax:=-k*v*vx+3;{pri sopr}{-3 dobav weter,esli duet po x,to +3, esli protiv x,to -3}

ay:=-9.8-k*v*vy;{pri sopr}

vx:=vx+ax*dt;

vy:=vy+ay*dt;

x:=x+vx*dt;

y:=y+vy*dt;

t:=t+dt;

outres(x,y,red);

end;

end;

 

BEGIN

init;

outres(x,y,red);

euler;

repeat until keypressed;

closegraph;

END.

 

 

(график синуса) sin.pas

Program sinus;

uses crt, graph;

const PI=3.14;

var x,y,dx,a,b,rx,ry,Sx,Sy,Hu,Hv:real;

 

Procedure Init;

var d,m:integer;

begin

d:=detect;

InitGraph(d,m,'');

a:=-2*Pi;

b:=3*PI;

dx:=0.001;

Hu:=GetMaxX/2;

Hv:=GetmaxY/2;

rx:=b-a;

ry:=3;

Sx:=GetMaxX/rx;

Sy:=GetMaxY/ry; Line(round(Hu),0,round(Hu),round(Getmaxy)); Line(0,round(Hv),Getmaxx,round(Hv));

end;

 

Procedure Outres(x,y:real; color:word);

var u,v:word;

begin

u:=round(x*Sx+Hu);

v:=round(-y*Sy+Hv);

PutPixel(u,v,color);

end;

 

Procedure Plot;

begin

x:=a;

while x<b do

begin

y:=sin(x);

Outres(x,y,white);

x:=x+dx;

end;

Repeat until KeyPressed;

CloseGraph;

end;

 

BEGIN

Init;

Plot;

END.

(земля вокруг солнца) zem_i_so.pas

program gr; {bez soprotiv}

uses crt,graph;

var rx,ry,hu,hv,sx,sy, x,y,vx,vy,ax,ay,v,gm,t,tk,dt,r,k,wx:real;

procedure init;

var d,m:integer;

begin

d:=detect;

initgraph(d,m,'');

k:=1;{pri soprot}

gm:=4*pi*pi;

x:=1;

y:=0;

t:=0;

tk:=1;

dt:=0.000001;

vx:=0;

vy:=2*pi;

wx:=0.01*gm/x*x;{weter добав в Init}

hu:=getmaxx/2;

hv:=getmaxy/2;

rx:=3;

sx:=getmaxx/rx;

sy:=sx; line(round(hu),0,round(hu),round(getmaxy)); line(0,round(hv),getmaxx,round(hv));

end;

procedure outres(x,y:real;color:word);

var u,v:word;

begin

u:=round(x*sx+hu);

v:=round(-y*sy+hv);

putpixel(u,v,color);

end;

procedure euler;

begin

while t<tk do begin

v:=sqrt(vx*vx+vy*vy);{pri sopr}

r:=sqrt(x*x+y*y);{bez sopr}

r:=r*r*r;{bez sopr}

{ax:=-gm/r*x+wx;{bez sopr,+wx-+weter}

{ay:=-gm/r*y;{bez sopr}

ax:=-gm/r*x-k*v*vx+wx;{pri sopr}

ay:=-gm/r*y-k*v*vy;{pri sopr}

vx:=vx+ax*dt;

vy:=vy+ay*dt;

x:=x+vx*dt;

y:=y+vy*dt;

t:=t+dt;

outres(x,y,red);

end;

end;

BEGIN

init;

outres(x,y,red);

euler;

repeat until keypressed;

closegraph;

END.

(Генератор+период+вещ.числа)

Generat.pas

program generat;

uses crt;

var x,x1,a,c,i,m,n:integer;

 

procedure init;

begin

x:=3;

c:=5;

a:=2;

m:=7;

{n:=0; {period}

{m:=97; {period}

end;

 

function gen:integer;

begin

x:=(a*x+c) mod m;

gen:=x;

end;

 

{function gen1:real; {wesestwen}

{ begin

gen1:=gen/m;

end;}

 

BEGIN

clrscr;

init;

{x1:=x; {period}

{repeat {period}

{n:=n+1; {period}

{write(gen:8); {period}

{until {period}

{x=x1; {period}

{writeln; {period}

{write('period=',n); {period}

{readln; {period}

for i:=1 to 15 do

write(gen:8);

{write(gen1:8:5);{wesestwen}

readln;

END.

(нейман) program neiman;

uses crt;

var x,y,a,b,u,v,fm:real;

i:integer;

 

function f(x,s:real):real;

begin

f:=exp(-sqr(x/s)/2)/(s+sqrt(2*pi));

end;

 

procedure init;

begin

a:=-5;

b:=5;

fm:=f(0,1);

end;

 

function ney:real;

begin

repeat

x:=random;

y:=random;

u:=a+x*(b-a);

v:=y*fm;

until v<f(u,1);

ney:=u;

end;

 

BEGIN

clrscr;

randomize;

init;

for i:=1 to 100 do

write(ney:8:2);

readln;

END.

Монтекарло для x2. montekar.pas

program integral;

uses crt;

var x,y,fm,a,b,int2,pogr,integ,otnospogr:real;

i,n0,n:integer;

 

function f(x:real):real;

Begin

f:=sqr(x);

end;

 

Procedure Init;

Begin

a:=-2;

b:=2;

fm:=f(2);

n0:=100;

end;

 

function int:real;

begin

for i:=1 to n0 do

begin

x:=(b-a)*random+a;

y:=fm*random;

if f(x)>y

then n:=n+1;

end;

int:=((b-a)*fm*n)/n0;

end;

 

 

BEGIN

randomize;

clrscr;

init;

integ:=int;

int2:=1/3*(b*b*b-a*a*a);

pogr:=abs(integ-int2);

otnospogr:=pogr/int2*100;

writeln(' pogr= ',pogr:2:2);

write('int= ',integ:8:2);

readln;

writeln('int2= ',int2:2:2);

readln;

writeln('otnospogr= ',otnospogr:2:2,'%');

readln;

END.

Монтек для двойного интегр Mont_v.pas

program integral;

uses crt;

var z,c,d,x,y,fm,a,b,int2,pogr,integ,otnospogr:real;

i,n0,n:integer;

 

function f(x,y:real):real;

Begin

f:=exp(-x*x-y*y);

end;

 

Procedure Init;

Begin

a:=-2;

b:=2;

c:=-2;

d:=2;

fm:=f(0,0);

n0:=10000;

end;

 

function int:real;

begin

for i:=1 to n0 do

begin

x:=(b-a)*random+a;

y:=(d-c)*random+c;

z:=fm*random;

if f(x,y)>z

then n:=n+1;

end;

int:=((b-a)*(d-c)*fm*n)/n0;

end;

 

 

BEGIN

randomize;

clrscr;

init;

integ:=int;

int2:=3.112;{pervoobr s4itaem v matcade}

pogr:=abs(integ-int2);

otnospogr:=pogr/int2*100;

writeln(' pogr= ',pogr:2:2);

write('int= ',integ:8:2);

readln;

writeln('int2= ',int2:2:2);

readln;

writeln('otnospogr= ',otnospogr:2:2,'%');

readln;

END.

Монтек для син mont_sin.pas

program integral;

uses crt;

var x,y,fm,a,b,int2,pogr,integ,otnospogr:real;

i,n0,n:integer;

 

function f(x:real):real;

Begin

f:=sin(x);

end;

 

Procedure Init;

Begin

a:=0;

b:=pi/2;

fm:=f(2);

n0:=100;

end;

 

function int:real;

begin

for i:=1 to n0 do

begin

x:=(b-a)*random+a;

y:=fm*random;

if f(x)>y

then n:=n+1;

end;

int:=((b-a)*fm*n)/n0;

end;

 

 

BEGIN

randomize;

clrscr;

init;

integ:=int;

int2:=cos(a)-cos(b);

pogr:=abs(integ-int2);

otnospogr:=pogr/int2*100;

writeln(' pogr= ',pogr:2:2);

write('int= ',integ:8:2);

readln;

writeln('int2= ',int2:2:2);

readln;

writeln('otnospogr= ',otnospogr:2:2,'%');

readln;

END.

Динамич хаос R_6.pas

program zav;

uses crt,graph;

var r,x,y,x0,n,nkon,dn:real;

rx,ry,hu,hv,sx,sy:real;

 

procedure init;

var d,m,u,v,u1,v1:integer;

begin

d:=detect;

initgraph(d,m,'');

x:=0.01;

nkon:=100;

r:=0.4;

dn:=1;

hu:=5;

hv:=getmaxy-5;

rx:=nkon;

ry:=1.5;

sx:=getmaxx/rx;

sy:=getmaxy/ry;

line(round(hu),0,round(hu),round(getmaxy));

line(0,round(hv),getmaxx,round(hv));

u:=round(n*sx+hu);

v:=round(-x*sy+hv);

MoveTo(u,v);

Setcolor(lightred);

end;

 

procedure outres(x,y:real;color:word);

var u,v:word;

begin

u:=round(x*sx+hu);

v:=round(-y*sy+hv);

LineTo(u,v);

end;

 

procedure qq;

begin

n:=1;

while n<nkon do

begin

x:=4*r*x*(1-x);

outres(n,x,lightred);

n:=n+dn;

end;

repeat until keypressed;

closegraph;

end;

 

BEGIN

init;

outres(0,x,lightred);

qq;

END.

                     

 

Фрактал коха Fractals.pas

uses crt, graph;

var hu,hv,fi,rx,ry,sx,sy,dx,x1,x2,y1,y2:real;

 

procedure init;

var d,m: integer;

begin

d:=detect;

initgraph(d,m,'');

Hu:=5;

Hv:=getmaxy-5;

rx:=3;

ry:=3;

sx:=getmaxx/rx;

sy:=sx;

fi:=pi/3;

end;

 

{для снежинки добавляем

a:=0;

b:=1

меняем

Hu:=getmaxx/2;

Hv:=getmaxy/2}

 

Procedure Outres(x1,y1,x2,y2:real);

var u1,v1,u2,v2:word;

begin

u1:=round(x1*Sx+hu);

v1:=round(-y1*sy+hv);

u2:=round(x2*Sx+hu);

v2:=round(-y2*sy+hv);

line(u1,v1,u2,v2);

end;

 

procedure draw(x1,y1,x2,y2:real;n:word);

var x3,x4,y3,y4,x5,y5,dx,dy:real;

begin

if n>0 then

begin

dx:=(x2-x1)/3;

dy:=(y2-y1)/3;

x3:=x1+dx; y3:=y1+dy;

x5:=x2-dx; y5:=y2-dy;

x4:=dx*cos(fi)-dy*sin(fi)+x3;

y4:=dx*sin(fi)+dy*cos(fi)+y3;

draw(x1,y1,x3,y3,n-1);

draw(x3,y3,x4,y4,n-1);

draw(x4,y4,x5,y5,n-1);

draw(x5,y5,x2,y2,n-1);

end else outres(x1,y1,x2,y2);

end;

 

BEGIN

init;

outres(x1,y1,x2,y2);

 

{draw(0,0,1,0,3)}

 

{сненжинка(весто нижнего)

draw(0.5,0,-0.5,0,5);

draw(-0.5,0,0,1,5);

draw(0,1,0.5,0,5); }

draw(0.5,0,-0.5,0,3);

draw(-0.5,0,0,1,3);

draw(0,1,0.5,0,3);

repeat until keypressed;

closegraph;

END.

Фрактал Минховского полностью.fra_me3.pas

uses crt, graph;

var hu,hv,fi,rx,ry,sx,sy,dx,x1,x2,y1,y2,x3,y3:real;

 

procedure init;

var d,m: integer;

begin

d:=detect;

initgraph(d,m,'');

Hu:=getmaxx/2;

Hv:=getmaxy/2;

rx:=3; ry:=3;

sx:=getmaxx/rx;

sy:=sx;

fi:=pi/2;

end;

 

Procedure Outres(x1,y1,x2,y2:real);

var u1,v1,u2,v2,u3,v3:word;

begin

u1:=round(x1*Sx+hu);

v1:=round(-y1*sy+hv);

u2:=round(x2*Sx+hu);

v2:=round(-y2*sy+hv);

{u3:=round(x3*Sx+hu);

v3:=round(-y3*sy+hv); }

line(u1,v1,u2,v2);

{line(u2,v2,u3,v3);}

end;

 

procedure draw(x1,y1,x2,y2:real;n:word);

var x3,x4,y3,y4,x5,y5,x6,y6,x7, y7, x8, y8, x9, y9, dx,dy:real;

begin

if n>0 then

begin

dx:=(x2-x1)/4;

dy:=(y2-y1)/4;

x3:=x1+dx; y3:=y1+dy;

x9:=x2-dx; y9:=y2-dy;

x4:=dx*cos(fi)-dy*sin(fi)+x3;

y4:=dx*sin(fi)+dy*cos(fi)+y3;

x5:=x4+dx; y5:=y4+dy;

x6:=x3+dx; y6:=y3+dy;

x7:=dx*cos(3*pi/2)-dy*sin(3*pi/2)+x6; y7:=dx*sin(3*pi/2)+dy*cos(3*pi/2)+y6;

x8:=x7+dx; y8:=y7+dy;

draw(x1,y1,x3,y3,n-1);

draw(x3,y3,x4,y4,n-1);

draw(x4,y4,x5,y5,n-1);

draw(x5,y5,x6,y6,n-1);

draw(x6,y6,x7,y7,n-1);

draw(x7, y7, x8, y8, n-1);

draw(x8, y8, x9, y9, n-1);

draw(x9,y9,x2,y2,n-1);

end else outres(x1,y1,x2,y2);

end;

 

BEGIN

init; outres(x1,y1,x2,y2);

draw(0,0,1,0,5); draw(1,0,1,1,5);

draw(1,1,0,1,5); draw(0,1,0,0,5);

repeat until keypressed;

closegraph;

END.

Фрактал Минховского не полностью.fra_me2.pas

uses crt, graph;

var hu,hv,fi,rx,ry,sx,sy,dx,x1,x2,y1,y2,x3,y3:real;

 

procedure init;

var d,m: integer;

begin

d:=detect; initgraph(d,m,'');

Hu:=getmaxx/2;

Hv:=getmaxy/2;

rx:=3; ry:=3;

sx:=getmaxx/rx; sy:=sx;

fi:=pi/2;

end;

 

Procedure Outres(x1,y1,x2,y2:real);

var u1,v1,u2,v2,u3,v3:word;

begin

u1:=round(x1*Sx+hu);

v1:=round(-y1*sy+hv);

u2:=round(x2*Sx+hu);

v2:=round(-y2*sy+hv);

{u3:=round(x3*Sx+hu);

v3:=round(-y3*sy+hv); }

line(u1,v1,u2,v2);

{line(u2,v2,u3,v3);}

end;

procedure draw(x1,y1,x2,y2:real;n:word);

var x3,x4,y3,y4,x5,y5,x6,y6,x7, y7, x8, y8, x9, y9, dx,dy:real;

begin

if n>0 then

begin

dx:=(x2-x1)/4;

dy:=(y2-y1)/4;

x3:=x1+dx; y3:=y1+dy;

x9:=x2-dx; y9:=y2-dy;

x4:=dx*cos(fi)-dy*sin(fi)+x3;

y4:=dx*sin(fi)+dy*cos(fi)+y3;

x5:=x4+dx;

y5:=y4+dy;

x6:=x3+dx;

y6:=y3+dy;

x7:=dx*cos(3*pi/2)-dy*sin(3*pi/2)+x6;

y7:=dx*sin(3*pi/2)+dy*cos(3*pi/2)+y6;

x8:=x7+dx; y8:=y7+dy;

draw(x1,y1,x3,y3,n-1);

draw(x3,y3,x4,y4,n-1);

draw(x4,y4,x5,y5,n-1);

draw(x5,y5,x6,y6,n-1);

draw(x6,y6,x7,y7,n-1);

draw(x7, y7, x8, y8, n-1);

draw(x8, y8, x9, y9, n-1);

draw(x9,y9,x2,y2,n-1);

end else outres(x1,y1,x2,y2);

end;

 

BEGIN

init;

outres(x1,y1,x2,y2);

draw(0,0,1,0,7);

{draw(-0.5,0,0,1,3);

draw(0,1,0.5,0,3); }

repeat until keypressed;

closegraph;

END.

Фрактал Минховского часть увеличенная.fra_me.pas

uses crt, graph;

var hu,hv,fi,rx,ry,sx,sy,dx,x1,x2,y1,y2,x3,y3:real;

 

procedure init;

var d,m: integer;

begin

d:=detect;

initgraph(d,m,'');

Hu:=getmaxx/2;

Hv:=getmaxy/2;

rx:=3;

ry:=3;

sx:=getmaxx/rx;

sy:=sx;

fi:=pi/2;

end;

ProcedureOutres(x1,y1,x2,y2:real);

var u1,v1,u2,v2,u3,v3:word;

begin

u1:=round(x1*Sx+hu);

v1:=round(-y1*sy+hv);

u2:=round(x2*Sx+hu);

v2:=round(-y2*sy+hv);

line(u1,v1,u2,v2);

end;

 

procedure draw(x1,y1,x2,y2:real;n:word);

var x3,x4,y3,y4,x5,y5,x6,y6,dx,dy:real;

begin

if n>0 then

begin

dx:=(x2-x1)/3;

dy:=(y2-y1)/3;

x3:=x1+dx; y3:=y1+dy;

x6:=x2-dx; y6:=y2-dy;

x4:=dx*cos(fi)-dy*sin(fi)+x3;

y4:=dx*sin(fi)+dy*cos(fi)+y3;

x5:=x4+dx;

y5:=y4+dy;

draw(x1,y1,x3,y3,n-1);

draw(x3,y3,x4,y4,n-1);

draw(x4,y4,x5,y5,n-1);

draw(x5,y5,x6,y6,n-1);

draw(x6,y6,x2,y2,n-1);

end else outres(x1,y1,x2,y2);

end;

 

BEGIN

init;

outres(x1,y1,x2,y2);

draw(0.5,0,-0.5,0,3);

repeat until keypressed;

closegraph;

END.

program Avtomat;

uses crt;

const n=10;

type matr=array[1..n,1..n] of 0..1;

var A,B:matr;

i,j,t,tk:integer;

s:byte;

procedure Init;

begin

for i:=1 to n do

begin

for j:=1 to n do

A[i,j]:=0;

end;

A[5,3]:=1;

A[5,4]:=1;

A[5,5]:=1;

B:=A;

t:=1;

tk:=5;

end;

Procedure Print(x:matr);

begin

for i:=1 to n do begin

for j:=1 to n do

write(x[i,j],' ');

writeln;

end;

end;

Function Sosedi(i,j:integer):byte;

var im,ip,jm,jp:integer;

begin

im:=i-1;

ip:=i+1;

jm:=i-1;

jp:=j+1;

if im=0 then im:=n;

if ip=n+1 then ip:=1;

if jm=0 then jm:=n;

if jp=n+1 then jp:=1;

Sosedi:=a[im,jm]+a[im,j]+a[im,jp]

+a[i,jm]+a[i,j]+a[i,jp]+a[ip,jm]+

a[ip,j]+a[ip,jp];

end;

 

BEGIN

clrscr;

init;

print(a);

writeln;

repeat

for i:=1 to n do

for j:=1 to n do begin

s:=Sosedi(i,j);

if (s>3) or (s<2) then B[i,j]:=0;

if s=3 then B[i,j]:=1;

end;

Print(B);

A:=B;

readln;

t:=t+1;

until t>tk

END.

 

Фибоначчи

program Fibonschi;

uses crt;

var a:array [1..17] of real;

x:real;

i,j,k:integer;

 

procedure Init;

begin

for i:=1 to 17 do

a[i]:=random;

i:=17;

j:=5;

end;

Function Fib:real;

begin

x:=a[i]-a[j];

if x<0 then x:=x+1;

a[i]:=x;

dec(i);

dec(j);

if i=0 then i:=17;

if j=0 then j:=17;

fib:=x;

end;

 

BEGIN

clrscr;

randomize;

Init;

for k:=1 to 50 do

write(fib:8:4);

readln;

END.

Период program Period;

uses crt,graph;

var a:array [1..1000] of real;

i:integer;

procedure init;

var d,m:integer;

begin

d:=detect;

initgraph(d,m,'');

n:=0;

nmax:=100;

r:=0.86;{mogno menat'}

x:=0.5;

{меняем зн-е x:=0.5;

r:=0.001;

rx:=1.1;

ry:=1.1;

dn:=0.001;}

 

hu:=5;

hv:=getmaxy-5;

rx:=nmax;

ry:=1.1;

sx:=getmaxx/rx;

sy:=GetMaxy/ry;

end;

 

procedure outres(x,y:real;color:word);

var u,v:word;

begin

u:=round(x*sx+hu);

v:=round(-y*sy+hv);

putpixel(u,v,color);

end;

 

BEGIN

init;

while n<nmax do

begin

x:=4*r*x*(1-x);

outres(n,x,white);

n:=n+1;

end;

repeat until keypressed;

closegraph;

end.

 

Удвоение периода

program Udvoenie;

uses crt,graph;

var a:array [1..1000] of real;

i:integer;

procedure init;

var d,m:integer;

begin

d:=detect; initgraph(d,m,'');

dp:=0.001;

n:=0;

r:=0.01;

x:=0.2;

hu:=5;

hv:=getmaxy-5;

rx:=1.1;

ry:=1.1;

sx:=getmaxx/rx;

sy:=GetMaxy/ry;

end;

procedure outres(x,y:real;color:word);

var u,v:word;

begin

u:=round(x*sx+hu);

v:=round(-y*sy+hv);

putpixel(u,v,color);

end;

procedure graf;

begin

while r<1 do

begin x:=0.5;

for i:=1 to 500 do

x:=4*r*x*(1-x);

for i:=1 to 1000 do

begin

x:=4*r*x*(1-x);

outres(r,x,white);

end;

r:=r+dr;

end;

end;

 

BEGIN

init;

graf;

repeat until keypressed;

closegraph;

end.

 
                 

 

Дата добавления: 2015-11-04; просмотров: 24 | Нарушение авторских прав


<== предыдущая лекция | следующая лекция ==>
 | Форма предварительной регистрации рейтингового турнира
mybiblioteka.su - 2015-2024 год. (0.209 сек.)