Powered By Blogger

Thứ Sáu, 20 tháng 7, 2012

BÀI TẬP PASCAL


1.NHẬP MẢNG VÀ XUẤT MẢNG N PHẦN T
program p ;
uses crt;
var a:array[1..100] of real;
     n,i:integer;
begin
 clrscr;
 write('nhap n='); readln(n);
 write('nhap cac phan tu cua mang,moi phan tu tren mot dong');
 for i:=1 to n do
   begin
    write('a[',i:2,']=') ;

    readln(a[i]);
    end;
    for i:=1 to n do writeln('a[',i:2,']=',a[i]:0:2);
     readln;
end.

2.LẬP MẢNG B TỪ MẢNG A BẰNG CÁCH ĐỔI CHỔ 2 PHẦN TỬ


program p100207;{lap mang b tu mang a bang cach doi cho hai phan tu }
uses crt;
var a,b:array[1..100] of real;
    n,p,q,i:integer;
begin
 write('nhap kich thuot cua mang a :n=');
 readln(n);
 writeln('nhap cac phan tu cua mang tren mot dong:');
 for i:=1 to n do read(a[i]);   readln;
 write('nhap hai vi tri p,q<=n:');
 readln(p,q);
 for i:= 1 to n do b[i]:=a[i];
                   b[p]:=a[q];
                   b[q]:=a[p];
 writeln('mang b lap ra tu mang a bang cach doi hai phan tu thu',p,'va thu',q,':');
 for i:=1 to n do write(b[i]:7:1);
 readln
 end.

3.TÌM UCLN
program p100117;{tim uscln cua hai so nhap tu ban phim}
uses crt;
var m,n:integer;
function us(a,b:integer):integer;
begin
while a<>b do
   if a>b then a:=a-b else if b>a then b:=b-a;
   us:=a;
end;
begin
clrscr;
write('nhap hai so nguyen duong m,n:');
readln(m,n);
write(us(m,n));
readln;
end.

3.LẬP MẢNG B TỪ MẢNG A BẰNNG CÁCH LOẠI BỎ PHẦN TỬ MẢNG A

program p100205;{lap mang b tu mang a bang cach loai bo phan tu mang a}
uses crt;
var a,b:array [1..100] of real;
   n,p,i:integer;
begin
write('nhap kich thuot cua mang a: n=');   readln(n);
writeln('nhap cac phan tu cua nang a tren mot dong:');
for i:=1 to n do read(a[i]);readln;
write('nhap so p<=n:');readln(p);
if i<P then b[i]:=a[i] else b[i]:=a[i+1];
write('mang b lap tu mang a bang cach loai bo phan tu mang thu',p,':');
for i:=1 to n-1 do write(b[i]:8:2);readln;
end.

4.LẬP MẢNG B TỪ MẢNG A BẰNG CÁCH CHÈN THÊM MỘT SỐ A

program p100206;{lap mang b tu mang a bang cach chen them mot so a}
uses crt;
var a,b:array[1..100] of real;
    n,i,p:integer;
    ap:real;
begin
write('nhap kich thuot mang a:n=');readln(n);
writeln('nhap cac phan tu mang a tren mot dong:');
for i:=1 to n  do read(a[i]);readln;
write('nhap so a:');readln(ap);
write('nhap  so p<=n:'); readln(p);
for i:=1 to n+1 do
    if i<p then b[i]:=a[i]
                else if i>p then b[i]:=a[i-1] else b[i]:=ap;
writeln('mang b lap tu mang a bang cach chen a vao vi tri ',p,':');
for i:=1 to n do write(b[i]:8:2);
readln;
end.
4.IN RA BẢNG CỬU CHƯƠNG
program  bang_cuu_chuong;
uses     crt;
var      i, j: byte;
begin
clrscr;
 write('      BANG CUU CHUONG     ');
 for i:=1 to 10 do
 for j:=1 to 10 do
 write(i, '* ' ,  j   ,'  =   ',  i  *  j);
 readln
end.

5.KIỂM TRA TAM GIÁC VUÔNG 

