Bài tập Pascal nè các bạn ơi!!!!!!!!

Xem chủ đề cũ hơn Xem chủ đề mới hơn Go down

Bài tập Pascal nè các bạn ơi!!!!!!!!

Bài gửi  vanhongha on 2010-02-19, 06:14

Bài 1 :
Dùng thủ tục chuyển một số tự nhiên n cho trước sang hệ cơ số 2 .
Bài 2 :
Dùng thủ tục giải phương trình bậc hai ax2 + bx + c = 0
Bài 3 :
Hãy viết lại thủ tục Insert đối với một chuỗi kí tự cho trước tùy ý .
Bài 4 :
Viết chương trình thực hiện lần lượt các công việc sau :
_ Lập thủ tục nhập ba số thực dương a , b , c từ bàn phím .
_ Lập thủ tục kiểm tra xem ba số trên có lập thành ba cạnh của tam giác hay không ?
_ Viết thủ tục tính diện tích của tam giác .
_ Viết thủ tục tính các trung tuyến của tam giác .
_ Viết hoàn thiện chương trình chính .
Bài 5 :
Giải phương trình x + y + z = 12 trong phạm vi số nguyên không âm với điều kiện x < 4 .
Bài 6 :
Cho trước các số N , a , b , c tự nhiên . Giải phương trình sau trong phạm vi số nguyên không âm x + y + z = N với điều kiện x < a , y < b , z < c .
Bài 7 :
Viết thủ tục Compare ( S1 , S2 : String ; Var Kq : String ) thực hiện công việc sau : so sánh hai xâu S1 và S2 , tìm tất cả các kí tự có trong cả hai xâu trên . Xâu Kq sẽ chứa tất cả các kí tự đó , mỗi kí tự chỉ được nhớ một lần .
Bài 8 :
Viết hàm tính D (St1 , St2) , với U, V là hai xâu kí tự bất kì , là tổng số các kí tự không giống nhau trong hai xâu trên , mỗi loại kí tự chỉ được nhớ một lần . Ví dụ D (‘aabba’ , ‘bcdd’) = 2 vì chỉ có hai kí tự a và d là không giống nhau trong các xâu trên .
Bài 9 :
Viết chương trình hoàn chỉnh thực hiện các công việc của thực đơn sau :
1. Nhập dữ liệu ( nhập số tự nhiên n ) .
2. Phân tích ra thừa số nguyên tố ( phân tích n thành tích các số nguyên tố ) .
3. Thoát khỏi chương trình .

BÀI GIẢI
Bài 1 :
Dùng thủ tục chuyển một số tự nhiên n cho trước sang hệ cơ số 2 .
Procedure Change ( n : integer ; Var St : String ) ;
(* thủ tục chuyển số tự nhiên n cho trước sang
hệ cơ số 2 và được lưu ở trong xâu St *)
Type
b : Array[0 .. 1] Of Char = ('0' , '1') ;
Var
du , So : Integer ;
S : String ;

Begin
S := '' ; (* xâu rỗng *)
So := n ;
Repeat
Du := So mod 2 ;
So :=So div 2 ;
S := b[du] + s ;
Until So = 0 ;
St := S ;
End ;
Bài 2 :
Dùng thủ tục giải phương trình bậc hai ax2 + bx + c = 0
Uses Crt ;
Var a, b, c, x1, x2: real;
(*================================*)
Procedure Nhapabc(var aa,bb,cc: real);
Begin
Write('a='); Readln(aa);
Write('b='); Readln(bb);
Write('c='); Readln(cc);
End;
(*=================================*)
Procedure GPTB2;
Var Delta: real;
Begin
Delta:=sqr(b)-4*a*c;
If Delta<0 then Writeln('Phuong trinh vo nghiem.')
Else
If Delta=0 then
Begin
Write('Phuong trinh co nghiem kep : ');
Write('x1,2=',-b/(2*a):8:2);
End
Else
Begin
x1:=(-b+sqrt(Delta))/(2*a);
x2:=(-b-sqrt(Delta))/(2*a);
Writeln('Phuong trinh co 2 nghiem phan biet la :');
Writeln('X1=',x1:8:2, 'X2=',x2:8:2);
End;
End;
(*================================*)
BEGIN (* CT chính *)
Clrscr;
Writeln(' Giai Phuong Trinh Bac Hai Voi Cac He So :');
Nhapabc(a,b,c);
If a<>0 then GPTB2
Else Writeln(' Khong phai phuong trinh bac hai ');
Readln ;
END .
Bài 3 :
Hãy viết lại thủ tục Insert đối với một chuỗi kí tự cho trước tùy ý .
Procedure Insert ( St1 : String ; Var St2 : String ;Vt : Byte ) ;
(* chèn xâu St1 vào St2 bắt đầu từ vị trí Vt *)
Var i : Byte ;
S : String ;

