Một số bài tập Pascal cơ bản có lời giải

Một số bài tập Pascal cơ bản có lời giải ! I. Bài Tập Tính Toán Cơ Bản 1. Giải PT bậc 1 (ax+b=0) PROGRAM NCK;         VAR A,B:REAL;         BEGIN         WRITELN('NHAP A, B: ');         READLN(A,B);         IF (A=0) AND (B<=0) THEN WRITELN('VO NGHIEM');         IF (A=0) AND (B>0) THEN WRITELN('X THUO^.C R');         IF A<0 THEN WRITELN('NGHIEM: X<',-B/A:0:2);         IF A>0 THEN WRITELN('NGHIEM: X>',-B/A:0:2);         READLN;         END.   2.ĐỔI SỐ THÀNH CHỮ (VD: A --> TWO) PROGRAM NCK;         VAR N:BYTE;         BEGIN         WRITELN('NHAP N: ');         READLN(N);         IF N=1 THEN WRITE('1 = ONE');         IF N=2 THEN WRITE('2 = TWO');         IF N=3 THEN WRITE('3 = THREE');         IF N=4 THEN WRITE('4 = FOUR');         IF N=5 THEN WRITE('5 = FIVE');         READLN;         END.   Bài 3: Giải hệ phương trình bậc 1 - 2 ẩn số PROGRAM NCK;         VAR A1, B1, C1, A2, B2, C2:INTEGER;         DX, DY ,DD : REAL;         BEGIN         WRITELN('NHAP HE SO A1, B1, C1: ');         READLN(A1, B1, C1);         WRITELN('NHAP HE SO A2, B2, C2: ');         READLN(A2, B2, C2);         DD := A1*B2-A2*B1;         DX := C1*B2-C2*B1;         DY := A1*C2-A2*C1;         IF DD = 0 THEN         IF (DX=0) AND (DY=0 ) THEN         WRITE('HPT VSN')         ELSE WRITE('HPT VN')         ELSE         BEGIN         WRITELN('HPT CO NGHIEM: ');         WRITELN('X = ', DX/DD:2:2);         WRITELN('Y = ', DY/DD:2:2);         END;         READLN;         END.   Bài 4: Nhập tọa độ 3 điểm và xét tan giác PROGRAM NCK;         VAR XA, YA, XB, YB, XC, YC, AB, BC, AC, S, P: REAL;         BEGIN         WRITELN('NHAP TOA DO DIEM A(XA,YA): ');         READLN(XA,YA);         WRITELN('NHAP TOA DO DIEM B(XB,YB): ');         READLN(XB,YB);         WRITELN('NHAP TOA DO DIEM C(XC,YC): ');         READLN(XC,YC);         AB:=SQRT(SQR(XB-XA)+SQR(YB-YA));         BC:=SQRT(SQR(XC-XB)+SQR(YC-YB));         AC:=SQRT(SQR(XC-XA)+SQR(YC-YA));         IF (AB=0) OR (BC=0) OR (AC=0) OR (AB+AC=BC) OR (AB+BC=AC) OR (AC+BC=AB)          THEN         WRITELN('KHONG PHAI LA 3 DINH CUA TAM GIAC')         ELSE         BEGIN         WRITELN('LA 3 DINH CUA TAM GIAC');         IF (AB=BC) AND (AB=AC) THEN WRITELN('LA TAM GIAC DEU');         IF (AB=BC) OR (AB=AC) OR (BC=AC) THEN WRITELN('LA TAM GIAC CAN');         IF (SQR(AB)+SQR(AC)=SQR(BC)) OR (SQR(AB)+SQR(BC)=SQR(AC)) OR          (SQR(BC)+SQR(AC)=SQR(AB)) THEN         WRITELN('LA TAM GIAC VUONG');         P:=(AB+AC+BC)/2;         S:=SQRT(P*(P-AB)*(P-AC)*(P-BC));         WRITELN('DIEN TICH CUA TAM GIAC LA:',S:0:2);         END;         READLN;         END.   Bài 5: Bài toán Gà - Chó PROGRAM NCK;         VAR G,C:REAL;         BEGIN         X+Y=36;         2X+4Y=100;         G:=0;         C:=0;         WHILE G<36 DO         BEGIN         C:=36-G;         IF 2*G+4*C=100 THEN WRITELN('SO GA LA: ',G,' SO CHO LA: ',C);         G:=G+1;         END;         READLN;         END.   Bài 6: Giải Phương Trình Bậc 2 Ax.x + bx + c =0 PROGRAM G_PTB2; {AX*X+BX+C=0}         USES CRT;         VAR A, B, C: INTEGER;         D, X1, X2: REAL;         BEGIN         CLRSCR;         WRITELN('** GIAI PHUONG TRINH BAC 2 **');         WRITELN('NHAP HE SO A, B, C: ');         READLN(A, B, C);         D:=SQR(B)-4*A*C;         IF D=0 THEN         WRITE('PT CO NGHIEM KEP X = ',-B/2*A:2:2)         ELSE         IF D>0 THEN         BEGIN         X1:=(-B+SQRT(D))/(2*A);         X2:=(-B-SQRT(D))/(2*A);         WRITELN('PT CO 2 NGHIEM: ');         WRITELN('X1 = ', X1:2:2);         WRITELN('X2 = ', X2:2:2);         END         ELSE WRITE('PT VN');         READLN;         END.   Bài 7: Nhập mảng gồm n phần tử. Tìm số lớn nhất và số nhỏ nhất trong mảng PROGRAM          NCK; {MS: 639}          USES CRT;          VAR A:          ARRAY[1..100] OF INTEGER;              I, N,          LN, NN: INTEGER;          BEGIN            CLRSCR;                     WRITELN('** CHUONG TRINH NCK **');                     WRITE('NHAP N PHAN TU: ');                     READLN(N);            FOR I:=1          TO N DO                BEGIN                           WRITE('A[',I,']=');                           READLN(A[I]);                END;            LN:=A[1];          NN:=A[1];            FOR I:=1          TO N DO              BEGIN                IF          A[I]>LN THEN LN:=A[I];                IF          A[I]             END;                     WRITELN('MAX: ', LN, '  MIN: ',NN);            READLN          END.   II. Phần chuyên sâu khó hơn tí 1. Giải bài toán FIBONACI - Khử đệ quy (không dùng đệ quy) program fibonaci; uses crt; var a:array [1..100] of integer;     n,i,m,d,s:integer; procedure fibonaci; begin      if n=1 then a[1]:=1         else begin                i:=2;s:=1;a[1]:=1;                repeat                      a[i]:=s;                      i:=i+1;                      s:=a[i-1]+a[i-2];                until i>n;           end;       write(' Day so fibonaci la:');       for i:=1 to n do           write(' ',a[i]);       writeln; end; begin      clrscr;      write(' Nhap so de tinh day fibonaci:');readln(n);      write(' Nhap so de kiem tra xem co trong day fibonaci khong:');readln(m);      fibonaci;      d:=0;      for i:=1 to n do          if a[i]=m then d:=d+1;      if d=1 then writeln(' So de kiem tra co mat trong day fibonaci')      else writeln(' So kiem tra khong co mat trong day fibonaci');      readln; end.   2. Số Hoàn Hảo: là số có tổng các ước của nó (trừ nó) bằng chính nó Ví dụ : 6 = 1 + 2 + 3 Nội dung : -viết chương trình kiểm tra xem 1 số có là số hoàn hảo không -liệt kê tất cả số hoàn hảo từ 1..2000 và đếm xem có bao nhiu số program hoanhao; uses crt; var n,i,d,k,j:integer; procedure hoanhao; begin d:=0; for i:=1 to n-1 do if n mod i=0 then d:=d+i; if d=n then writeln(' So vua nhap la so hoan hao') else writeln(' So vua nhap khong la so hoan hao'); end; procedure vietlen; begin write(' Day so hoan hao tu 1-->2000:'); k:=0; for i:=1 to 2000 do begin d:=0; for j:=1 to i-1 do if i mod j=0 then d:=d+j; if d=i then begin   write(' ',i);   k:=k+1;   end; end; writeln;   writeln(' Trong day 1-->2000 co ',k,' so hoan hao'); end; begin clrscr; write(' Nhap n=');readln(n); hoanhao; vietlen; readln; end.   3. Tổng hợp - Nhập vào 1 số nguyên gồm 4 chữ số -Kiểm tra tình chắn lể     -kiểm tra xem có phải là số nguyên tố không     -kiểm tra xem có phải là số chính phương không program chuong_trinh; uses crt; var i,n,k,d:integer;     ok:boolean; function chanle(n:integer):boolean; begin      ok:=true;      if n mod 20 then ok:=false;      chanle:=ok; end; function nguyento(n:integer):boolean; begin      ok:=true;      d:=0;      for i:=1 to n-1 do          if n mod i=0 then d:=d+1;      if d1 then ok:=false;      nguyento:=ok; end; function chinhphuong(n:integer):boolean; begin      ok:=true;      k:=trunc(sqrt(n));      if sqr(k)n then ok:=false;      chinhphuong:=ok; end; begin      clrscr;      write(' Nhap n=');readln(n);      if chanle(n) then writeln(' So vua nhap la chan')      else writeln(' So vua nhap la so le');      if nguyento(n) then writeln(' So vua nhap la nguyen to')      else writeln(' So vua nhap khong phai la so nguyen to');      if chinhphuong(n) then writeln(' So vua nhap la so chinh phuong')      else writeln(' So vua nhap khong la so chinh phuong');      readln; end.   4. Viết chương trình thược hiện các việc sau a) Tạo 2 file F1 F2 là những file text để ghi dữ liệu từ bàn phím     b) Nối file F2 vào cuối File F1 và tính độ dài File F1     c) Đưa nội dung File F1 ra màn hình và đếm xem trong file này có bao nhiêu từ 'May mắn' program hahuy; uses crt; const input='input.txt';       output='output.txt'; var f1,f2: text;     st1,st2,key:string;     dem,vt: integer; begin clrscr;   assign(f1,input);  rewrite(f1);   assign(f2,output);  rewrite(f2);   writeln('nhap xau 1'); readln(st1); write(f1,st1); close(f1);   writeln('nhap xau 2'); readln(st2); write(f2,st2); close(f2); st1:=st1 + st2; writeln('do dai xau s1 = ',length(st1) ); writeln(st1); dem:=0; key:='may man'; vt:=pos(key,st1); while vt0 do    begin delete(st1,vt,length(key)); dem:=dem+1; vt:=pos(key,st1);    end;   writeln('tu khoa ',key,' xuat hien ',dem,' lan');   write(' HAHUY_NO1VN  ');    readln; end.   5. Tính Giai Thừa Program giaithua; uses crt; var a: integerl=; Function gt(n:byte):Longint;   Var   s:Longint;   i:byte; Begin   s:=1   For i:=2 to n do     s:=s*i;   gt:=s; End; Begin      clrscr;      write ('Nhap so can tinh giai thua: ');readln(a);      if a:=0 or a:=1 then          writeln('Giai thua cua ',a,' = 1')      else          writeln('Giai thua cua',a ,' =', giaithua(a) ); End.   Bài 6  - Nhập vào 1 mảng gồm n số nguyên (2<n program Mang; uses crt; var  a:array [ 1..20] of byte;       i,n,d,j,k:integer; procedure nhap; begin         for i:=1 to n do               begin                      write(' a[',i,']=');readln(a[i]);               end; end; procedure nguyento; begin               write(' Day so cac so nguyen to:');         k:=0;         for i:=1 to n do              begin                                 d:=0;                   for j:=1 to a[i]-1 do                        if a[i] mod j=0 then                               d:=d+1;                        if d=1 then                              begin                                                                   write(' ',a[i]);                                   k:=k+1;                                                        end;               end;         if k=0 then                  write(' khong co so nao')         else                 begin                                         writeln;                          writeln(' Trong day co ',k,' so nguyen to');                 end; end; begin        clrscr;        repeat                          write(' Nhap n=');readln(n);         until (2<n)and(n<20);               nhap;         nguyento;    readln; end.  </n)and(n<20);       Bài 7 Nhập vào 1 mảng gồm n số nguyên (2<n<20) -tìm số lớn nhất và vị trí của nó     -sắp xếp mảng t[COLOR=rgb(0, 0, 0)]ăng dần theo giá trị     -hiển thị mảng vừa sắp xếp program mang2; uses crt; var    a:array [1..20] of integer;             b:array [1..20] of integer;             i,n,max,j,tg:integer; procedure nhap; begin             for i:=1 to n do                   begin                             write(' a[',i,']=');readln(a[i]);                   end; end; procedure timmax; begin            max:=a[1];            for i:=2 to n do                   if a[i]>max then           max:=a[i];             j:=1;                  for i:=1 to n do                        if a[i]=max then                 begin                                                      b[j]:=i;                                                      j:=j+1;                                            end;                  write(' So lon nhat trong day la ',max,' o vi tri thu');                 for i:=1 to j-1 do                             write(', ',b[i]);                         writeln; end; procedure tang; begin       for i:=1 to n-1 do                 for j:=i+1 to n do                           if a[i]>a[j] then                     begin                                                             tg:=a[i];                                                             a[i]:=a[j];                                                             a[j]:=tg;                                                     end;                 write(' Day duoc sap xep lai la:');                   for i:=1 to n do                           write(' ',a[i]); end; begin          clrscr;       repeat                 write(' Nhap n=');readln(n);       until (2<n)and(n<20);            nhap;            timmax;            tang;            readln; end.   </n)and(n<20);       chú ý các bạn có thể xem và tự gõ nếu khó thì copy và paste vào 1 file notepad và save lại với đuôi  .PAS cho vào thư mục Bin của pascal mở pascal chọn File=>open file vừa lưu để chạy</n<20) </n