PROGRAM PITAGO;
USES CRT;
VAR A, B, C : INTEGER;
    A2, B2, C2 : LONGINT;
BEGIN
CLRSCR;
WRITE('A, B, C  ');
READLN(A, B, C);
A2:=A;
B2:=B ;
 C2:=C;
 A2:= A2*A;
 B2:= B2*B ;
 C2 :=C2*C;
IF (A2= B2+ C2) OR (B2=A2+C2) OR (C2=A2+B2) THEN WRITELN (' BA SO DA NHAP LA BO BA SO PITAGO')
ELSE WRITELN(' BA SO DA NHAP KHONG PHAI LA BO BA SO PITAGO');
READLN
END.


 6.DANH SÁCH MÓC NỐI KIỂU CON TRỎ(đếm nút và xắp xếp)

type listlink = ^contro  ;
      contro = record
       info:integer  ;
       link:listlink;
       end;
 var a:array[1..100] of integer;
function   demnut(l:listlink):word;
 var p:listlink;  dem:word;
   begin
     p:=l;
     dem:=0;
     while p<>nil do
     begin
           dem:=dem+1;
           p:=p^.link;
    end;
  end;
procedure sapxep(l:listlink);
var  i,j,t :listlink;
begin
   if l<>nil then
     i:=l;
      while (i^.link <> nil) do
            begin
             j:=i^.link;
               while j<>nil do
                  begin
                   if  i^.info > j^.info then
                   begin
                   t:=i^.info ;
                   i^.info:=j^.info;
                   i^.info:=t;
                   end
                   ;j:=j^.link;
                   end;
              i^.link;
              end;
           end;
begin
 writeln('nhap so phan tu cua mang n:=');
 readln(n);
 dnut(l);
 sapxep(l);
end.

7.giải phương trình bậc hai

program Giai_PTB2;
uses crt;
var a, b, c : real;
    d, x1, x2 : real;
begin
clrscr;
writeln(' a, b, c=');
readln(a, b, c);
d:= b*b-4*a*c;
if d<0 then write (' phuong trinh vo nghiem')
   else
   begin
   x1:=(-b-sqrt(d))/(2*a);
   x2:=(-b+sqrt(d))/(2*a);
   writeln(' x1 =', x1:8:3,      'x2 =',x2:8:3);
   end;
   readln
end.

8.bài tập hoán vị

var try:integer;
const max=100;
var a:array[0..100] of integer;
 n:integer;
 procedure try(n:integer):integer;
 var i,j,tg:integer;
      kt:boolean;
 begin
 kt:=true;
   for i:=1 to n do
        begin
         a[i]:=i;
         write(a[i],' ');
         end;
         writeln;
         while kt do
         begin
         kt:=false;
         for i:=1 to n do
           if a[i]<a[i+1] then kt:=true;
           if kt then
           begin
           i:=n-1;
           while (a[j]<a[i])and(j>=1) do
           begin
              dec(i);
              j:=n ;
              end;
              while (a[j]<a[i])and(j<=1)do
              begin
               dec(j);
               tg:=a[i];
               a[i]:=a[j];
               a[j]:=tg;
               inc(i);
               j:=n;
               end;
               while i<j do
                 begin
               tg:=a[i];
               a[i]:=a[j];
               a[j]:=tg ;
               i:=i+1;
               j:=j-1;
               end;
               for i:=1 to n do
                 write(a[i],'');
                 writeln;
                 end;
                 end;
                 end;
                 begin
                writeln('hoan vi cua so:=',try);
                readln  ;
                 end.

9.in ngược xâu

var s,s1:string;
procedure innguoc(s:string);
Begin
if(length(s)>0) then
   begin
     write(copy(s,length(s),1));
     delete(s,length(s),1);
     innguoc(s);
   end;
End;
Begin
write('Nhap xau: ');readln(s);
innguoc(s);
readln;
End.

10.tính n^x