Begin
If ( Vt > length(St2) Or ( Vt < 1 ) Then
Write(' Khong the chen ra ngoai xau ') ;
Else
Begin
S := '' ; (* xâu rỗng *)
For i := 1 To (Vt - 1) Do S := S + St2[i] ;
S := S + St1 ;
For i := Vt To length(St2) Do S := S + St2[i] ;
St2 := S ;
End ;
End ;
Bài 4 :
Viết chương trình thực hiện lần lượt các công việc sau :
_ Lập thủ tục nhập ba số thực dương a , b , c từ bàn phím .
_ Lập thủ tục kiểm tra xem ba số trên có lập thành ba cạnh của tam giác hay không ?
_ Viết thủ tục tính diện tích của tam giác .
_ Viết thủ tục tính các trung tuyến của tam giác .
_ Viết hoàn thiện chương trình chính .
Uses Crt;
Var a, b, c: real ;
(*================================*)
Procedure Nhap(Var a, b, c: real);
Procedure input (Var a: real; tenbien: Char);
Begin
Repeat
Write('Nhap ' + tenbien+' = '); Readln(a);
Until (a>=0);
End;
Begin (* bắt đầu thủ tục nhập *)
Input(a, 'a');
Input(b, 'b');
Input(c, 'c');
End; (* kết thúc thủ tục nhập *)
(*================================*)
Procedure Kiemtra(a, b, c: Real);
Begin
If (a<b+c) and (b<a+c) and (c<a+b) then
Writeln(a:0:2, ', ', b:0:2, ' va ', c:0:2,
' lap thanh ba canh cua tam giac ')
Else Writeln('Khong lap thanh ba canh cua tam giac') ;
End;
(*===============================*)
Procedure Trung_tuyen (a, b, c: Real);
Var ma, mb, mc: real;
Begin
ma:=sqrt((2*sqr(b)+2*sqr(c)-sqr(a))/4);
mb:=sqrt((2*sqr(a)+2*sqr(c)-sqr(b))/4);
mc:=sqrt((2*sqr(a)+2*sqr(b)-sqr(c))/4);
Writeln('Cac trung tuyen cua tam giac la : ') ;
Writeln('ma=', ma:0:2, ' mb=', mb:0:2, ' mc=', mc:0:2);
End;
(*================================*)
Procedure Dientich (a, b, c: real); Var p, S: real;
Begin
p:=(a+b+c)/2;
S:=sqrt(p*(p-a)*(p-b)*(p-c));
Writeln('Dien tich =', S:0:2);
End;
(*================================*)
BEGIN (* Chương trình chính *)
Clrscr;
Nhap(a, b, c);
Kiemtra(a, b, c);
Dientich(a, b, c);
Trung_tuyen(a, b, c);
Readln;
END .
Bài 5 :
Giải phương trình x + y + z = 12 trong phạm vi số nguyên không âm với điều kiện x < 4 .
Uses Crt;
Var X, Y, Z: byte;
Begin
Clrscr;
Writeln('Giai phuong trinh X+Y+Z=12 trong pham vi '
+ 'so nguyen khong am voi dieu kien x<4');
For X:=0 to 3 do
For Y:=0 to 12 do
For Z:=0 to 12 do
If (X+Y+Z=12) then Writeln(' x=',X,' y=',Y, 'z=',Z);
Readln;
End.
Bài 6 :
Cho trước các số N , a , b , c tự nhiên . Giải phương trình sau trong phạm vi số nguyên không âm x + y + z = N với điều kiện x < a , y < b , z < c .
Uses Crt;
Var N, a, b, c, X, Y, Z, i: Integer;
Begin
Clrscr;
Write(' N, a, b, c = '); Readln(N, a, b,c);
If (a+b+c-3<N) then
Begin
Writeln('Phuong trinh vo nghiem'); Readln;
Exit;
End
Else
Begin
Writeln('Phuong trinh co nghiem la:');
Writeln('x': 10, 'y': 10, 'z':10);
i:=4;
For X:=0 to (a-1) do
For Y:=0 to (b-1) do
For Z:=0 to (c-1) do
If (X+Y+Z=N) then
Begin
Writeln(x: 10, y: 10, z: 10);
inc(i);
If i=24 then
Begin
Write('Nhan Enter de tiep tuc...'); Readln;
i :=0;
End;
End ;
End ;
Write('Nhan Enter de ket thuc...');
Readln;
End.
Bài 7 :
Viết thủ tục Compare ( S1 , S2 : String ; Var Kq : String ) thực hiện công việc sau : so sánh hai xâu S1 và S2 , tìm tất cả các kí tự có trong cả hai xâu trên . Xâu Kq sẽ chứa tất cả các kí tự đó , mỗi kí tự chỉ được nhớ một lần .
Uses Crt;
Var xau1,xau2,xau: string;
(*==================================*)
Procedure compare(s1, s2: string; Var kq: string);
Var i: byte;
(*===============================*)
Function kt(ch: char; st: string): boolean;
(* Kiểm tra xem kí tự Ch có trong xâu St không . Nếu có thì
hàm trả về giá trị True . Nếu không thì hàm trả về giá trị False *)
Begin
kt:=pos(ch,st)<>0;
End;
(*================================*)
Begin (* Thân của thủ tục Compare*)
kq:=''; (* Xâu rỗng *)
For i:=1 to length(s1) do
If (not kt(s1[i],kq)) and (kt(s1[i],s2)) then
kq:=concat(kq,s1[i]);
End;
(*==============================*)
BEGIN
Clrscr;
Writeln('Nhap 2 xau S1 va S2 :');
Write('S1: '); Readln(xau1);
Write('S2: '); Readln(xau2);
Compare(xau1, xau2, xau);
If xau<>'' then Writeln('Xau chung la: ',xau)
Else Writeln('Khong co ki tu nao trong ca hai xau ');
Write('Nhan ENTER de ket thuc...');
Readln;
END .
Bài 8 :
Viết hàm tính D (St1 , St2) , với U, V là hai xâu kí tự bất kì , là tổng số các kí tự không giống nhau trong hai xâu trên , mỗi loại kí tự chỉ được nhớ một lần . Ví dụ D (‘aabba’ , ‘bcdd’) = 2 vì chỉ có hai kí tự a và d là không giống nhau trong các xâu trên .
Uses Crt;
Const M=100;
Var S: array[1..M] of string;
max, min, i, j, n: byte;
(*===============================*)
Function D(U,V: string): byte;
(*Trả về tổng số loại kí tự không giống nhau
trong 2 xâu U và V *)
Var k, id: byte;
s, luu: string;
Begin
luu:=''; (* Xâu rỗng *)
For id:=1 to length(U) do
If (pos(U[id],V)=0) and (pos(U[id],luu)=0) then
luu:=concat(luu,U[id]);
For id:=1 to length(V) do
If(pos(V[id],U) = 0) and (pos(V[id],luu)=0) then
luu:= concat(luu,V[id]);
d:=length(luu);
End;
(*=================================*)
Procedure nhap;
Begin
Repeat
Write('So xau ki tu (>=2):') ; Readln(n);
If n<2 then
Writeln(#7,'Co ',n,' xau ki tu nen khong the '
+ 'so sanh duoc');
Until n>=2;
Writeln('Nhap ',n,' xau ki tu :');
For i:=1 to n do
Begin
Write('S',i,'='); Readln(S[i]);
End;
End ;
(*===============================*)
BEGIN (* Chương trình chính *)
Clrscr;
nhap;
max:=0;
min:=255;
For i:=1 to n-1 do
For j:=i+1 to n do
Begin
If max<d(S[i],S[j]) then max:=d(S[i],S[j]);
If min>d(S[i],S[j]) then min:=d(S[i],S[j]);
End;
Write('Max(d(Si,Sj)=',max,' Min(d(Si,Sj)=',min);
Readln;
END .
Bài 9 :
Viết chương trình hoàn chỉnh thực hiện các công việc của thực đơn sau :
1. 1. Nhập dữ liệu ( nhập số tự nhiên n ) .
2. 2. Phân tích ra thừa số nguyên tố ( phân tích n thành tích các số nguyên tố ) .
3. 3. Thoát khỏi chương trình .
Uses Crt;
Type uoc_nguyen_to=array[1..50] of longint;
Var
u, N: longint;
i, dem: integer;
a: uoc_nguyen_to;
(*================================*)
Procedure nhap(Var NN:longint);
Begin
Repeat
Write('Nhap N='); Readln(NN);
Until NN>=0;
End;
(*=================================*)
Procedure viet;
Begin
If dem=0 then
Writeln('So ',N,' khong the phan tich thanh '
+ 'tich cua cac so nguyen to')
Else
If dem=1 then Writeln(N, '=', a[dem])
Else
Begin
Write(N,'=');
For i:=1 to dem-1 do Write(a[i],'*');
Writeln(a[dem]);
End;
End;
(*================================*)
Procedure phantich(N1:longint);
Begin
If N1>1 then
Begin
u:=2;
dem:=0;
Repeat
If (N1 mod u=0) then
Begin
inc(dem);
a[dem]:=u;
N1:=N1 div u;
End
Else inc(u);
Until N1=1;
End
Else dem:=0;
Viet;
End;
(*==============================*)
BEGIN (* Main Program *)
Clrscr;
Writeln('Phan tich so N thanh tich cua cac so nguyen to :');
nhap(N);
phantich(N);
Write('Nhan Enter de ket thuc ...');
Readln;
END .

vanhongha

Tổng số bài gửi: 6
Join date: 19/02/2010

Xem lý lịch thành viên

Về Đầu Trang Go down

trả lời chủ đề

Bài gửi  banhbotmi on 2010-04-11, 00:12

hay lắm, cảm ơn bạn nhìu nha Wink


______________
nhac dj hay | nhac san hay | nhac san cuc manh | phim online | xem phim online | phim bay rong

banhbotmi

Tổng số bài gửi: 2
Join date: 10/04/2010

Xem lý lịch thành viên

Về Đầu Trang Go down

Xem chủ đề cũ hơn Xem chủ đề mới hơn Về Đầu Trang

- Similar topics

Permissions in this forum:
Bạn không có quyền trả lời bài viết