bài tạp cấu trúc vòng lặp

I CẤU TRÚC VÒNG LẶP Viết chương trình nhập vào số nguyên in hình tất ước số số Giải: Uses Crt; Var N,i : Integer; Begin Clrscr; Write('Nhap so nguyen N= '); Readln(N); For i:=1 To N Do If N MOD i=0 Then Write(i:5); Readln; End Viết chương trình vẽ tam giác cân dấu (*) Giải: uses crt; var n,i,j:longint; begin write('Chieu cao = '); readln(n); clrscr; for i:=1 to n begin if i n then for j:=1 to n*2-1 if (j = n-i+1) OR (j = n+i-1) then write('*') else write(' ') else for j:=1 to n*2-1 write('*'); writeln; end; readln; end Viết chương trình tính tổng nghịch đảo N số nguyên theo công thức S = + 1/2 + 1/3 + … + 1/N GIAÛI Uses Crt ; Var i , n : Integer ; tong: Real ; BEGIN Clrscr ; Write (' Cho so tu nhien n : ') ; Readln (n) ; tong :=0 ; i :=1 ; While i THEN write ('*'); UNTIL n = 1; readln; END Viết chương trình tính số hạng thứ n dãy Fibonaci Dãy Fibonaci dãy số gồm số hạng p(n) với p(n) = p(n-1) + p(n-2) với n>2 p(1) = p(2) = Giải: uses crt; var i,n,f1,f2: integer; begin clrscr; write('Nhap n: '); readln(n); f1:=1; f2:=1; for i:=1 to n begin write(f1,' '); f2:=f2+f1; f1:=f2-f1; end; readln; end Viết chương trình tính Xn với n nhập vào từ bàn phím GIAÛI Uses Crt ; Var i , n : Integer ; a , giatri : Real ; BEGIN Clrscr ; Write (' Cho so a : ') ; Readln(a) ; Write (' Cho so mu n : ') ; Readln(n) ; i := ; giatri := ; While i THEN write ('*'); UNTIL n = 1; readln; END 11 Viết chương trình giải phương trình bậc aX2 + bX + C = Sử dụng câu lệnh lặp Repeat…Until để bắt buộc nhập hệ số a0 Giải: PROGRAM ptb2; USES crt; VAR a,b,c,x1,x2,d:REAL; BEGIN clrscr; REPEAT write('Nhap cac he so a, b, c: '); readln(a,b,c); UNTIL a0; d:=sqr(b)-4*a*c; IF dbb Then aa:=aa-bb Else bb:=bb-aa; End; Writeln('USCLN= ',aa); Writeln('BSCNN= ',a*b DIV aa); Readln; End 14 Viết chương trình giải toán cổ sau a) Trăm trâu, trăm cỏ Trâu đứng ăn năm Trâu nằm ăn ba Ba trâu già ăn Hỏi loại trâu có con? Giải: Program tramtrautramco; uses crt; var x, y, z: integer ; begin clrscr ; writeln('Bai toan tram trau tram co') ; for x:=1 to 20 for y:= 1to 33 Begin z:=100-x-y; If ((5*x + 3*y + z/3) = 100) then writeln('Trau dung: ', x:3 ,' trau nam: ', y:3 ,' trau gia: ', z:3) ; End ; Readln End b) Vừa gà vừa chó 36 Bó lại cho tròn 100 chân chẵn Hỏi có gà, chó Giải: uses crt; var g,c: integer; begin clrscr; for c:=1 to 25 begin g:=36-c; if 4*c+2*g=100 then write('So ga: ',g,' So cho: ',c); end; readln; end 15 Viết chương trình nhập vào số N, tìm số nguyên tố từ đến N Giải: Uses crt; var i,dem,j,n:Integer; Begin Clrscr; write('Nhap so nguyen n');ReadLn(n); if n>0 Then begin WriteLn('Cac so nguyen to tu den ',n,' la:'); for j:=2 to n Do begin dem:=0; for i:= to j if j mod i=0 then dem:=dem+1; if dem=2 then write(j,' '); end; end; Readln End II CHƯƠNG TRÌNH CON Viết hàm tính tổng số chẵn từ M đến N uses crt; var i,n,s:integer; begin clrscr; writeln(' Nhap n : ' );Readln(n); S:=0; For i:=1 to n begin if (i mod 2) = then s:=s+i; end; Writeln('Tong S: ,S’);readln; END Viết chương trình tìm USCLN số x y var x,y,UCLN,BCNN:integer; begin readln(x,y); BCNN:=x*y; While xy If x>y then x:=x-y else y:=y-x; UCLN:=x; BCNN:=BCNN div UCLN; write(UCLN,' ',BCNN); end Tạo dãy số Fibonaci Dãy số Fibonaci dãy số gồm số hạng p(n) với p(n) = p(n-1) + p(n-2) với n>2 p(1) = p(2) = Ví dụ 1 13 21… Hãy lập chương trình đệ quy để tạo dãy số Đảo chữ số Viết chương trình đảo chữ số số Yêu cầu sử dụng chương trình đệ quy VD đảo số: Đọc vào số: 12345 Đảo số in ra: 54321 uses crt; var m,n:longint;tong,dem:byte; BEGIN clrscr; write('Nhap so n: ');readln(n); m:=n;dem:=0;tong:=0; while m>0 begin tong:=tong+ m mod 10; dem:=dem+1; m:=m div 10; end; writeln(n,' co ',dem,' chu so va tong cac chu so cua ',n,' la: ',tong); write('So dao nguoc cua ',n,' la: '); m:=n; while m>0 begin write(m mod 10); m:=m div 10; end; readln END Viết Function tính an với a: real, n nguyên dương theo cách - Tính trực tiếp, không đệ quy - Theo thuật toán đệ quy Program Fibonacci; Uses CRT; Var n,i:shortint; F:real; CH:char; Label 1; Procedure FB(n:shortint); Var a,b:Real; Begin If (n=1) or (n=2) Then F:=1 Else Begin FB(n-1); a:=F; FB(n-2); b:=F; F:=a+b; End; End; Begin 1: ClrScr; Write(‘N = ‘);Readln(n); If n>40 Then Begin Writeln(‘n phai nho hon hoac bang 40′); Writeln; GOTO 1; End; Writeln; For i:=1 to n Do Begin FB(i); Write(F:0:0,’ ‘); End; Writeln;Writeln; Write(‘Ban co muon tinh lai ko? (Y/N)’);CH:= ReadKey; Writeln;Writeln; If (CH=’Y') or (CH=’y') Then GOTO 1; End Viết hàm tìm Max số thực x,y,z Function Max(x,y: Real) : Real; Begin If X >y then Max := x else Max := y; End; Còn chương trình hoàn chỉnh: Program Tim_So_Lon; Var a, b : Real; Function Max(x,y: Real) : Real; Begin If x >y then Max := x else Max := y; End; Begin Write('Nhap vao so thuc : '); Readln(a,b); Write('So lon nhat la : ',Max(a,b):6:4); Readln End Program Tim_max; var a,b,c,max : integer; Begin writeln('Tim MAX cua so a,b,c'); write('Nhap so a :');readln(a); write('Nhap so b :');readln(b); write('Nhap so c :');readln(c); max:= a; 10 While POSNUM(St)0 Do Delete(St,POSNUM(St),1); Write(‘Xau sau xoa: ‘,St); Readln; End Bài tập 11: Viết chương trình để mã hoá giải mã xâu ký tự cách đảo ngược bit ký tự xâu Uses crt; Var st:string; {Hàm đảo bit ký tự c} Function DaoBit(c:char):char; Var n,i,s,bitcuoi,Mask:byte; Begin {Đổi ký tự sang số} n:=ORD(c); {s: kết đảo bit, Mask: mặt nạ dùng để bật bit thứ i} s:=0; Mask:=128; For i:=1 To Do {duyệt qua bit n} Begin {Lấy bit cuối n: bit cực phải} bitcuoi:=n AND 1; n:=n shr 1; {loại bỏ bit cuối cùng: n:=n DIV 2} {Bật bit thứ i lên: từ trái sang phải} if bitcuoi=1 then s:=s OR Mask; Mask:=Mask shr 1; { Mask:= Mask DIV 2} End; DaoBit:=CHR(s); End; Function MaHoa(st:string):string; Var i:Byte; Begin {Đảo bit ký tự xâu st} For i:=1 To Length(st) Do st[i]:=DaoBit(st[i]); Mahoa:=st; End; Begin Write('Nhap xau: '); Readln(st); st:=MaHoa(st); Writeln('Xau sau ma hoa: ',st); Readln; 28 st:=MaHoa(st); Writeln('Xau sau giai ma: ',st); Readln; End Bài tập 12: Viết chương trình thực phép cộng số tự nhiên lớn (không 255 chữ số) Uses crt; Var so1,so2,kqua:string; Procedure LamDayXau(Var st1,st2:string); {Them so vao truoc xau ngan} var i:Byte; Begin If Length(st1)>Length(st2) Then For i:=1 To Length(st1)-Length(st2) Do st2:='0'+st2 Else For i:=1 To Length(st2)-Length(st1) Do st1:='0'+st1; End; Function Cong(st1,st2:string):string; Var i,a,b,c,sodu:Byte; code:integer; st,ch:string; Begin st:=''; sodu:=0; LamDayXau(st1,st2); {Lấy số xâu: từ phải sang trái} For i:=Length(st1) DownTo Do Begin {Đổi ký tự sang số nguyên} Val(st1[i],a,code); Val(st2[i],b,code); {Tính tổng số a,b vừa lấy cho vào biến c} c:=(a+b+sodu) MOD 10; {Lấy phần dư tổng a+b} sodu:=(a+b+sodu) DIV 10; {Đổi số nguyên c sang xâu ký tự ch} str(c,ch); {Cộng xâu ch vào bên trái xâu kết st} st:=ch+st; End; {Xử lý trường hợp số dư cuối >0} If sodu>0 Then Begin 29 str(sodu,ch); st:=ch+st; End; Cong:=st; End; Begin Write('Nhap so thu nhat: '); Readln(so1); Write('Nhap so thu hai: '); Readln(so2); kqua:=Cong(so1,so2); Writeln('Tong= ',kqua); Readln; End V KIỂU BẢN GHI (RECORD) Viết chương trình quản lý điểm thi Tốt nghiệp sinh viên với môn thi: Cơ sở chuyên ngành Nội dung công việc quản lý bao gồm: - Nhập điểm cho sinh viên - In danh sách sinh viên hình - Thống kê số lượng sinh viên thi đậu - In hình hình danh sách sinh viên bị thi lại Giải: program baitaplamgiup; type hocsinh = record hoten:string[255]; diemtin:real; diemngoaingu:real; diemtrungbinh:real; xeploai:string; end; Var hs:array[1 60] of hocsinh; i,n:integer; Begin writeln('Nhap so luong hoc sinh');Readln(n); for i:=1 to n Begin Writeln('Nhap ho ten hoc sinh');Readln(hs[i].hoten); Writeln('Nhap diem tin'); Readln(hs[i].diemtin); Writeln('Nhap diem ngoai ngu'); Readln(hs[i].diemngoaingu); End; for i:=1 to n Begin if (hs[i].diemtrungbinh >= 8.0) then hs[i].xeploai:='Gioi'; if (hs[i].diemtrungbinh =6.5) then hs[i].xeploai:='Kha'; if (hs[i].diemtrungbinh =5) 30 then hs[i].xeploai:='Trungbinh'; if (hs[i].diemtrungbinh < 5) and (hs[i].diemtrungbinh >=3.5) then hs[i].xeploai:='Yeu'; if (hs[i].diemtrungbinh =5) and (CN>=5) then begin inc(d); gotoxy(1,d+6); write(d,'.'); gotoxy(7,d+6); write(hoten); gotoxy(29,d+6); write(CS:2:2); gotoxy(43,d+6); write(CN:2:2); writeln; end; end; procedure danhsachthilai; var i,d:integer; begin clrscr; d:=0; writeln('Danh sach cac sinh vien thi lai'); writeln; writeln; writeln('STT HO VA TEN DIEM CO SO NGANH '); for i:=1 to n with hs[i] 34 DIEM CHUYEN if (CS