![]() |
Eugeniusz Jakubas |
Stąd można pobrać teksty źródłowe poniższych 57 programów w Pascalu pr-pascal.zip - 34 kB
1. Ciągi
Program Wykresy_ciagow; uses Graph; var karta,tryb,n,j:integer; y:real; function a(n:integer):real; begin a:=10/n; end; begin karta:=detect; initGraph(karta,tryb,''); j:=16; setColor(darkGray); for n:=10 to 640 div j do line(n*j+20,0,n*j+20,479); for n:=-240 div j to 240 div j do line(160,240+n*j,639,240+n*j); setcolor(white); line(160,240,639,240); line(630,235,639,240); line(630,245,639,240); outtextxy(630,250,'n'); line(180,0,180,479); line(175,9,180,0); line(180,0,185,9); outtextxy(190,8,'an'); n:=0; setColor(lightBlue); setFillStyle(1,lightBlue); repeat n:=n+1; y:=a(n); writeLn(y:1:11); if abs(y)<480 then fillEllipse(round(n*j+180),round(240-y*j),2,2); until n>28; readln; closeGraph; end. |
![]() |
2. Cykloida
Program Cykloida; uses graph,crt; var karta,tryb,n,i:integer; begin karta:=detect; initGraph(karta,tryb,''); line(0,301,639,301); for i:=0 to 160 do begin setColor(white); fillEllipse(round(60*cos(1.9+i/19)+60+4*i),round(60*sin(1.9+i/19)+240),2,2); line(60+4*i,240,round(60*cos(1.9+i/19)+60+4*i),round(60*sin(1.9+i/19)+240)); for n:=0 to 5 do begin setColor(n+1); arc(60+4*i,240,n*60-3*i,(n+1)*60-3*i,60); end; delay(100); setColor(black); circle(60+4*i,240,60); line(60+4*i,240,round(60*cos(1.9+i/19)+60+4*i),round(60*sin(1.9+i/19)+240)); end; readln; closeGraph; end. |
![]() |
3. Deska Galtona
program Deska_Galtona; uses graph,crt; var karta,tryb,n,k,i,wi,ko,ilO : integer; t:array[0..40] of integer; begin karta:=vga; tryb:=vgaHi; initGraph(karta,tryb,''); randomize; bar(0,475,639,479); for n:=0 to 40 do for k:=1 to n+2 do fillEllipse(k*14+287-n*7,n*5+10,1,1); for i:=1 to 400 do begin ko:=308; wi:=10; fillEllipse(ko,wi,2,2); for n:=1 to 40 do begin setColor(black); setFillStyle(1,black); fillEllipse(ko,wi,2,2); if random<0.5 then ko:=ko-7 else ko:=ko+7; wi:=wi+5; setColor(lightRed); setFillStyle(1,lightRed); fillEllipse(ko,wi,2,2); delay(50); end; setColor(black); setFillStyle(1,black); fillEllipse(ko,wi,2,2); ilO:=(ko-28) div 14; t[ilO]:=t[ilO]+1; setColor(lightRed); setFillStyle(1,lightRed); fillEllipse(ko,477-t[ilO]*4,2,2); end; readLn; closeGraph; end. |
![]() |
4. Dywan Ulama
program Dywan_Ulama; uses graph; var karta,tryb,pozX,pozY,D:integer; liczba,i:longInt; procedure sprawdzenie; var k,spr:longInt; begin k:=1; spr:=1; repeat k:=k+1; if liczba mod k=0 then spr:=0; until (liczba mod k=0) or (k>sqrt(liczba)); if spr=1 then putPixel(pozX,pozY,white); end; begin karta:=detect; initGraph(karta,tryb,''); liczba:=1; pozX:=320; pozY:=240; D:=0; repeat D:=D+2; for i:=1 to D do begin liczba:=liczba+1; pozY:=pozY-1; sprawdzenie; end; for i:=1 to D do begin liczba:=liczba+1; pozX:=pozX-1; sprawdzenie; end; for i:=1 to D do begin liczba:=liczba+1; pozY:=pozY+1; sprawdzenie; end; for i:=1 to D do begin liczba:=liczba+1; pozX:=pozX+1; sprawdzenie; end; pozX:=pozX+1; pozY:=pozY+1; until liczba>576000; readLn; closeGraph; end. |
![]() |
5. Dywan Sierpińskiego
6. Ekstrema funkcji
Program Ekstrema_funkcji_Metoda_naturalna; {$N+} uses graph; var karta,tryb,n:integer; x,y,Dx,y1,y2:extended; function f(x:extended):extended; begin f:=x+3/4-2*sin(x)-0.065 end; begin karta:=detect; initGraph(karta,tryb,''); setColor(darkGray); for n:=1 to 32 do line(n*20,0,n*20,479); for n:=1 to 24 do line(0,n*20,639,n*20); setColor(white); line(0,240,639,240); line(320,0,320,479); x:=-16; Dx:=0.1; repeat x:=x+Dx; y:=f(x); y1:=f(x+Dx); y2:=f(x+2*Dx); if (y1<y) and (y1<y2) then Dx:=Dx/10; if (y1>y) and (y1>y2) then Dx:=Dx/10; if (Dx<1e-17) or ((y=y1)and(Dx<0.1)) then begin if abs(y)<12 then writeln('x=',x:22:18,', f(x)=',y:22:18); Dx:=0.1; end; if abs(y)<12 then putPixel(round(x*20+320),round(-y*20+240),yellow); until x>16; readLn; closeGraph; end. |
![]() |
7. Figury Sierpińskiego
program Figury_Sierpinskiego; uses Graph,crt; var karta,tryb,los,n_kat:integer; x,y,r,skok:real; begin karta:=detect; initGraph(karta,tryb,''); n_kat:=3; skok:=0.5; r:=120/skok; x:=0; y:=0; repeat putPixel(round(x+320),round(y+240),los); los := random(n_kat) + 1; x:=x+(r*cos(los*2*pi/n_kat)-x)*skok; y:=y+(r*sin(los*2*pi/n_kat)-y)*skok; until keyPressed; closeGraph; end. |
![]() |
8. Funkcja pierwotna
Program Funkcja_pierwotna; uses graph; var karta,tryb,n,j,k:integer; x,Dx,pierwotna:real; function f(x:real):real; begin f:=cos(x); end; begin karta:=detect; initgraph(karta,tryb,''); j:=40; setColor(darkGray); for n:=-320 div j to 320 div j do line(320+n*j,0,320+n*j,479); for n:=-240 div j to 240 div j do line(0,240+n*j,639,240+n*j); setColor(white); line(0,240,639,240); line(320,0,320,479); x:=-320/j; pierwotna:=0; Dx:=0.001; repeat x:=x+Dx; putPixel(round(x*j+320),round(-f(x)*j+240),lightBlue); pierwotna:=pierwotna+f(x)*Dx; for k:=-5 to 5 do putPixel(round(x*j+320),round(-pierwotna*j+240+k*j),lightRed); until x>320/j; readln; closegraph; end. |
![]() |
9. Krzywe - epicykloidy
10. Krzywe - obwarzanek
Program Obwarzanek; uses graph,crt; var karta,tryb,n:integer; x,y,r,alfa,beta:real; const tk:array[1..4] of integer= (lightCyan,lightRed,yellow,lightBlue); begin karta:=detect; initGraph(karta,tryb,''); alfa:=0; repeat r:=160; beta:=alfa; x:=r*cos(alfa)+320; y:=r*sin(alfa)+240; setColor(red); fillEllipse(round(x),round(y),1,1); r:=r/6; beta:=beta*12; for n:=1 to 4 do begin x:=x+r*cos(beta+n*pi/2); y:=y+r*sin(beta+n*pi/2); setFillStyle(1,tk[n]); setColor(tk[n]); fillEllipse(round(x),round(y),7,7); end; alfa:=alfa+0.005; until (keyPressed) or (alfa>=2*pi); readLn; closegraph; end. |
![]() |
11. Kwadrat sito
Program Sito; uses Graph; var karta,tryb,n,x,y,bok,gr:integer; begin karta:=detect; initGraph(karta,tryb,''); n:=1; gr:=1; bok:=256; rectangle(0,0,bok,bok); repeat gr:=gr div 2; bok:=bok div 2; for x:=0 to n-1 do for y:=0 to n-1 do bar(bok+2*x*bok-gr,bok+2*y*bok-gr, bok+2*x*bok+gr,bok+2*y*bok+gr); n:=n*2; readLn; until bok=1; CloseGraph; end. |
![]() |
12. Liczba e
Program e; uses crt; var n,k:integer; a:real; begin clrScr; for n:=1 to 100 do begin a:=1+1/n; for k:=1 to n-1 do a:=a*(1+1/n); writeLn(n,'. ',a:1:10); end; readLn; end. |
![]() |
13. Liczba p
program Liczba_pi_Algorytm_Gaussa_Legendrea; {$N+} uses crt; var a, b, t, x, y:extended; begin clrScr; a:=1; b:=1/sqrt(2); t:=1/4; x:=1; writeLn(a:22:18,b:22:18,t:22:18); writeLn('pi=',(a+b)*(a+b)/(4*t):22:18); repeat y:=a; a:=(a+b)/2; b:=sqrt(b*y); t:=t-x*(y-a)*(y-a); x:=2*x; writeLn(a:22:18,b:22:18,t:22:18); writeLn('pi=',(a+b)*(a+b)/(4*t):22:18); until a-b<0.0000000000000000001; writeln('pi=',pi:22:18); readLn; end. |
![]() |
14. Liczby pierwsze
program Liczba_pierwsza; uses crt; var liczba,n:longint; begin clrScr; liczba:=2147483647; for n:=2 to round(sqrt(liczba)) do if liczba mod n=0 then begin writeLn(liczba,'-liczba zlozona'); readLn; exit; end; textColor(lightRed); writeLn(liczba,'-liczba pierwsza'); readLn; end. |
![]() |
15. Miejsca zerowe funkcji
program Miejsca_zerowe_Metoda_stycznych; {$N+} uses crt; var x : extended; function f (x: extended): extended; begin f :=sin(x); end; begin clrScr; x := 2; repeat x:=x-f(x)/(f(x+0.000001)-f(x))*0.000001; writeln('x = ',x:22:18,' f(x) = ',f(x):22:18); until (abs(f(x)) < 1e-17); readLn; end. |
![]() |
16. Monotoniczność funkcji
Program Ekstrema_funkcji_Metoda_naturalna; {$N+} uses graph; var karta,tryb,n,j,kolor:integer; x,y,Dx,y1,y2:extended; function f(x:extended):extended; begin f:=x*x/(2*x*x-x-2) end; begin karta:=detect; initGraph(karta,tryb,''); j:=20; setColor(darkGray); for n:=-320 div j to 320 div j do line(n*j+320,0,n*j+320,479); for n:=-240 div j to 240 div j do line(0,n*j+240,639,n*j+240); setColor(white); line(0,240,639,240); line(320,0,320,479); x:=-320/j; Dx:=0.00025; repeat x:=x+Dx; y:=f(x); y1:=f(x+Dx); y2:=f(x+2*Dx); if y1>y then kolor:=yellow else kolor:=lightRed; if abs(y)<240/j then putPixel(round((x+Dx)*j+320),round(-y1*j+240),kolor); if (y1<y) and (y1<y2) and (abs(y1)<240/j) then writeln('x=',x+Dx:18:14); if (y1>y) and (y1>y2) and (abs(y1)<240/j) then writeln('x=',x+Dx:18:14); if y*y1<0 then writeLn('x=',x+2*Dx:18:14); until x>320/j; readLn; closeGraph; end. |
![]() |
17. Nwd - algorytm Euklidesa
Program Najwiekszy_wspolny_dzielnik; uses crt; var a,b,nwd,r:integer; begin clrScr; a:=1995; b:=1957; repeat writeLn(a,' = ',a div b,'*',b,' + ',a mod b); r:=a mod b; a:=b; b:=r; until r=0; writeLn('Nwd = ',a); readLn; end. |
![]() |
18. Nww
program NWW; uses crt; var a,b,dz:longInt; begin clrScr; a:=30; b:=105; dz:=1; while dz*a mod b<>0 do dz:=dz+1; writeLn('NWW(',a,',',b,') = ',dz*a); readLn; end. |
![]() |
19. Permutacje
program Permutacje; uses crt; var n,k,dl_slowa,il_permut,spr,poz,i,max:longInt; slowo_wyj,slowo_0,slowo,slowo_st:string; x:char; t:array[1..255] of integer; key:char; const slowo_max:string='abcdefghijklmnoprstuvwxyz'; procedure sprawdz_i_wstaw(x:char;nr:integer); begin for k:=poz to dl_slowa do if (slowo_st[k]=x) and (t[ord(x)]=0) then begin slowo[nr]:=x; spr:=1; t[ord(x)]:=1; end; end; begin clrScr; slowo_0:='AABEGLR'; dl_slowa:=length(slowo_0); slowo:=copy(slowo_max,1,dl_slowa); slowo_st:=slowo; il_permut:=1; writeLn(il_permut,'. ',slowo_0); max:=1; for n:=1 to dl_slowa do max:=max*n; repeat for n:=1 to 255 do t[n]:=0; n:=1; while slowo[dl_slowa-n]>slowo[dl_slowa-n+1] do n:=n+1; poz:=dl_slowa-n; i:=0; spr:=0; repeat x:=char(ord(slowo[poz])+1+i); sprawdz_i_wstaw(x,poz); i:=i+1; until spr=1; x:='!'; for n:=1 to dl_slowa-poz do begin i:=0; spr:=0; repeat x:=char(ord(x)+1); sprawdz_i_wstaw(x,poz+n); i:=i+1; until spr=1; end; il_permut:=il_permut+1; slowo_wyj:=''; for i:=1 to dl_slowa do slowo_wyj:=slowo_wyj+slowo_0[ord(slowo[i])-96]; writeLn(il_permut,'. ',slowo_wyj); slowo_st:=slowo; { key:=readKey;} until (slowo_wyj='ALGEBRA') or (il_permut=max); readLn; end. |
![]() |
20. Pochodna funkcji
21. Pola figur płaskich.
Program Pole_figury_plaskiej; uses Graph; var karta,tryb,x,y,k,n,bialy,czarny,siatka:integer; psw,psz:longint; const czworokat:array[1..5,1..2] of integer= ((50,120),(400,100),(500,285),(210,420),(50,120)); j:integer = 64; begin karta:=vga; tryb:=vgaHi; initGraph(karta,tryb,''); fillPoly(4,czworokat); setColor(cyan); siatka:=16; psw:=0; psz:=0; for n:=0 to 440 div siatka do for k:=0 to 560 div siatka do begin bialy:=0; czarny:=0; for x:=k*siatka to (k+1)*siatka-1 do for y:=n*siatka to (n+1)*siatka-1 do if getPixel(x,y)=white then bialy:=1 else czarny:=1; rectangle(k*siatka-1,n*siatka-1,(k+1)*siatka-1,(n+1)*siatka-1); if (bialy=1) and (czarny=0) then begin inc(psw); setFillStyle(1,lightRed); bar(k*siatka,n*siatka,(k+1)*siatka-1,(n+1)*siatka-1); end; if (bialy=1) and (czarny=1) then begin inc(psz); setFillStyle(1,lightBlue); bar(k*siatka,n*siatka,(k+1)*siatka-1,(n+1)*siatka-1); end; end; setColor(black); drawPoly(5,czworokat); writeLn('P.s.z.=',(psz+psw)/j/j*siatka*siatka:6:4, ' P.s.w.=',psw/j/j*siatka*siatka:6:4); readLn; closeGraph; end. |
![]() |
22. Pole pod funkcją
Program Pole_pod_funkcja; uses Graph; var karta,tryb,n,k,iprz,j:integer; x,y,x1,x2,Dx,pole:real; function f(x:real):real; begin f:=(x*x*x-5*x)/5 end; begin karta:=detect; initGraph(karta,tryb,''); j:=20; setColor(darkGray); for n:=-320 div j to 320 div j do line(320+n*j,0,320+n*j,479); for n:=-240 div j to 240 div j do line(0,240+n*j,639,240+n*j); setColor(white); line(0,240,639,240); line(320,0,320,479); setColor(lightBlue); x1:=-3; x2:=4; x:=-320/j; Dx:=0.00025; repeat x:=x+Dx; y:=f(x); if abs(y)<240/j then putPixel(round(x*j+320),round(-y*j+240),lightBlue); if (x>x1) and (x<x2) then line(round(x*j+320),round(-y*j+240), round(x*j+320),240); until x>320/j; setColor(lightRed); iprz:=20; pole:=0; Dx:=(x2-x1)/iprz; for n:=1 to iprz do begin x:=x1+n*Dx-Dx/2; pole:=pole+f(x)*Dx; rectangle(round(j*(x1+(n-1)*Dx)+320),round(-j*f(x)+240), round(j*(x1+n*Dx)+320),240); end; setColor(white); line(0,240,639,240); line(320,0,320,479); writeLn(' Pole = ',pole:1:4); readln; closeGraph; end. |
![]() |
23. Potęga =1999
Program Potega_1999; uses crt; var n,i,poz,iloczyn,pamiec,podstawa,wypis:longInt; t:array[1..64000] of byte; begin clrScr; t[1]:=1; podstawa:=2; poz:=1; for i:=1 to 64000 do begin pamiec:=0; for n:=1 to poz do begin iloczyn:=t[n]*podstawa; t[n]:=(iloczyn+pamiec) mod 10; pamiec:=(iloczyn+pamiec) div 10; end; t[n+1]:=pamiec; if pamiec>=1 then poz:=poz+1; write(podstawa,'^',i,' = '); wypis:=1; if poz>10 then wypis:=poz-10; for n:=poz downTo wypis do write(t[n]); if poz>11 then writeLn('...') else writeLn; if poz>3 then if (t[poz]=1)and(t[poz-1]=9)and(t[poz-2]=9)and(t[poz-3]=9) then readLn; end; readLn; end. |
![]() |
24. Przekształcenia izometryczne
Program Translacja; uses Graph; var karta,tryb:integer; x,y,xnowe,ynowe:longint; begin karta:=vga; tryb:=vgaHi; initGraph(karta,tryb,'c:\tp\bgi'); setTextStyle(triplexFont,horizDir,5); outTextXY(30,430,'Matematyka'); rectangle(20,435,300,479); fillEllipse(130,420,50,50); for x:=0 to 300 do for y:=0 to 110 do if getpixel(x,479-y)=white then begin xnowe:=x+250; ynowe:=y+200; putPixel(xnowe,479-ynowe,lightRed); end; readLn; closeGraph; end. |
![]() |
25. Przekształcenia afiniczne.
program Trzy_przeksztalcenia_afiniczne; uses graph,crt; var karta,tryb,prz,skala:integer; x,y,xNowe,yNowe:real; const t:array[1..18] of real= (0.5,-0.8,0.5,0.0,0.5,-0.1, 0.5,0.0,0.0,0.0,0.5,0.4,0.5,0.6,-0.4,0.0,0.6,-0.4); begin karta:=detect; initGraph(karta,tryb,'c:\tp\bgi'); randomize; x := 0; y := 0; skala:=180; repeat prz := random(3); xNowe:=t[prz*6+1]*x+t[prz*6+2]*y+t[prz*6+3]; ynowe:=t[prz*6+4]*x+t[prz*6+5]*y+t[prz*6+6]; x := xNowe; y := yNowe; putPixel(round(x*skala+320),round(-y*skala+240),prz+2); until keyPressed; readLn; closeGraph; end. |
![]() |
26. Reszta ab mod c.
program Reszta; {$N+} uses crt; var a:extended; function potegaModulo(a,b,c:extended):extended; var reszta:extended; begin reszta:=1; while b>0 do begin if int(b/2)<>b/2 then reszta:=reszta*a-int(reszta/c*a)*c; a:=a*a-int(a/c*a)*c; b:=int(b/2); end; potegaModulo:=reszta; end; begin clrScr; a:=4905289; writeLn(a:1:0,' -> ',potegaModulo(a,4321,948581743):1:0); readLn; end. |
![]() |
27. Rozkład na czynniki pierwsze
Program Rozklad_na_czynniki_pierwsze; uses crt; var liczba,n:longInt; begin clrscr; liczba:=1995; n:=2; repeat if liczba mod n=0 then begin writeLn(liczba:15,' ł ',n); liczba:=liczba div n; end else n:=n+1; until n>sqrt(liczba); if liczba<>1 then writeLn(liczba:15,' ł ',liczba); write(1:15,' ł'); readln; end. |
![]() |
28. Rzut kostką
Program Rzut_kostka; uses graph; var karta,tryb,n,los,il_rz:integer; ilosc,czestosc:string; t:array[1..6] of integer; begin karta:=detect; initGraph(karta,tryb,''); for n:=1 to 6 do t[n]:=0; il_rz:=1500; randomize; for n:=1 to il_rz do begin los:=random(6)+1; inc(t[los]); line(los*85,455-t[los],los*85+37,455-t[los]); line(los*85+40,455-t[los],los*85+55,455-15-t[los]); end; for n:=1 to 6 do begin str(t[n],ilosc); outTextxy(n*85+20,441-t[n],ilosc); str(t[n]/il_rz:1:4,czestosc); outTextxy(n*85+10,411-t[n],czestosc); end; readln; closeGraph; end. |
![]() |
29. Rzut monetą
Program Rzut_moneta; uses graph; var karta,tryb:integer; n,il_rz,il_o,il_r:longInt; x,y,los:real; begin karta:=detect; initGraph(karta,tryb,''); randomize; il_rz:=30000; il_o:=0; il_r:=0; for n:=1 to il_rz do begin los:=random; if los<=0.5 then begin il_o:=il_o+1; x:=il_o/100*cos(il_o*pi/180); y:=il_o/100*sin(il_o*pi/180); fillEllipse(round(x+200),round(y+200),1,1); end else begin il_r:=il_r+1; x:=il_r/100*cos(il_r*pi/180); y:=il_r/100*sin(il_r*pi/180); fillEllipse(round(x+400),round(y+200),1,1); end; end; writeln(' Ilosc orlow = ',il_o:1,' Ilosc reszek = ',il_r:1); writeLn('Czestosc orla = ',il_o/il_rz:1:4,' Czestosc reszki = ',il_r/il_rz:1:4); readln; closeGraph; end. |
![]() |
30. Schemat Bernoulliego
Program Schemat_Bernouliego_symulacje; uses graph,crt; const n=40; il_ucz=5000; g=1; var karta,tryb:integer; k,i,sukces:longInt; Dcz:real; czS,nS:string; tab:array[1..n] of longInt; begin karta:=detect; initGraph(karta,tryb,''); bar(0,0,639,479); randomize; for k:=1 to n do tab[k]:=0; setColor(darkGray); for k:=0 to 12 do begin str(0.01*k:1:2,czS); outTextXY(280-g*n div 2,448-k*25,czS); line(280-g*n div 2,460-k*25,340+g*n div 2,460-k*25); end; setColor(white); setColor(black); line(315-g*n div 2,479,315-g*n div 2,140); line(280-g*n div 2,460,340+g*n div 2,460); outTextXY(317-g*n div 2,465,'0'); str(n div 2,nS); outTextXY(312,465,nS); str(n,nS); outTextXY(315+g*n div 2,465,nS); for k:=1 to il_ucz do begin sukces:=0; for i:=1 to n do if random<0.5 then sukces:=sukces+1; tab[sukces]:=tab[sukces]+1; Dcz:=2500/il_ucz; line(g*sukces-g*n div 2+320,458-round(Dcz*tab[sukces]-Dcz), g*sukces-g*n div 2+320,458-round(Dcz*tab[sukces])); if keyPressed then exit; end; str(tab[n div 2]/il_ucz:1:4,czS); outTextXY(300,440-round(Dcz*tab[n div 2]),czS); readLn; closeGraph; end. |
![]() |
31. Schemat Hornera
program Schemat_Hornera; uses crt; var n,x0,wartosc,w,blad:integer; dane:string; const tab:array[1..10] of integer= (1,-2,3,4,-5,6,7,-8,-9,10); begin clrScr; x0:=1; wartosc:=0; for n:=1 to 10 do wartosc:=x0*wartosc+tab[n]; writeln(wartosc); readLn; end. |
7 |
32. Sieczna
Program Sieczna; uses Graph; var karta,tryb,n,siatka,j,xA,yA,xB,yB:integer; x,y,x1,x2,u:real; function f(x:real):real; begin f:=1/4*x*x+x-6; end; begin karta:=detect; initGraph(karta,tryb,''); j:=20; siatka:=20; setColor(darkGray); rectangle(0,0,639,479); for n:=-320 div siatka to 320 div siatka do begin line(320+n*siatka,0,320+n*siatka,479); line(0,240+n*siatka,639,240+n*siatka); end; setcolor(white); line(0,240,639,240); line(630,235,639,240); line(630,245,639,240); outtextxy(630,250,'X'); line(320,0,320,479); line(315,9,320,0); line(320,0,325,9); outtextxy(330,8,'Y'); for n:=-320 div j to 320 div j do begin line(320+n*j,238,320+n*j,242); line(318,240+n*j,322,240+n*j); end; x:=-320/j; repeat x:=x+1/j; putPixel(round(x*j+320),round(240-f(x)*j),yellow); until x>320/j; x2:=6; x1:=-1; u:=(f(x2)-f(x1))/(x2-x1); write('u = ',u:5:4); setColor(lightRed); xA:=round(x1*j+320); yA:=round(240-f(x1)*j); fillEllipse(xA,yA,3,3); xB:=round(x2*j+320); yB:=round(240-f(x2)*j); fillEllipse(xB,yB,3,3); line(0,round(u*xA+yA),639,round(u*(xA-639)+yA)); line(xB,yB,xB,yA); line(xB,yA,xA,yA); readln; closegraph; end. |
![]() |
33. Sito Eratostenesa
program Sito_Eratostenesa; uses crt; const max=500; var liczba,n:longInt; t:array[1..max] of byte; begin clrScr; for n:=1 to max do t[n]:=0; for liczba:=2 to round(sqrt(max)) do if t[liczba]=0 then for n:=2 to max div liczba do t[liczba*n]:=1; for n:=2 to max do if t[n]=0 then write(n:5); readLn; end. |
![]() |
34. Sortowanie
program sortowanie_liczb; uses crt; var tab:array[1..25] of integer; n,k,x:integer; begin clrscr; randomize; for n:=1 to 25 do begin tab[n]:=round(random(100));write(tab[n],' ');end; for n:=1 to 25 do for k:=n+1 to 25 do begin if tab[n]>tab[k] then begin x:=tab[n]; tab[n]:=tab[k]; tab[k]:=x; end; end; writeln; for n:=1 to 25 do write(tab[n],' '); readln; end. |
![]() |
35. Styczna
Program Styczna; uses graph; var karta,tryb,n:integer; skala,xp,yp,ip,ips:longInt; x,y,x0,y0,krok,h:real; xS,yS:string; function f(x:real):real; begin f:=x*x-4*x-2; end; procedure osie; begin setColor(darkGray);setLineStyle(1,0,1); for n:=0 to 30 do line(xp mod ip+n*ip,0,xp mod ip+n*ip,380); for n:=0 to 22 do line(0,yp mod ip+n*ip,510,yp mod ip+n*ip); setLineStyle(0,0,1); for n:=0 to 2*(15 div skala) do line(xp mod ips+n*ips,0,xp mod ips+n*ips,380); for n:=0 to 2*(11 div skala) do line(0,yp mod ips+n*ips,510,yp mod ips+n*ips); rectangle(0,0,510,380);setColor(lightGray);setLineStyle(0,0,3); line(0,yp,510,yp);line(500,yp-5,508,yp);line(500,yp+5,508,yp); line(xp,0,xp,380); line(xp-5,10,xp,2); line(xp+5,10,xp,2); str(-16/skala+x0:2:4,xS); outTextXY(3,198,xS); str(16/skala+x0:2:4,xS);outTextXY(510-8*length(xS),198,xS); str(-12/skala+y0:2:4,yS); outTextXY(260,370,yS); str(12/skala+y0:2:4,yS); outTextXY(264,5,yS); end; procedure wykres; begin x:=-16/skala+x0; krok:=0.005/skala; repeat x:=x+krok; y:=-f(x)*ips+yp; if (y>0) and (y<380) then putPixel(round(x*ips+xp),round(y),lightcyan); if x<x0 then h:=-0.0001/skala else h:=0.0001/skala; putPixel(round(x*ips+xp), round(-((f(x0+h)-f(x0))/h*(x-x0)+f(x0))*ips+yp),lightRed); until x>16/skala+x0; setColor(yellow);circle(255,190,2); str(x0:2:4,xS);str(y0:2:4,yS); outTextXY(260,200,'A ('+xS+', '+yS+')'); end; begin karta:=vga; tryb:=vgaHi; initgraph(karta,tryb,'c:\tp\bgi'); skala:=1; ip:=16; ips:=ip*skala; x0:=3; xp:=round(255-x0*ips); y0:=f(x0); yp:=round(190+y0*ips); osie; wykres; readln; closegraph; end. |
![]() |
36. Suma sześcianów cyfr
program Suma_szescianow_cyfr; uses crt; var liczba,cyfra,suma,i:longInt; key:char; begin clrScr; liczba:=123; write(liczba,' -> '); repeat suma:=0; repeat cyfra:=liczba mod 10; suma:=suma+cyfra*cyfra*cyfra; liczba:=liczba div 10; until liczba=0; write(suma,' -> '); liczba:=suma; key:=readKey; until (key=#27); end. |
![]() |
37. Symbol Newtona n_po_k
program Obliczanie_n_po_k; {$N+} uses crt; function silnia (s:integer):extended; var i:integer; x:extended; begin x:=1; for i:=1 to s do x:=x*i; silnia:=x; end; function n_po_k(n,k:integer):extended; begin n_po_k:=silnia(n)/silnia(k)/silnia(n-k); end; begin clrScr; writeLn(n_po_k(10,5):1:0); readLn; end. |
![]() |
38. Szeregi
program Szeregi; {$N+} uses crt; var n:longint; suma:extended; function a(n:real):real; begin a:=1/n; end; begin clrscr; suma:=0; for n:=1 to 20 do begin suma:=suma+a(n); writeln('a(',n,') = ',a(n):17:17,' S(',n,') = ',suma:17:17); end; readln; end. |
![]() |
39. Szyfrowanie RSA
program Szyfrowanie; uses crt; var blok, e, k: longInt; function reszta (a, b, c: longInt): longInt; var n, p: longInt; begin p := 1; for n := 1 to b do p := p * a; reszta := p mod c end; {**********************************} begin clrScr; blok := 352; e := 3; k := 901; writeLn('Szyfrowanie: ', blok : 10, ' -> ', reszta(blok, e, k) : 10); readLn; end. |
![]() |
40. Trójkąt Pascala
program trojkat_Pascala; uses graph; var karta,tryb,n,k:integer; x,y:longInt; ilS:string; t:array[1..33] of longInt; begin karta:=detect; initGraph(karta, tryb, ''); setTextStyle(smallFont,0,1); for n:=1 to 33 do t[n]:=0; y:=1; for n:=1 to 33 do for k:=1 to n-1 do begin x:=y; y:=t[k]; t[k]:=x+y; setColor(t[k] mod 2+3); str(t[k],ilS); setUserCharSize(1,length(ilS) div 2,5,4); outTextXY(320-10*n+k*20,12*n,ilS); end; readLn; closeGraph; end. |
![]() |
41. Trójkąt Sierpińskiego
program trojkat_Sierpinskiego_max; uses graph; var karta, tryb, n, k, i, bok: integer; tr:array[1..3,1..2] of integer; procedure trojkat (x, y, bok, znak: integer); begin tr[1,1]:=x; tr[1,2]:=y; tr[2,1]:=x-bok div 2; tr[2,2]:=y-znak*bok div 2; tr[3,1]:=x+bok div 2; tr[3,2]:=y-znak*bok div 2; fillPoly(3,tr); end; begin karta:=detect; initGraph(karta,tryb,''); bok:=256; trojkat(bok,0,bok*2,-1); setFillStyle(1,black); i:=0; repeat readLn; for n:=0 to i do for k:=0 to i do if n and k = 0 then trojkat((n-k)*(bok div (i+1))+bok, (n+k-i)*(bok div (i+1))+bok,bok div (i+1),1); i:=2*i+1; until i>64; readLn; closeGraph; end. |
![]() |
42. Twierdzenie o liczbach pierwszych i jego zastosowanie do szyfrowania RSA
program Twierdzenie_o_liczbach_pierwszych_i_jego_zastosowanie_do_szyfrowania_RSA; {$N+} uses crt; var i,p,q,k,N,M,a,a1,e,d:integer; potega,potega1,potega2:extended; reszta,reszta1,reszta2:integer; function pierwsza(a:integer):boolean; var n:integer; begin pierwsza:=false; for n:=2 to round(sqrt(a)) do if a mod n=0 then exit; pierwsza:=true; end; function NdoM(a,b:integer):extended; var n:integer; x:extended; begin x:=1; for n:=1 to b do x:=x*a; NdoM:=x; end; function nwd(a,b:integer):integer; var r:integer; begin repeat r:=a mod b; a:=b; b:=r; until r=0; nwd:=a; end; procedure liczba_d; var m:integer; begin a:=0; repeat a:=a+1; m:=a*(p-1)*(q-1)+1; until m mod e=0; d:= m div e; end; {******* program gl˘wny *********} begin clrScr; randomize; repeat repeat repeat repeat p:=random(12)+2; until pierwsza(p)=true; repeat q:=random(12)+2; until (pierwsza(q)=true) and (p<>q); k := p * q; M := (p-1)*(q-1)+1; N := random(12)+2; potega:=NdoM(N,M); until (N<k) and (potega<1e14); reszta:=round(potega-int(potega/k)*k); repeat e:=random(5)+2; until (nwd(e,p-1)=1) and (nwd(e,q-1)=1); liczba_d; potega1:=NdoM(N,e); until potega1<1e14; reszta1:=round(potega1-int(potega1/k)*k); potega2:=NdoM(reszta1,d); until (potega2<1e14) and (reszta1<>N); reszta2:=round(potega2-int(potega2/k)*k); textColor(green); { Twierdzenie } writeLn('TW.2.'); write(' Jezeli p,q-r˘zne liczby pierwsze i '); textColor(lightBlue); write('N'); textColor(green); write('<p*q, to '); textColor(lightBlue); write('N'); textColor(green); write('^(p-1)*(q-1)+1 mod p*q = '); textColor(lightBlue); writeLn('N'); textColor(white); for i:=1 to 76 do write('_'); textColor(green); writeLn; writeLn; { przyklad } write('Przyklad:'); textColor(white); write(' p=',p:1,', q=',q:1,', p*q=',p*q:1,', N='); textColor(lightBlue); write(N:1); textColor(white); writeLn(', (p-1)*(q-1)+1=',M:1); textColor(lightBlue); write(' ',N:1); textColor(white); write('^',M:1,' mod ',k:1,' = ',potega:1:0,' mod ',k:1,' = '); textColor(lightBlue); write(reszta:1); textColor(green); writeLn; writeLn; { uog˘lnienie } writeLn('Uog˘lnienie:'); write(' Jezeli p,q-r˘zne liczby pierwsze i '); textColor(lightBlue); write('N'); textColor(green); write('<p*q, to '); textColor(lightBlue); write('N'); textColor(green); write('^a*(p-1)*(q-1)+1 mod p*q = '); textColor(lightBlue); writeLn('N'); textColor(green); writeLn(' gdzie a = 1, 2, 3, ...'); for a1:=1 to 3 do begin textColor(white); write(' np. a=',a1:1,' p=',p:1,', q=',q:1,', p*q=',p*q:1,' N='); textColor(lightBlue); write(N:1); M:=a1*(p-1)*(q-1)+1; potega:=NdoM(N,M); reszta:=round(potega-int(potega/k)*k); textColor(white); writeLn(', a*(p-1)*(q-1)+1=',M:1); textColor(lightBlue); write(' ',N:1); textColor(white); write('^',M:1,' mod ',k:1,' = ',potega:1:0,' mod ',k:1,' = '); textColor(lightBlue); write(reszta:1); writeLn; end; writeLn; a1:=a; M:=a1*(p-1)*(q-1)+1; potega:=NdoM(N,M); reszta:=round(potega-int(potega/k)*k); textColor(green); writeLn('Zastosowanie:'); { Zastosowanie-szyfrowanie RSA } textColor(lightBlue); write(' N'); textColor(green); write('^M mod k = ('); textColor(lightBlue); write('N'); textColor(green); write('^e)^d mod k = ('); textColor(lightBlue); write('N'); textColor(green); write('^e mod k)^d mod k = '); textColor(lightRed); write('X'); textColor(green); write('^d mod k = '); textColor(lightBlue); writeLn('N'); textColor(green); writeLn(' gdzie M = a*(p-1)*(q-1)+1 = e*d i e,d wzglednie pierwsze z p-1 i q-1,'); textColor(white); writeLn(' np. a=',a:1,', p=',p:1,', q=',q:1,', e=',e:1,', d=',d:1,', M=',M:1,', k=',k:1); writeLn; textColor(lightBlue); write(N:1); textColor(white); write('^',M:1,' mod ',k:1,' = ('); textColor(lightBlue); write(N:1); textColor(white); write('^',e:1,' mod ',k:1,')'); write('^',d:1,' mod ',k:1,' = '); textColor(lightRed); write(reszta1:1); textColor(white); write('^',d:1,' mod ',k:1,' = '); write(potega2:1:0,' mod ',k:1,' = '); textColor(lightBlue); write(reszta2:1); textColor(white);writeLn; readLn; end. |
![]() |
43. Twierdzenie o resztach
program Tw_1a_o_resztach; uses crt; var a,b,c,x,y:longInt; begin clrScr; writeLn('Tw.1a. (a+b) mod c = ((a mod c)+(b mod c)) mod c'); writeLn('-----------------------------------------------------'); randomize; a:=random(40); b:=random(30); c:=random(20)+1; x:=a mod c; y:=b mod c; textColor(lightGray); writeLn('Przyklad: a = ',a,', b = ',b,', c = ',c,','); writeLn; writeLn(' L = (',a,'+',b,') mod ',c,' = '); writeLn(' = ',a+b,' mod ',c,' = '); textColor(lightRed); writeLn(' = ',(a+b) mod c); textColor(lightGray); writeLn(' P = ((',a,' mod ',c,')+(',b,' mod ',c,')) mod ',c,' = '); writeLn(' = (',x,'+',y,') mod ',c,' = '); writeLn(' = ',x+y,' mod ',c,' = '); textColor(lightRed); writeLn(' = ',(x+y) mod c); textColor(lightGray); writeLn(' L = P'); readLn; end. |
![]() |
44. Układ współrzędnych w przestrzeni
Program XYZ; uses Graph; var karta,tryb,x,y,z,n,xN,xP,yP,xA,yC,yA:integer; begin karta:=vga; tryb:=vgaHi; initGraph(karta,tryb,'c:\tp\bgi'); line(0,240,639,240); for n:=0 to 32 do putPixel(n*20,238,white); line(320,0,320,479); for n:=0 to 24 do putPixel(318,n*20,white); line(0,479,639,0); for n:=0 to 64 do putPixel(n*10-3,479-round(240/320*n*10),white); x:=5; y:=6; z:=7; xN:=320+x*20; xP:=320-y*10; xA:=XP+x*20; yP:=240+round(240/320*y*10); yA:=YP-z*20; yC:=240-z*20; setColor(yellow); line(xP,yP,xA,yP);line(xA,yP,xN,240);line(xN,240,xN,yC);line(xA,yA,xN,yC); line(xA,yA,xP,yA);line(xP,yA,320,yC);line(320,yC,xN,yC);line(xP,yP,xP,yA); line(xA,yA,xA,yP);line(xP,yP,320,240);line(320,240,xN,240);line(320,240,320,yC); fillEllipse(xA,yA,3,3); readLn; closeGraph; end. |
![]() |
45. Wklęsłość - wypukłość funkcji
Program wkleslosc_wypuklosc; {$N+} uses Graph; var karta,tryb,n,siatka,j,kolor:integer; x,y,dx,y1,y2,y3,xpp:extended; function f(x:extended):extended; begin f:=x*x/(2*x*x-x-2); end; begin karta:=detect; initGraph(karta,tryb,'c:\tp\bgi'); j:=20; setColor(darkGray); for n:=-320 div j to 320 div j do line(n*j+320,0,n*j+320,479); for n:=-240 div j to 240 div j do line(0,n*j+240,639,n*j+240); setColor(white); line(0,240,639,240); line(320,0,320,479); x:=-320/j; Dx:=0.00025; repeat x:=x+Dx; y:=f(x); y1:=f(x+Dx); y2:=f(x+2*Dx); y3:=f(x+3*Dx); if y1-y>y2-y1 then kolor:=yellow else kolor:=lightRed; xpp:=(2*x+3*Dx)/2; if abs(y)<240/j then putPixel(round(xpp*j+320),round(-f(xpp)*j+240),kolor); if (((y2-y1<y1-y) and (y2-y1<y3-y2)) or ((y2-y1>y1-y) and (y2-y1>y3-y2))) and (abs(y)<240/j) and (abs(y1)<240/j) and (abs(y2)<240/j) and (abs(y3)<240/j) then writeLn('xpp=',xpp:18:14,', ypp=',f(xpp):18:14); until x>320/j; readln; closeGraph; end. |
![]() |
46. Wielościany foremne
Program Sprawdzenie_ilosci_wieloscianow_foremnych; uses crt; var x,y,k,s,w:integer; begin clrScr; for x:=3 to 50 do for y:=3 to 50 do for k:=6 to 50 do if abs(2/x+2/y-2/k-1)<0.0000001 then writeLn('x=',x,' y=',y,' k=',k,' w=',2*k/y:2:0,' s=',2*k/x:2:0); writeLn('Koniec obliczeä'); readLn; end. |
![]() |
47. Wykresy funkcji
Program Wykresy_funkcji; uses Graph; var karta,tryb,n,siatka,j:integer; x,y:real; function f(x:real):real; begin f:=3/(x-2); end; begin karta:=detect; initGraph(karta,tryb,''); j:=36; siatka:=36; setColor(darkGray); rectangle(0,0,639,479); for n:=-320 div siatka to 320 div siatka do line(320+n*siatka,0,320+n*siatka,479); for n:=-240 div siatka to 240 div siatka do line(0,240+n*siatka,639,240+n*siatka); setcolor(white); line(0,240,639,240); line(630,235,639,240); line(630,245,639,240); outtextxy(630,250,'X'); line(320,0,320,479); line(315,9,320,0); line(320,0,325,9); outtextxy(330,8,'Y'); for n:=-320 div j to 320 div j do line(320+n*j,238,320+n*j,242); for n:=-240 div j to 240 div j do line(318,240+n*j,322,240+n*j); x:=-320/j; setColor(lightBlue); setFillStyle(1,lightBlue); repeat x:=x+1/j/2; y:=240-f(x)*j; if abs(y)<480 then fillEllipse(round(x*j+320),round(y),1,1); until x>320/j; readln; closeGraph; end. |
![]() |
48. Wykresy skalowane
49. Wykresy nierówności.
50. Zamiana liczby binarnej na dziesiętną
program Binarne_na_rzeczywiste; uses crt; var n: longInt; RZ, p: real; Bin: string; begin clrScr; Bin:='1010101,1100110011'; p:=1; n:=2; while (Bin[n]<>',') and (n<=length(Bin)) do begin p:=p*2; n:=n+1; end; write(Bin,' -> '); Rz:=0; for n:=1 to length(Bin) do begin if Bin[n]='1' then Rz:=Rz+p; if Bin[n]<>',' then p:=p/2; end; write(Rz:1:11); readLn; end. |
![]() |
51. Zamiana liczby dziesiętnej na binarną
Program Dziesietne_na_binarne; uses crt; var liczbaDz:integer; liczBin:string; begin clrScr; liczbaDz:=85; write(liczbaDz,' - '); liczBin:=''; repeat liczBin:=chr(liczbaDz mod 2+48) +liczBin; liczbaDz:=liczbaDz div 2; until liczbaDz=0; writeLn(liczBin); readLn; end. |
![]() |
52. Zamiana liter na kody ASCII
program Zamiana_tekstu_na_liczbe; {$N+} uses crt; var n:integer; liczba,potega255:extended; tekst:string; procedure zamienTekstNaLiczbe(tekst:string); begin liczba:=0; potega255:=1; for n:=length(tekst) downto 1 do begin liczba:=liczba+ord(tekst[n])*potega255; potega255:=potega255*255; end; end; begin clrScr; tekst:='Kom'; zamienTekstNaLiczbe(tekst); writeLn(tekst,'=',liczba:1:0); readLn; end. |
![]() |
53. Zamiana ułamków zwykłych na dziesiętne do 1000 cyfr po przecinku
Program Ulamki_zwykle_na_dziesietne; uses crt; var licznik,mianownik,iloscMiejsc:longInt; begin clrScr; licznik:=133; mianownik:=74; iloscMiejsc:=0; write(licznik,'/',mianownik,' = ',licznik div mianownik,','); repeat; licznik:=(licznik mod mianownik)*10; write(licznik div mianownik); inc(iloscMiejsc); until iloscMiejsc>1000; write('...'); readLn; end. |
![]() |
54. Zbiory punktów
55. Zbiory Julii
Program Zbior_Julii; uses crt,graph; var karta,tryb,n,k,i,obr,siatka:integer; x,y,xst,yst,Re_c,Im_c,xpocz,xkon,ypocz,ykon,krok_x,krok_y:real; begin karta:=detect; initgraph(karta,tryb,''); xpocz:=-1.8; xkon:=1.8; ypocz:=-1.3; ykon:=1.3; krok_x:=(xkon-xpocz)/630; krok_y:=(ykon-ypocz)/420; for n:=1 to 630 do for k:=1 to 420 do begin Re_c:=xpocz+n*krok_x; Im_c:=ypocz+k*krok_y; xst:=Re_c; yst:=Im_c; i:=0; repeat x:=xst*xst-yst*yst; y:=2*xst*yst-1; xst:=x; yst:=y; i:=i+1; until (x*x+y*y>8) or (i>12); if keyPressed then exit; if i>12 then putPixel(n,420-k+30,white); putPixel(n,420-k+30,i); end; readln; closeGraph; end. |
![]() |
56. Zbiór Mandelbrota
57. Wieże Hanoi (rekurencja)
program Wieze_Hanoi; uses graph; var karta,tryb,n,ilK,ypocz,gr,j:integer; t :array[1..3,1..12] of integer; tw:array[1..3] of integer; procedure przeloz_krazek(skad, dokad : integer); begin tw[dokad]:=tw[dokad]+1; t[dokad,tw[dokad]]:=t[skad,tw[skad]]; setFillStyle(1,black); setColor(black); fillEllipse(skad*210-100,ypocz-tw[skad]*gr,t[skad,tw[skad]]*j,gr div 2-1); t[skad,tw[skad]]:=0; tw[skad]:=tw[skad]-1; setFillStyle(1,t[dokad,tw[dokad]]); fillEllipse(dokad*210-100,ypocz-tw[dokad]*gr,t[dokad,tw[dokad]]*j,gr div 2-1); readLn; end; procedure przeloz(ile, skad, dokad, roboczy : integer); begin if ile=1 then przeloz_krazek(skad, dokad) else begin przeloz(ile-1, skad, roboczy, dokad); przeloz_krazek(skad, dokad); przeloz(ile-1, roboczy, dokad, skad) end; end; begin karta:=vga; tryb:=vgaHi; initGraph(karta, tryb,''); writeLn('Nacisnij dowolny klawisz'); ilK:=3; j:=19-ilK; gr:=30; j:=19-ilK; ypocz:=420; for n:=1 to ilK do t[1,n]:=ilK-n+1; tw[1]:=ilK; for n:=1 to tw[1] do begin setFillStyle(1,t[1,n]); fillEllipse(1*210-100,ypocz-n*gr,t[1,n]*j,gr div 2-1); end; readLn; przeloz(ilK,1,3,2); closeGraph; end. |
![]() |