A gi¶i thuËt I / §Þnh nghÜa gi¶i thuËt

Bµi 10
Uses Crt;

Var h,i,j : Byte;

Begin

Clrscr;

Repeat

Write('nhap so dong dau sao "*" ');

{$I-} Readln(h); {$I+}

Until (IoResult=0) and (h>0) and (h<=24);

For i:=1 to h do

Begin

For j:=1 to i do

Begin

Gotoxy(41-i+j*2,i);

Write('* ');

End;

End;

Readln

End.
Bµi 11

Uses Crt;

Var k,l,m,n : Byte;

Procedure Ve;

Var i,j : Byte;

Begin

Clrscr;

Writeln('Ve ban co quoc te ');

For i:=1 to 8 do

Begin

For j:=1 to 8 do

Begin

If i mod 2 =0 then

If j mod 2 = 0 then Textcolor(12) Else Textcolor(15)

Else

If j mod 2 = 0 then Textcolor(15) Else Textcolor(12);

Write(#219#219);

End;

Writeln;

End;

End;

Procedure Nhap;

Begin

Writeln ;Textcolor(15);

Write('Nhap toa do o thu nhat : ');

Repeat

{$I-} Readln(k,l) {$I+}

Until ( IoResult=0 ) and (k>0) and(k<9) and (l>0) and(l<9);

Write('Nhap toa do o thu hai : ');

Repeat

{$I-} Readln(m,n) {$I+}

Until ( IoResult=0 ) and (m>0) and(m<9) and (n>0) and(n<9);

End;

Function Cungmau : Boolean;

Begin

If (k+l+m+n) mod 2 =0 then Cungmau := True

Else Cungmau := False;

End;

Function Hau : Boolean;

Begin

If (k=m) or (l=n) or (abs(m-k)=abs(n-l)) then

hau := True Else hau := False;

End;

Function Ma : Boolean;

Begin

If Abs((k-m)*(l-n))=2 then Ma := True Else Ma := False;

End;

Procedure Ketluan;

Begin

If cungmau then Writeln('Cung mau ') Else writeln('Khac mau ');

If hau then Writeln('2 Hau khong che nhau ')

Else writeln('2 Hau khong khong che nhau');

If Ma then Writeln('2 Ma khong che nhau ')

Else writeln('2 Ma khong khong che nhau ');

End;

BEGIN

Ve;

Nhap;

Ketluan;

Readln

END.

Bµi 12

Uses Crt;

Label Continue,continue1;

Var x,y,Color : Byte;

BEGIN

color:=1;

Textbackground(0); Clrscr;

Textcolor(10);

Gotoxy(28,18);

Write('An phim bat ky de thoat . . .');

Continue:

If (color=15) then color:=1 Else Inc(color);

Textcolor(color);

x:=1;

y:=1;

Continue1:

Gotoxy(2*x,y); Write('TIN HOC ');

Gotoxy(72-2*x,y); Write('TUOI TRE ');

Gotoxy(39,y); Write('va');

DELAY(200);

Gotoxy(2*x,y); Write(' ');

Gotoxy(72-2*x,y); Write(' ');

Gotoxy(39,y); Write(' ');

Inc(x);

Inc(y);

If (y<14) then Goto continue1;

Gotoxy(2*x,y); Write('TIN HOC ');

Gotoxy(72-2*x,y); Write('TUOI TRE ');

Gotoxy(39,y); Write('va');

If Not keypressed then goto continue;

END.
Bµi 13
Uses Crt;

Const Max = 30;

Type Mang = Array[1..Max] of Real;

Var X,Y : mang;

n : Byte;

Function Congtuyen : Boolean;

Var i,j,k : Byte;

Begin

For i:=1 to N do

For j:=1 to N do

For k:=1 to N do

If (i<>j) and (i<>k) and (j<>k) then

If (X[i]-X[j])*(Y[k]-Y[j])=(Y[i]-Y[j])*(X[k]-X[j])

then

Begin Congtuyen := True; Exit; End;

Congtuyen := False;

End;

Procedure Nhap;

Var i : Byte;

Begin

n := 3;

Writeln('Nhap toa do 3 dinh cua tam giac : ');

For i:=1 to n do

Repeat

Write('Toa do ',i,' la : ');

{$I-} Readln(X[i],Y[i]);

Until Ioresult=0;

End;

Function Tontai: Boolean ;

Begin

If congtuyen then

Begin

Writeln('Khong ton tai tam giac ');

Tontai := False;

Readln;

Halt;

End

Else

Begin

Writeln('Ton tai tam giac ');

Tontai := True;

End;

End;

Function Dientich : Real;

Var i,j : Byte;

p : Real;

Begin

p := 0;

For i:=1 to N do

Begin

j := i+1;

If j=N+1 then j:=1;

p := p+(((X[j]-X[i])*ABS(Y[j]+Y[i]))/2);

End;

Dientich := ABS(p);

End;

BEGIN

Clrscr;

Nhap;

Tontai;

If tontai then Writeln('Dien tich tam giac la : ',dientich :10:2);

Readln

END.
Bµi 14

Uses Crt;

Const Max = 100;

Type Mang = Array[1..Max+1] of Integer;

Var X,Y : mang;

N,sd : Byte;

Procedure Nhap1 (i : integer;Var x0,y0 :integer);

Begin

Write('Nhap vao toa do diem ',Char(i+64),' = ');

Repeat

{$I-} readln(x0,y0); {$I+}

until (ioresult=0) ;

End;

Procedure Nhap;

Var i : Byte;

Begin

Clrscr;

Repeat

Write('Nhap so dinh cua da giac sd = ');

{$I-} Readln(sd); {$I+}

Until (IoResult=0) and (sd < Max) and (sd>2);

N := sd+1;

For i:=1 to N do Nhap1(i,x[i],y[i]);

End;

Procedure Hien;

Var i : Integer;

Begin

For i:=1 to N do

Writeln('Diem ',Char(i+64),'(',x[i]:3,',',y[i]:3,')');

End;

Function Dactrung(i,j,k : Byte) : ShortInt;

Var F : Real;

Begin

{Lap phuong trinh duong thang qua (x[i],y[i]) va (x[j],y[j]) }

F := (y[k]-y[i])*(x[j]-x[i])-(y[j]-y[i])*(x[k]-x[i]);

If F > 0 then dactrung := 1 Else dactrung := -1;

End;

Function Dagiacloi(sd1 : Byte) : Boolean;

Var i,j,k,h : Byte;

t : ShortInt;

Begin

For i:=1 to sd1 do

Begin

j := i+1;

If j=N then j:= 1;

k := j+1;

If k=N then k:= 1;

T := dactrung(i,j,k);

For h := 1 to sd1 do

If (h<>i) and (h<>j) and( h<>k) then

If T*dactrung(i,j,h) < 0 then

Begin

DagiacLoi := False;

Exit;

End;

End;

DagiacLoi := True;

End;

Function Trong : Boolean;

Var i,j,k : Byte;

T : ShortInt;

Begin

For i:=1 to sd do

Begin

j:=i+1;

If j=N then j:=1;

k :=j+1;

If k=N then k:=1;

t := dactrung(i,j,N);

If t*dactrung(i,j,k) < 0 then

Begin

Trong := False;

Exit;

End;

End;

Trong := True;

End;

Procedure Thuchien;

Begin

If Not Dagiacloi(sd) then

Begin

Writeln(' Theo thø tù liªn tiÕp cña ®Ønh th× Khong phai da giac loi ');

Readln;

Halt;

End

Else

Begin

Writeln('Dung la da giac loi ');

If not Trong then

Begin

Write('Diem ',Char(N+64),'(',x[N]:3,',',y[N]:3,')');

Writeln(' o ngoai da giac loi da cho ');

End

Else

Begin

Write('Diem ',Char(N+64),'(',x[N]:3,',',y[N]:3,')');

Writeln(' o trong da giac loi da cho ');

End;

End

End;

BEGIN

Clrscr;

Nhap;

Hien;

Thuchien;

Readln

END.
T­¬ng tù Bµi 14 +15+ 16 { KiÓm tra ®a gi¸c låi vµ tÝnh diÖn tÝch cña ®a gi¸c låi }

Uses Crt;

Const Max = 20;

Type Toado = Array[1..Max] of Real;

Var X,Y : Toado;

B : Array[1..1000] of Boolean;

ds : Array[1..1000] of Word;

n,top : Word;

Procedure Input;

Var i : Word;

Begin

{ NhËp gi¸ trÞ c¸c ®Ønh cña ®a gi¸c vµo m¶ng X vµ Y }

End;

Function CungFia(X1,X2,X3,X4,Y1,Y2,Y3,Y4 : Real) : Boolean;

Var d1,d2 : Real;

Begin

d1 := (Y3-Y1)*(X2-X1)-(X3-X1)*(Y2-Y1);

d2 := (Y4-Y1)*(X2-X1)-(X4-X1)*(Y2-Y1);

cungFia:=d1*d2>=0;

End;

Function DG_Loi(X,Y : Toado): Boolean; { Kiem tra tinh Loi cua da giac }

Var i,j,k,L : Word;

s : Real;

Begin

For i:=1 to n do

Begin

k := i+2;

L := i+1;

If k=n+1 then k := 1;

If L=n+1 then L := 1;

For j:=1 to n do

If (j<>i) and ( Not CungFia(x[i],x[L],x[j],x[k],y[i],y[L],y[j],y[k])) then

Begin

Write('Da Giac Khong Loi');{Theo thø tù liªn tiÕp c¸c ®Ønh ®· nhËp}

DG_Loi := False; Halt;

End;

End;

Writeln('Da Giac Loi');

DG_Loi := True;

End;

Procedure Dientich(X,Y : Toado);

Var s,Min : Real;

i,j : Byte;

Begin

Min := 100000; { TÞnh tiÕn ®a gi¸c däc trôc tung , ®Ó ®a gi¸c n»m hoµn toµn phÝa trªn ox}

For i:=1 to n do

If Y[i]

If Min<0 then

For i:=1 to n do Y[i] := Y[i] - Min;

S := 0;

For i:=1 to n do

Begin

j := i+1;

If j=n+1 then j := 1;

S := S+((x[j]-x[i])*abs(y[j]+y[i]))/2;

End;

S := Abs(S);

Writeln(s:6:2);

End;

Procedure Work1;

Begin

If DG_Loi(X,Y) then Dientich(X,Y);

End;

Function Timk : Byte; { Tim diem tiep theo cua duong bao quanh }

Var i,L,k : Byte;

Ok : Boolean;

Begin

Timk:=0;

For k:=1 to n do

If B[k]=False then

Begin

L := (k+1) mod n;

Ok := False;

For i:=1 to n do

If not cungFia(x[k],x[ds[top]],x[i],x[L],y[k],y[ds[top]],y[i],y[L]) then

Begin

Ok:=true;

Break;

End;

If Ok=False then

Begin

Timk := k;

exit;

End;

End;

End;

Procedure Work2; { T×m ®­êng ®a gi¸c låi chøa tËp ®iÎm ®· cho }

Var i,j,k,L,T : Word;

Min : Real;

Begin

Min := 100000;

For i:=1 to n do

If x[i]

Begin

Min := x[i];

T := i;

End;

B[t] := True;

Top := 0;

Inc(Top);

Ds[Top] := t;

Repeat

T := Timk;

Inc(Top);

Ds[Top] := T;

B[t] := True;

Until T=0;

Dec(Top);

For i:=1 to Top do Write(DS[i]:4);

End;

BEGIN

Input;

Work1;

Work2;

END.
{ Bµi 16 Bµi kiÓm tra ( NhiÒu b­u ¶nh cho vµo 1 phong b× ) }
C¸ch lµm 1

Uses Crt;

Const sa = 3;

e = 0.01;

Type ktcd = Array[1..sa] of Real;

Ok = Array[1..sa] of Boolean;

Var a,b : Real;

c,d : ktcd;

Kq : Ok;

Procedure Trao(Var x,y : Real);

Var p : Real;

Begin

p := x; x := y; y := p;

End;

Procedure Nhap;

Var i : Byte;

Begin

Clrscr;

Write('Nhap 2 kich thuoc a,b cua phong bi : ');

Repeat

{$I-} Readln(a,b); {$I+}

Until ( Ioresult = 0 ) and ( a>0 ) and (b>0);

If a>b then Trao(a,b);

Writeln;

For i:=1 to sa do

Begin

Write('Nhap 2 kich thuoc c,d cua buu anh ',i,' : ');

Repeat

{$I-} Readln(c[i],d[i]); {$I+}

Until ( Ioresult = 0 ) and ( c[i]>0 ) and (d[i]>0);

If c[i]>d[i] then trao(c[i],d[i]);

End;

End;

Procedure Hien;

Var i : Byte;

Begin

Writeln('Phong bi (',a:5:2,b:5:2,')');

For i:=1 to sa do

Writeln('Buu anh ',i:2,'(',c[i]:5:2,d[i]:5:2,')');

End;

Procedure Khoitri;

Begin

FillChar(Kq,Sizeof(Kq),False);

End;

Function Kt1(x,y : Real) : Boolean;

Begin

If (x<=a) and (y<=b) then Kt1 := True Else Kt1 := False;

End;

Procedure Thu1;

Var i : Byte;

Begin

For i:=1 to sa do

If Kt1(c[i],d[i]) then kq[i] := True;

End;

Procedure HienKq;

Var i ,dem : Byte;

Begin

Writeln(‘Sè hiÖu c¸c b­u ¶nh cho ®­îc vµo trong phong b× lµ : ‘);

For i:=1 to sa do

If Kq[i] then

Begin

Write(i:4);

Inc(dem);

End;

Writeln(‘Tæng sè cã ‘ ,dem,’ b­u ¶nh cho ®­îc vµo trong phong b× ‘);

End;

Function Duoc(i : Byte;m,n : Real) : Boolean;

Var xc,yc,xd,yd,k : Real;

Begin

k := d[i]/c[i];

xc := n + k*m;

yc := n*k;

yd := m+yc;

xd := xc - n;

If (xc <= b) and (yc <=a) and (xd <= b) and (yd <=a) then

Duoc := True Else Duoc := False;

End;

Procedure Kt2(i : Byte);

Var m,n,k : Real;

co : Boolean;

Begin

m := e;

While (m<=a) and ( c[i]>= m) do

Begin

n := sqrt(sqr(c[i])-sqr(m));

k := d[i]/c[i];

If duoc(i,m,n) then

Begin

kq[i] := true;

Exit;

End;

m := m+e;

End;

End;

Procedure Thu2;

Var i : Byte;

Begin

For i:=1 to sa do kt2(i);

End;

BEGIN

Nhap;

Hien;

Thu1;

Thu2;

Hienkq;

END.

C¸ch lµm 2 :

Uses Crt;

Const Max = 20;

Fi = 'Phbi_anh.txt';

Type M1 = Array[1..Max] of Real;

Var x,y : M1;

F : Text;

N : Byte;

A,B : Real;

Procedure Loi;

Begin

Writeln('Loi File ');

Readln;

Halt;

End;

Procedure Traococ(Var x,y : Real);

Var phu : Real;

Begin

phu := x; x := y; y := phu;

End;

Procedure Nhap;

Var i : Byte;

Begin

Assign(F,Fi);

{$I-} Reset(F); {$I+}

If IoResult<>0 then Loi;

Readln(F,N);

i := 1;

While not Eof(F) do

Begin

Readln(F,X[i],Y[i]);

If X[i]>Y[i] then Traococ(X[i],Y[i]);

Inc(i);

End;

a := x[i-1]; b := y[i-1];

If i <> N+2 then Loi;

Close(F);

End;

Procedure Hien;

Var i : Byte;

Begin

Writeln('So buu anh la ',N);

Writeln('Kich thuoc ®¸y hép : ','(',x[N+1]:4:2,',',y[N+1]:4:2,')');

Writeln('Kich thuoc cac b anh : ');

For i:=1 to N do Writeln('(',x[i]:4:2,',',y[i]:4:2,')');

End;

Function Duoc(c,d : Real) : Boolean;

Var k,L,m : Real;

Begin

If (c<=a) and (d<=b) then duoc := True Else

Begin

m := (Sqrt(Sqr(c)+sqr(d)))/2;

k := Sqr((b/2)-sqrt(sqr(m)-sqr(a)/4));

L := Sqr((a/2)-sqrt(sqr(m)-sqr(b)/4));

m := Sqrt(sqr(k)+sqr(L));

If c

End;

End;

Procedure HienKQ;

Var i : Byte;

Begin

Writeln('Kich thuoc cac b anh dat duoc trong hép la : ');

For i:=1 to N do

If duoc(x[i],y[i]) then Writeln('(',x[i]:4:2,',',y[i]:4:2,')');

End;

BEGIN

Nhap; Hien; HienKq;

END.

C¬ së cña c¸ch lµm trªn lµ :

XÐt b­u ¶nh cã kÝch th­íc c x d . NÕu c<=a , d<=b th× râ rµng b­u ¶nh trong ®¸y hép

Trong tr­êng hîp chiÒu dµi b­u ¶nh > chiÒu dµi ®¸y hép ( d > b)

Trong tr­êng hîp chiÒu dµi b­u ¶nh > chiÒu dµi ®¸y hép ( d > b)

A H B Quay ®­êng trßn ®­êng kÝnh = ®­êng chÐo b­u ¶nh K OH=R = SQRT( Sqr(OH)+Sqr(HK)) --> tÝnh AH

M T­¬ng tù t×m AM . Tõ ®ã TÝnh MH .

§iÒu kiÖn cÇn vµ ®ñ ®Ó b­u ¶nh n»m trong hép lµ chiÒu réng cña nã <= MH

O

Chó ý Trong h×nh vÏ bªn , ®¸y hép lµ ABCD , NÕu J b­u ¶nh n»m trong h×nh ch÷ nhËt MHJN th× còng n»m trong ®¸y hép ABCD

C D

N

Bµi KiÓm tra

S¾p xÕp lµ mét c«ng viÖc tÝnh to¸n hay ph¶i lµm nhÊt . XÐt bµi to¸n s¾p xÕp cô thÓ sau ®©y : CÇn s¾p xÕp kh«ng gi¶m c¸c phÇn tö cña m¶ng , mµ c¸c gi¸ trÞ cña c¸c phÇn tö chØ lµ 1,2,3 .ViÖc s¾p xÕp ®­îc thùc hiÖn b»ng mét d·y c¸c thao t¸c ®æi chç . Mét thao t¸c ®æi chç x¸c ®Þnh bëi 2 phÇn tö ë vÞ trÝ p , q cña m¶ng lµ ®æi vÞ trÝ cña chóng cho nhau .

LËp ch­¬ng tr×nh tÝnh sè Ýt nhÊt c¸c thao t¸c ®æi chç ®Ó s¾p xÕp d·y thµnh mét d·y kh«ng gi¶m .

HiÖn trªn mµn h×nh sè Ýt nhÊt c¸c thao t¸c nµy vµ tÊt c¶ c¸c thao t¸c thùc hiÖn ( mçi thao t¸c lµ 2 sè p vµ q t­¬ng øng )

H¹n chÕ : Sè phÇn tö cña m¶ng lµ N <=1000 .

Uses Crt;

Const Max = 1000;

Var A : Array[1..max] of Byte;

Phai,Trai : Array[1..Max] of Word;

N,T2,T3,sp : Word;

Procedure Nhap;

{ NhËp gi¸ trÞ cña N vµ c¸c phÇn tö cña M¶ng A(N) tõ bµn phÝm hoÆc ngÉu nhiªn }

Procedure Khoitao;

Var i : Word;

Begin

T2 := 1;

For i:=1 to N do

If A[i]=1 then Inc(T2) Else If A[i]=2 then Inc(T3);

T3 := T2+T3;

End;

Function Tim1_B2 : Word; { Tim so 1 trong bang 2 }

Var i,j : Word;

Begin

For i:=T2 to T3-1 do

If A[i]=1 then Begin Tim1_B2:=i; Exit; End;

Tim1_B2:=0;

End;

Function Tim1_B3 : Word; { Tim so 1 trong bang 3 }

Var i,j : Word;

Begin

For i:=T3 to N do

If A[i]=1 then Begin Tim1_B3:=i; Exit; End;

Tim1_B3:=0;

End;

Procedure Doi(i,j,gt : Word);

Begin

A[j] := A[i]; A[i] := gt;

Inc(sp);

Phai[sp]:= i; Trai[sp]:= j;

End;

Procedure Lam1;

Var i,x,y : Word;

Begin

For i:=1 to T2-1 do

Begin

x := Tim1_B2;

y := Tim1_B3;

If A[i]=2 then

Begin

If (x>0) then Doi(i,x,1);

If ((y>0) and (x=0)) then Doi(i,y,1);

End Else

If A[i]=3 then

Begin

If (y>0) then Doi(i,y,1);

If ((y=0) and (x>0)) then Doi(i,x,1);

End;

End;

End;

Function Tim3_B2 : Word;{ Tim so 2 trong bang 3 }

Var i : Word;

Begin

For i:=T3 to N do

If A[i]=2 then

Begin

Tim3_B2:=i;

Exit;

End;

Tim3_B2:=0;

End;

Procedure Lam2; { Chuyen so 3 tu bang 2 ve bang 3 }

Var x,i : Word;

Begin

For i:=T2 to T3-1 do

If A[i] = 3 then

Begin

x:=Tim3_B2;

If x>0 then Doi(i,x,3);

End;

End;

Procedure Hien;

Var i : Word;

Begin

For i:=1 to sp Do Writeln(Phai[i],' ',Trai[i]);

End;

BEGIN

Clrscr;

Nhap; Khoitao;

Lam1;

Lam2;

Hien;

Readln

END.

Каталог: files -> news -> attachs
news -> Chỉ số giá tiêu dùng, chỉ số giá vàng và đô la Mỹ tháng 02 năm 2007
news -> Nhập khẩu tháng 10 và 10 tháng năm 2005
news -> Coâng vieäc: nhaân vieân baùn haøNG
news -> Thoâng baùo tuyeån duïng maõ soá: 1208-903 Coâng vieäc: phuï vieäc nhaø
news -> Coâng vieäc: nhaân vieân thu ngaâN; nhaân vieân giöÕ xe
news -> Thoâng baùo tuyeån duïng maõ soá: 1210-1257 Coâng vieäc: phuï vieäc nhaø
news -> Thoâng baùo tuyeån duïng maõ soá: 1210-1161 Coâng vieäc: phuï vieäc nhaø
attachs -> TRƯỜng thpt quang minh số : 46/ktnb-thptqm cộng hòa xã HỘi chủ nghĩa việt nam
attachs -> PHẦn chung cho tất cả thí sinh (7,0 điểm) Câu I
attachs -> ĐẠi học quốc gia hà NỘi lý LỊch khoa họC