VAR N,X:INTEGER;
  FUNCTION   F(N,X:INTEGER):INTEGER;
  BEGIN
     IF X=1 THEN F:=N
      ELSE
        F:=(F(N,X-1)) * N
   END;
 BEGIN

        WRITELN('NHAP N:= ');READLN(N);
        WRITELN('NHAP X = ');READLN(X);
        WRITELN(' KET QUA LA:',F(N,X));
        READLN;
  END.

11.dựng cây nhị phân ,duyệt cây,đếm nút lá,cây nhị phân giảm dần

program cau_1;
uses crt;
type Btree=^cell;
     cell=record
            data:integer;
            left,right:btree;
     end;

var T, p1, p2, p3, p4, p5, p6, p7, p8, p9, p10, p11, p12: BTree;

procedure DungCayNhiPhan(L, R: BTree;x: Integer;var T:Btree);
var p: Btree;
Begin
       new(p);
       p^.data:=x;
       p^.right:=R;
       p^.left:=L;
       T:=p;
End;
Procedure DuyetCay(T: BTree);
Begin
     if T <> nil then
     Begin
          Duyetcay(T^.Left);
          write(T^.Data, ' ');
          Duyetcay(T^.Right);
    End;
End;
Function nutla(T:Btree):word;
Begin
         if T=nil then nutla:=0
         else if (T^.right = nil) and (T^.left = nil) then
                 nutla:= 1
              else
                nutla:= nutla(T^.left) + nutla(T^.right) +1;
end;
procedure TranverInOrder(T:Btree);
begin
     if T <> nil then
     begin
          TranverInOrder(T^.right);
          write(T^.Data,' ');
          TranverInOrder(T^.left);
     end;
end;

    {Chuong trinh chinh}
BEGIN
     clrscr;
     dungcayNhiPhan(nil, nil, 10, p1);
     dungcayNhiPhan(nil, nil, 24, p2);
     dungcayNhiPhan(nil, nil, 30, p3);
     dungcayNhiPhan(nil, nil, 50, p4);
     dungcayNhiPhan(nil, nil, 60, p5);
     dungcayNhiPhan(nil, nil, 70, p6);
     dungcayNhiPhan(p1, p2, 20, p7);
     dungcayNhiPhan(p3, nil, 40, p8);
     dungcayNhiPhan(p4, p5, 55, p9);
     dungcayNhiPhan(p6, nil, 75, p10);
     dungcayNhiPhan(p7, p8, 25, p11);
     dungcayNhiPhan(p9, p10, 65, p12);
     dungcayNhiPhan(p11, p12, 45, T);
     writeln;
     write('Cay can dung la: ');
     Duyetcay(T);
     writeln;
     writeln;
     writeln('So nut tren cay la: ',CountNode(t));
     writeln;
     write('cay theo thu tu giam dan la: ');
     TranverInOrder(T);
     writeln;
     readln;
End.

 12.tìm ước chung lớn nhất

program timucln;
var a, b :integer;
function ucln(a,b:integer):integer;
var r :word ;
  begin
    r:=a mod b;
    while r <> 0 do
               begin
                   a:=b;
                   b:=r ;
                   r:=a mod b;
              end;
    ucln:=b;
   end;
begin
  writeln('nhap a,b= ');
  readln(a,b);
  writeln('uoc chung lon nhat la :=',ucln(a,b));
  readln;
 end.

13.tính tổng

var n:integer;
 function tong(n:integer):integer;
 begin
  if n=1 then tong:=1
  else
    tong:=tong(n-1)+2*n;
 end;
begin
 writeln('nhap :=',) ;readln(n);
 writeln('tong tren la :',tong(n));
 readln;
 end.

13.sau bao nhiêu năm thì tuổi cha gấp đôi tuổi con

program tuoi;
uses crt;
var tcha, tcon, dem :integer;
begin
clrscr;
write('hay nhap tuoi cha va tuoi con  vao:=   ');
readln(tcha, tcon);
dem:=1;
while (tcha div tcon) <> 2  do
   begin
    dem:=dem+1;
    tcha:= tcha+dem;
    tcon:=tcon+dem;
   end;
writeln('sau ',dem, ' nam thi tuoi cha gap doi tuoi con');
readln
end.













Không có nhận xét nào:

Đăng nhận xét